diff options
author | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2003-11-29 17:28:49 +0000 |
---|---|---|
committer | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2003-11-29 17:28:49 +0000 |
commit | 9a6e3fe764dc2543dfa94de20fe5eec42d6be705 (patch) | |
tree | 77c0021911e3696a8c98e35a51840800db4be2a9 /theories | |
parent | 9058fb97426307536f56c3e7447be2f70798e081 (diff) |
Remplacement des fichiers .v ancienne syntaxe de theories, contrib et states par les fichiers nouvelle syntaxe
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@5027 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'theories')
200 files changed, 47542 insertions, 39875 deletions
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v index 832ea7a42..dbbb3403e 100755 --- a/theories/Arith/Arith.v +++ b/theories/Arith/Arith.v @@ -18,4 +18,4 @@ Require Export Between. Require Export Minus. Require Export Peano_dec. Require Export Compare_dec. -Require Export Factorial. +Require Export Factorial.
\ No newline at end of file diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v index 14b245335..665f96c68 100755 --- a/theories/Arith/Between.v +++ b/theories/Arith/Between.v @@ -8,178 +8,182 @@ (*i $Id$ i*) -Require Le. -Require Lt. +Require Import Le. +Require Import Lt. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type k,l,p,q,r:nat. +Implicit Types k l p q r : nat. Section Between. -Variables P,Q : nat -> Prop. +Variables P Q : nat -> Prop. -Inductive between [k:nat] : nat -> Prop - := bet_emp : (between k k) - | bet_S : (l:nat)(between k l)->(P l)->(between k (S l)). +Inductive between k : nat -> Prop := + | bet_emp : between k k + | bet_S : forall l, between k l -> P l -> between k (S l). -Hint constr_between : arith v62 := Constructors between. +Hint Constructors between: arith v62. -Lemma bet_eq : (k,l:nat)(l=k)->(between k l). +Lemma bet_eq : forall k l, l = k -> between k l. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Hints Resolve bet_eq : arith v62. +Hint Resolve bet_eq: arith v62. -Lemma between_le : (k,l:nat)(between k l)->(le k l). +Lemma between_le : forall k l, between k l -> k <= l. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Hints Immediate between_le : arith v62. +Hint Immediate between_le: arith v62. -Lemma between_Sk_l : (k,l:nat)(between k l)->(le (S k) l)->(between (S k) l). +Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l. Proof. -NewInduction 1. -Intros; Absurd (le (S k) k); Auto with arith. -NewDestruct H; Auto with arith. +induction 1. +intros; absurd (S k <= k); auto with arith. +destruct H; auto with arith. Qed. -Hints Resolve between_Sk_l : arith v62. +Hint Resolve between_Sk_l: arith v62. -Lemma between_restr : - (k,l,m:nat)(le k l)->(le l m)->(between k m)->(between l m). +Lemma between_restr : + forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Inductive exists [k:nat] : nat -> Prop - := exists_S : (l:nat)(exists k l)->(exists k (S l)) - | exists_le: (l:nat)(le k l)->(Q l)->(exists k (S l)). +Inductive exists_between k : nat -> Prop := + | exists_S : forall l, exists_between k l -> exists_between k (S l) + | exists_le : forall l, k <= l -> Q l -> exists_between k (S l). -Hint constr_exists : arith v62 := Constructors exists. +Hint Constructors exists_between: arith v62. -Lemma exists_le_S : (k,l:nat)(exists k l)->(le (S k) l). +Lemma exists_le_S : forall k l, exists_between k l -> S k <= l. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Lemma exists_lt : (k,l:nat)(exists k l)->(lt k l). +Lemma exists_lt : forall k l, exists_between k l -> k < l. Proof exists_le_S. -Hints Immediate exists_le_S exists_lt : arith v62. +Hint Immediate exists_le_S exists_lt: arith v62. -Lemma exists_S_le : (k,l:nat)(exists k (S l))->(le k l). +Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l. Proof. -Intros; Apply le_S_n; Auto with arith. +intros; apply le_S_n; auto with arith. Qed. -Hints Immediate exists_S_le : arith v62. +Hint Immediate exists_S_le: arith v62. -Definition in_int := [p,q,r:nat](le p r)/\(lt r q). +Definition in_int p q r := p <= r /\ r < q. -Lemma in_int_intro : (p,q,r:nat)(le p r)->(lt r q)->(in_int p q r). +Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r. Proof. -Red; Auto with arith. +red in |- *; auto with arith. Qed. -Hints Resolve in_int_intro : arith v62. +Hint Resolve in_int_intro: arith v62. -Lemma in_int_lt : (p,q,r:nat)(in_int p q r)->(lt p q). +Lemma in_int_lt : forall p q r, in_int p q r -> p < q. Proof. -NewInduction 1; Intros. -Apply le_lt_trans with r; Auto with arith. +induction 1; intros. +apply le_lt_trans with r; auto with arith. Qed. -Lemma in_int_p_Sq : - (p,q,r:nat)(in_int p (S q) r)->((in_int p q r) \/ <nat>r=q). +Lemma in_int_p_Sq : + forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat. Proof. -NewInduction 1; Intros. -Elim (le_lt_or_eq r q); Auto with arith. +induction 1; intros. +elim (le_lt_or_eq r q); auto with arith. Qed. -Lemma in_int_S : (p,q,r:nat)(in_int p q r)->(in_int p (S q) r). +Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r. Proof. -NewInduction 1;Auto with arith. +induction 1; auto with arith. Qed. -Hints Resolve in_int_S : arith v62. +Hint Resolve in_int_S: arith v62. -Lemma in_int_Sp_q : (p,q,r:nat)(in_int (S p) q r)->(in_int p q r). +Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Hints Immediate in_int_Sp_q : arith v62. +Hint Immediate in_int_Sp_q: arith v62. -Lemma between_in_int : (k,l:nat)(between k l)->(r:nat)(in_int k l r)->(P r). +Lemma between_in_int : + forall k l, between k l -> forall r, in_int k l r -> P r. Proof. -NewInduction 1; Intros. -Absurd (lt k k); Auto with arith. -Apply in_int_lt with r; Auto with arith. -Elim (in_int_p_Sq k l r); Intros; Auto with arith. -Rewrite H2; Trivial with arith. +induction 1; intros. +absurd (k < k); auto with arith. +apply in_int_lt with r; auto with arith. +elim (in_int_p_Sq k l r); intros; auto with arith. +rewrite H2; trivial with arith. Qed. -Lemma in_int_between : - (k,l:nat)(le k l)->((r:nat)(in_int k l r)->(P r))->(between k l). +Lemma in_int_between : + forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Lemma exists_in_int : - (k,l:nat)(exists k l)->(EX m:nat | (in_int k l m) & (Q m)). +Lemma exists_in_int : + forall k l, exists_between k l -> exists2 m : nat | in_int k l m & Q m. Proof. -NewInduction 1. -Case IHexists; Intros p inp Qp; Exists p; Auto with arith. -Exists l; Auto with arith. +induction 1. +case IHexists_between; intros p inp Qp; exists p; auto with arith. +exists l; auto with arith. Qed. -Lemma in_int_exists : (k,l,r:nat)(in_int k l r)->(Q r)->(exists k l). +Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l. Proof. -NewDestruct 1; Intros. -Elim H0; Auto with arith. +destruct 1; intros. +elim H0; auto with arith. Qed. -Lemma between_or_exists : - (k,l:nat)(le k l)->((n:nat)(in_int k l n)->((P n)\/(Q n))) - ->((between k l)\/(exists k l)). +Lemma between_or_exists : + forall k l, + k <= l -> + (forall n:nat, in_int k l n -> P n \/ Q n) -> + between k l \/ exists_between k l. Proof. -NewInduction 1; Intros; Auto with arith. -Elim IHle; Intro; Auto with arith. -Elim (H0 m); Auto with arith. +induction 1; intros; auto with arith. +elim IHle; intro; auto with arith. +elim (H0 m); auto with arith. Qed. -Lemma between_not_exists : (k,l:nat)(between k l)-> - ((n:nat)(in_int k l n) -> (P n) -> ~(Q n)) - -> ~(exists k l). +Lemma between_not_exists : + forall k l, + between k l -> + (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l. Proof. -NewInduction 1; Red; Intros. -Absurd (lt k k); Auto with arith. -Absurd (Q l); Auto with arith. -Elim (exists_in_int k (S l)); Auto with arith; Intros l' inl' Ql'. -Replace l with l'; Auto with arith. -Elim inl'; Intros. -Elim (le_lt_or_eq l' l); Auto with arith; Intros. -Absurd (exists k l); Auto with arith. -Apply in_int_exists with l'; Auto with arith. +induction 1; red in |- *; intros. +absurd (k < k); auto with arith. +absurd (Q l); auto with arith. +elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'. +replace l with l'; auto with arith. +elim inl'; intros. +elim (le_lt_or_eq l' l); auto with arith; intros. +absurd (exists_between k l); auto with arith. +apply in_int_exists with l'; auto with arith. Qed. -Inductive P_nth [init:nat] : nat->nat->Prop - := nth_O : (P_nth init init O) - | nth_S : (k,l:nat)(n:nat)(P_nth init k n)->(between (S k) l) - ->(Q l)->(P_nth init l (S n)). +Inductive P_nth (init:nat) : nat -> nat -> Prop := + | nth_O : P_nth init init 0 + | nth_S : + forall k l (n:nat), + P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n). -Lemma nth_le : (init,l,n:nat)(P_nth init l n)->(le init l). +Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l. Proof. -NewInduction 1; Intros; Auto with arith. -Apply le_trans with (S k); Auto with arith. +induction 1; intros; auto with arith. +apply le_trans with (S k); auto with arith. Qed. -Definition eventually := [n:nat](EX k:nat | (le k n) & (Q k)). +Definition eventually (n:nat) := exists2 k : nat | k <= n & Q k. -Lemma event_O : (eventually O)->(Q O). +Lemma event_O : eventually 0 -> Q 0. Proof. -NewInduction 1; Intros. -Replace O with x; Auto with arith. +induction 1; intros. +replace 0 with x; auto with arith. Qed. End Between. -Hints Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le - in_int_S in_int_intro : arith v62. -Hints Immediate in_int_Sp_q exists_le_S exists_S_le : arith v62. +Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le + in_int_S in_int_intro: arith v62. +Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62.
\ No newline at end of file diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v index f9f6eeb19..8b1b3a8c2 100644 --- a/theories/Arith/Bool_nat.v +++ b/theories/Arith/Bool_nat.v @@ -10,34 +10,30 @@ Require Export Compare_dec. Require Export Peano_dec. -Require Sumbool. +Require Import Sumbool. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,x,y:nat. +Implicit Types m n x y : nat. (** The decidability of equality and order relations over type [nat] give some boolean functions with the adequate specification. *) -Definition notzerop := [n:nat] (sumbool_not ? ? (zerop n)). -Definition lt_ge_dec : (x,y:nat){(lt x y)}+{(ge x y)} := - [n,m:nat] (sumbool_not ? ? (le_lt_dec m n)). +Definition notzerop n := sumbool_not _ _ (zerop n). +Definition lt_ge_dec : forall x y, {x < y} + {x >= y} := + fun n m => sumbool_not _ _ (le_lt_dec m n). -Definition nat_lt_ge_bool := - [x,y:nat](bool_of_sumbool (lt_ge_dec x y)). -Definition nat_ge_lt_bool := - [x,y:nat](bool_of_sumbool (sumbool_not ? ? (lt_ge_dec x y))). +Definition nat_lt_ge_bool x y := bool_of_sumbool (lt_ge_dec x y). +Definition nat_ge_lt_bool x y := + bool_of_sumbool (sumbool_not _ _ (lt_ge_dec x y)). -Definition nat_le_gt_bool := - [x,y:nat](bool_of_sumbool (le_gt_dec x y)). -Definition nat_gt_le_bool := - [x,y:nat](bool_of_sumbool (sumbool_not ? ? (le_gt_dec x y))). +Definition nat_le_gt_bool x y := bool_of_sumbool (le_gt_dec x y). +Definition nat_gt_le_bool x y := + bool_of_sumbool (sumbool_not _ _ (le_gt_dec x y)). -Definition nat_eq_bool := - [x,y:nat](bool_of_sumbool (eq_nat_dec x y)). -Definition nat_noteq_bool := - [x,y:nat](bool_of_sumbool (sumbool_not ? ? (eq_nat_dec x y))). +Definition nat_eq_bool x y := bool_of_sumbool (eq_nat_dec x y). +Definition nat_noteq_bool x y := + bool_of_sumbool (sumbool_not _ _ (eq_nat_dec x y)). -Definition zerop_bool := [x:nat](bool_of_sumbool (zerop x)). -Definition notzerop_bool := [x:nat](bool_of_sumbool (notzerop x)). +Definition zerop_bool x := bool_of_sumbool (zerop x). +Definition notzerop_bool x := bool_of_sumbool (notzerop x).
\ No newline at end of file diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v index 88055f11e..b5afebd94 100755 --- a/theories/Arith/Compare.v +++ b/theories/Arith/Compare.v @@ -9,7 +9,6 @@ (*i $Id$ i*) (** Equality is decidable on [nat] *) -V7only [Import nat_scope.]. Open Local Scope nat_scope. (* @@ -19,42 +18,42 @@ Hints Immediate not_eq_sym : arith. *) Notation not_eq_sym := sym_not_eq. -Implicit Variables Type m,n,p,q:nat. +Implicit Types m n p q : nat. -Require Arith. -Require Peano_dec. -Require Compare_dec. +Require Import Arith. +Require Import Peano_dec. +Require Import Compare_dec. Definition le_or_le_S := le_le_S_dec. -Definition compare := gt_eq_gt_dec. +Definition Pcompare := gt_eq_gt_dec. -Lemma le_dec : (n,m:nat) {le n m} + {le m n}. +Lemma le_dec : forall n m, {n <= m} + {m <= n}. Proof le_ge_dec. -Definition lt_or_eq := [n,m:nat]{(gt m n)}+{n=m}. +Definition lt_or_eq n m := {m > n} + {n = m}. -Lemma le_decide : (n,m:nat)(le n m)->(lt_or_eq n m). +Lemma le_decide : forall n m, n <= m -> lt_or_eq n m. Proof le_lt_eq_dec. -Lemma le_le_S_eq : (p,q:nat)(le p q)->((le (S p) q)\/(p=q)). +Lemma le_le_S_eq : forall n m, n <= m -> S n <= m \/ n = m. Proof le_lt_or_eq. (* By special request of G. Kahn - Used in Group Theory *) -Lemma discrete_nat : (m, n: nat) (lt m n) -> - (S m) = n \/ (EX r: nat | n = (S (S (plus m r)))). +Lemma discrete_nat : + forall n m, n < m -> S n = m \/ ( exists r : nat | m = S (S (n + r))). Proof. -Intros m n H. -LApply (lt_le_S m n); Auto with arith. -Intro H'; LApply (le_lt_or_eq (S m) n); Auto with arith. -NewInduction 1; Auto with arith. -Right; Exists (minus n (S (S m))); Simpl. -Rewrite (plus_sym m (minus n (S (S m)))). -Rewrite (plus_n_Sm (minus n (S (S m))) m). -Rewrite (plus_n_Sm (minus n (S (S m))) (S m)). -Rewrite (plus_sym (minus n (S (S m))) (S (S m))); Auto with arith. +intros m n H. +lapply (lt_le_S m n); auto with arith. +intro H'; lapply (le_lt_or_eq (S m) n); auto with arith. +induction 1; auto with arith. +right; exists (n - S (S m)); simpl in |- *. +rewrite (plus_comm m (n - S (S m))). +rewrite (plus_n_Sm (n - S (S m)) m). +rewrite (plus_n_Sm (n - S (S m)) (S m)). +rewrite (plus_comm (n - S (S m)) (S (S m))); auto with arith. Qed. Require Export Wf_nat. -Require Export Min. +Require Export Min.
\ No newline at end of file diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index a7cb9bd92..d88d6f29b 100755 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -8,102 +8,100 @@ (*i $Id$ i*) -Require Le. -Require Lt. -Require Gt. -Require Decidable. +Require Import Le. +Require Import Lt. +Require Import Gt. +Require Import Decidable. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,x,y:nat. +Implicit Types m n x y : nat. -Definition zerop : (n:nat){n=O}+{lt O n}. -NewDestruct n; Auto with arith. +Definition zerop : forall n, {n = 0} + {0 < n}. +destruct n; auto with arith. Defined. -Definition lt_eq_lt_dec : (n,m:nat){(lt n m)}+{n=m}+{(lt m n)}. +Definition lt_eq_lt_dec : forall n m, {n < m} + {n = m} + {m < n}. Proof. -NewInduction n; Destruct m; Auto with arith. -Intros m0; Elim (IHn m0); Auto with arith. -NewInduction 1; Auto with arith. +induction n; simple destruct m; auto with arith. +intros m0; elim (IHn m0); auto with arith. +induction 1; auto with arith. Defined. -Lemma gt_eq_gt_dec : (n,m:nat)({(gt m n)}+{n=m})+{(gt n m)}. +Lemma gt_eq_gt_dec : forall n m, {m > n} + {n = m} + {n > m}. Proof lt_eq_lt_dec. -Lemma le_lt_dec : (n,m:nat) {le n m} + {lt m n}. +Lemma le_lt_dec : forall n m, {n <= m} + {m < n}. Proof. -NewInduction n. -Auto with arith. -NewInduction m. -Auto with arith. -Elim (IHn m); Auto with arith. +induction n. +auto with arith. +induction m. +auto with arith. +elim (IHn m); auto with arith. Defined. -Definition le_le_S_dec : (n,m:nat) {le n m} + {le (S m) n}. +Definition le_le_S_dec : forall n m, {n <= m} + {S m <= n}. Proof. -Exact le_lt_dec. +exact le_lt_dec. Defined. -Definition le_ge_dec : (n,m:nat) {le n m} + {ge n m}. +Definition le_ge_dec : forall n m, {n <= m} + {n >= m}. Proof. -Intros; Elim (le_lt_dec n m); Auto with arith. +intros; elim (le_lt_dec n m); auto with arith. Defined. -Definition le_gt_dec : (n,m:nat){(le n m)}+{(gt n m)}. +Definition le_gt_dec : forall n m, {n <= m} + {n > m}. Proof. -Exact le_lt_dec. +exact le_lt_dec. Defined. -Definition le_lt_eq_dec : (n,m:nat)(le n m)->({(lt n m)}+{n=m}). +Definition le_lt_eq_dec : forall n m, n <= m -> {n < m} + {n = m}. Proof. -Intros; Elim (lt_eq_lt_dec n m); Auto with arith. -Intros; Absurd (lt m n); Auto with arith. +intros; elim (lt_eq_lt_dec n m); auto with arith. +intros; absurd (m < n); auto with arith. Defined. (** Proofs of decidability *) -Theorem dec_le:(x,y:nat)(decidable (le x y)). -Intros x y; Unfold decidable ; Elim (le_gt_dec x y); [ - Auto with arith -| Intro; Right; Apply gt_not_le; Assumption]. +Theorem dec_le : forall n m, decidable (n <= m). +intros x y; unfold decidable in |- *; elim (le_gt_dec x y); + [ auto with arith | intro; right; apply gt_not_le; assumption ]. Qed. -Theorem dec_lt:(x,y:nat)(decidable (lt x y)). -Intros x y; Unfold lt; Apply dec_le. +Theorem dec_lt : forall n m, decidable (n < m). +intros x y; unfold lt in |- *; apply dec_le. Qed. -Theorem dec_gt:(x,y:nat)(decidable (gt x y)). -Intros x y; Unfold gt; Apply dec_lt. +Theorem dec_gt : forall n m, decidable (n > m). +intros x y; unfold gt in |- *; apply dec_lt. Qed. -Theorem dec_ge:(x,y:nat)(decidable (ge x y)). -Intros x y; Unfold ge; Apply dec_le. +Theorem dec_ge : forall n m, decidable (n >= m). +intros x y; unfold ge in |- *; apply dec_le. Qed. -Theorem not_eq : (x,y:nat) ~ x=y -> (lt x y) \/ (lt y x). -Intros x y H; Elim (lt_eq_lt_dec x y); [ - Intros H1; Elim H1; [ Auto with arith | Intros H2; Absurd x=y; Assumption] -| Auto with arith]. +Theorem not_eq : forall n m, n <> m -> n < m \/ m < n. +intros x y H; elim (lt_eq_lt_dec x y); + [ intros H1; elim H1; + [ auto with arith | intros H2; absurd (x = y); assumption ] + | auto with arith ]. Qed. -Theorem not_le : (x,y:nat) ~(le x y) -> (gt x y). -Intros x y H; Elim (le_gt_dec x y); - [ Intros H1; Absurd (le x y); Assumption | Trivial with arith ]. +Theorem not_le : forall n m, ~ n <= m -> n > m. +intros x y H; elim (le_gt_dec x y); + [ intros H1; absurd (x <= y); assumption | trivial with arith ]. Qed. -Theorem not_gt : (x,y:nat) ~(gt x y) -> (le x y). -Intros x y H; Elim (le_gt_dec x y); - [ Trivial with arith | Intros H1; Absurd (gt x y); Assumption]. +Theorem not_gt : forall n m, ~ n > m -> n <= m. +intros x y H; elim (le_gt_dec x y); + [ trivial with arith | intros H1; absurd (x > y); assumption ]. Qed. -Theorem not_ge : (x,y:nat) ~(ge x y) -> (lt x y). -Intros x y H; Exact (not_le y x H). +Theorem not_ge : forall n m, ~ n >= m -> n < m. +intros x y H; exact (not_le y x H). Qed. -Theorem not_lt : (x,y:nat) ~(lt x y) -> (ge x y). -Intros x y H; Exact (not_gt y x H). +Theorem not_lt : forall n m, ~ n < m -> n >= m. +intros x y H; exact (not_gt y x H). Qed. - diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index 9ab8fc820..911b0b386 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -8,153 +8,155 @@ (*i $Id$ i*) -Require Lt. -Require Plus. -Require Compare_dec. -Require Even. +Require Import Lt. +Require Import Plus. +Require Import Compare_dec. +Require Import Even. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type n:nat. +Implicit Type n : nat. (** Here we define [n/2] and prove some of its properties *) -Fixpoint div2 [n:nat] : nat := - Cases n of - O => O - | (S O) => O - | (S (S n')) => (S (div2 n')) +Fixpoint div2 n : nat := + match n with + | O => 0 + | S O => 0 + | S (S n') => S (div2 n') end. (** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is useful to prove the corresponding induction principle *) -Lemma ind_0_1_SS : (P:nat->Prop) - (P O) -> (P (S O)) -> ((n:nat)(P n)->(P (S (S n)))) -> (n:nat)(P n). +Lemma ind_0_1_SS : + forall P:nat -> Prop, + P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n. Proof. -Intros. -Cut (n:nat)(P n)/\(P (S n)). -Intros. Elim (H2 n). Auto with arith. +intros. +cut (forall n, P n /\ P (S n)). +intros. elim (H2 n). auto with arith. -NewInduction n0. Auto with arith. -Intros. Elim IHn0; Auto with arith. +induction n0. auto with arith. +intros. elim IHn0; auto with arith. Qed. (** [0 <n => n/2 < n] *) -Lemma lt_div2 : (n:nat) (lt O n) -> (lt (div2 n) n). +Lemma lt_div2 : forall n, 0 < n -> div2 n < n. Proof. -Intro n. Pattern n. Apply ind_0_1_SS. -Intro. Inversion H. -Auto with arith. -Intros. Simpl. -Case (zerop n0). -Intro. Rewrite e. Auto with arith. -Auto with arith. +intro n. pattern n in |- *. apply ind_0_1_SS. +intro. inversion H. +auto with arith. +intros. simpl in |- *. +case (zerop n0). +intro. rewrite e. auto with arith. +auto with arith. Qed. -Hints Resolve lt_div2 : arith. +Hint Resolve lt_div2: arith. (** Properties related to the parity *) -Lemma even_odd_div2 : (n:nat) - ((even n)<->(div2 n)=(div2 (S n))) /\ ((odd n)<->(S (div2 n))=(div2 (S n))). +Lemma even_odd_div2 : + forall n, + (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)). Proof. -Intro n. Pattern n. Apply ind_0_1_SS. +intro n. pattern n in |- *. apply ind_0_1_SS. (* n = 0 *) -Split. Split; Auto with arith. -Split. Intro H. Inversion H. -Intro H. Absurd (S (div2 O))=(div2 (S O)); Auto with arith. +split. split; auto with arith. +split. intro H. inversion H. +intro H. absurd (S (div2 0) = div2 1); auto with arith. (* n = 1 *) -Split. Split. Intro. Inversion H. Inversion H1. -Intro H. Absurd (div2 (S O))=(div2 (S (S O))). -Simpl. Discriminate. Assumption. -Split; Auto with arith. +split. split. intro. inversion H. inversion H1. +intro H. absurd (div2 1 = div2 2). +simpl in |- *. discriminate. assumption. +split; auto with arith. (* n = (S (S n')) *) -Intros. Decompose [and] H. Unfold iff in H0 H1. -Decompose [and] H0. Decompose [and] H1. Clear H H0 H1. -Split; Split; Auto with arith. -Intro H. Inversion H. Inversion H1. -Change (S (div2 n0))=(S (div2 (S n0))). Auto with arith. -Intro H. Inversion H. Inversion H1. -Change (S (S (div2 n0)))=(S (div2 (S n0))). Auto with arith. +intros. decompose [and] H. unfold iff in H0, H1. +decompose [and] H0. decompose [and] H1. clear H H0 H1. +split; split; auto with arith. +intro H. inversion H. inversion H1. +change (S (div2 n0) = S (div2 (S n0))) in |- *. auto with arith. +intro H. inversion H. inversion H1. +change (S (S (div2 n0)) = S (div2 (S n0))) in |- *. auto with arith. Qed. (** Specializations *) -Lemma even_div2 : (n:nat) (even n) -> (div2 n)=(div2 (S n)). -Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_div2 n))). +Lemma even_div2 : forall n, even n -> div2 n = div2 (S n). +Proof fun n => proj1 (proj1 (even_odd_div2 n)). -Lemma div2_even : (n:nat) (div2 n)=(div2 (S n)) -> (even n). -Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_div2 n))). +Lemma div2_even : forall n, div2 n = div2 (S n) -> even n. +Proof fun n => proj2 (proj1 (even_odd_div2 n)). -Lemma odd_div2 : (n:nat) (odd n) -> (S (div2 n))=(div2 (S n)). -Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_div2 n))). +Lemma odd_div2 : forall n, odd n -> S (div2 n) = div2 (S n). +Proof fun n => proj1 (proj2 (even_odd_div2 n)). -Lemma div2_odd : (n:nat) (S (div2 n))=(div2 (S n)) -> (odd n). -Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_div2 n))). +Lemma div2_odd : forall n, S (div2 n) = div2 (S n) -> odd n. +Proof fun n => proj2 (proj2 (even_odd_div2 n)). -Hints Resolve even_div2 div2_even odd_div2 div2_odd : arith. +Hint Resolve even_div2 div2_even odd_div2 div2_odd: arith. (** Properties related to the double ([2n]) *) -Definition double := [n:nat](plus n n). +Definition double n := n + n. -Hints Unfold double : arith. +Hint Unfold double: arith. -Lemma double_S : (n:nat) (double (S n))=(S (S (double n))). +Lemma double_S : forall n, double (S n) = S (S (double n)). Proof. -Intro. Unfold double. Simpl. Auto with arith. +intro. unfold double in |- *. simpl in |- *. auto with arith. Qed. -Lemma double_plus : (m,n:nat) (double (plus m n))=(plus (double m) (double n)). +Lemma double_plus : forall n (m:nat), double (n + m) = double n + double m. Proof. -Intros m n. Unfold double. -Do 2 Rewrite -> plus_assoc_r. Rewrite -> (plus_permute n). -Reflexivity. +intros m n. unfold double in |- *. +do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n). +reflexivity. Qed. -Hints Resolve double_S : arith. +Hint Resolve double_S: arith. -Lemma even_odd_double : (n:nat) - ((even n)<->n=(double (div2 n))) /\ ((odd n)<->n=(S (double (div2 n)))). +Lemma even_odd_double : + forall n, + (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))). Proof. -Intro n. Pattern n. Apply ind_0_1_SS. +intro n. pattern n in |- *. apply ind_0_1_SS. (* n = 0 *) -Split; Split; Auto with arith. -Intro H. Inversion H. +split; split; auto with arith. +intro H. inversion H. (* n = 1 *) -Split; Split; Auto with arith. -Intro H. Inversion H. Inversion H1. +split; split; auto with arith. +intro H. inversion H. inversion H1. (* n = (S (S n')) *) -Intros. Decompose [and] H. Unfold iff in H0 H1. -Decompose [and] H0. Decompose [and] H1. Clear H H0 H1. -Split; Split. -Intro H. Inversion H. Inversion H1. -Simpl. 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. Rewrite (double_S (div2 n0)). Auto with arith. -Simpl. Rewrite (double_S (div2 n0)). Intro H. Injection H. Auto with arith. +intros. decompose [and] H. unfold iff in H0, H1. +decompose [and] H0. decompose [and] H1. clear H H0 H1. +split; split. +intro H. inversion H. inversion H1. +simpl in |- *. rewrite (double_S (div2 n0)). auto with arith. +simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. +intro H. inversion H. inversion H1. +simpl in |- *. rewrite (double_S (div2 n0)). auto with arith. +simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. Qed. (** Specializations *) -Lemma even_double : (n:nat) (even n) -> n=(double (div2 n)). -Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_double n))). +Lemma even_double : forall n, even n -> n = double (div2 n). +Proof fun n => proj1 (proj1 (even_odd_double n)). -Lemma double_even : (n:nat) n=(double (div2 n)) -> (even n). -Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_double n))). +Lemma double_even : forall n, n = double (div2 n) -> even n. +Proof fun n => proj2 (proj1 (even_odd_double n)). -Lemma odd_double : (n:nat) (odd n) -> n=(S (double (div2 n))). -Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_double n))). +Lemma odd_double : forall n, odd n -> n = S (double (div2 n)). +Proof fun n => proj1 (proj2 (even_odd_double n)). -Lemma double_odd : (n:nat) n=(S (double (div2 n))) -> (odd n). -Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_double n))). +Lemma double_odd : forall n, n = S (double (div2 n)) -> odd n. +Proof fun n => proj2 (proj2 (even_odd_double n)). -Hints Resolve even_double double_even odd_double double_odd : arith. +Hint Resolve even_double double_even odd_double double_odd: arith. (** Application: - if [n] is even then there is a [p] such that [n = 2p] @@ -162,13 +164,12 @@ Hints Resolve even_double double_even odd_double double_odd : arith. (Immediate: it is [n/2]) *) -Lemma even_2n : (n:nat) (even n) -> { p:nat | n=(double p) }. +Lemma even_2n : forall n, even n -> {p : nat | n = double p}. Proof. -Intros n H. Exists (div2 n). Auto with arith. +intros n H. exists (div2 n). auto with arith. Qed. -Lemma odd_S2n : (n:nat) (odd n) -> { p:nat | n=(S (double p)) }. +Lemma odd_S2n : forall n, odd n -> {p : nat | n = S (double p)}. Proof. -Intros n H. Exists (div2 n). Auto with arith. +intros n H. exists (div2 n). auto with arith. Qed. - diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v index a0ba5127d..f1246ceaf 100755 --- a/theories/Arith/EqNat.v +++ b/theories/Arith/EqNat.v @@ -10,69 +10,68 @@ (** Equality on natural numbers *) -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,x,y:nat. +Implicit Types m n x y : nat. -Fixpoint eq_nat [n:nat] : nat -> Prop := - [m:nat]Cases n m of - O O => True - | O (S _) => False - | (S _) O => False - | (S n1) (S m1) => (eq_nat n1 m1) - end. +Fixpoint eq_nat n m {struct n} : Prop := + match n, m with + | O, O => True + | O, S _ => False + | S _, O => False + | S n1, S m1 => eq_nat n1 m1 + end. -Theorem eq_nat_refl : (n:nat)(eq_nat n n). -NewInduction n; Simpl; Auto. +Theorem eq_nat_refl : forall n, eq_nat n n. +induction n; simpl in |- *; auto. Qed. -Hints Resolve eq_nat_refl : arith v62. +Hint Resolve eq_nat_refl: arith v62. -Theorem eq_eq_nat : (n,m:nat)(n=m)->(eq_nat n m). -NewInduction 1; Trivial with arith. +Theorem eq_eq_nat : forall n m, n = m -> eq_nat n m. +induction 1; trivial with arith. Qed. -Hints Immediate eq_eq_nat : arith v62. +Hint Immediate eq_eq_nat: arith v62. -Theorem eq_nat_eq : (n,m:nat)(eq_nat n m)->(n=m). -NewInduction n; NewInduction m; Simpl; Contradiction Orelse Auto with arith. +Theorem eq_nat_eq : forall n m, eq_nat n m -> n = m. +induction n; induction m; simpl in |- *; contradiction || auto with arith. Qed. -Hints Immediate eq_nat_eq : arith v62. +Hint Immediate eq_nat_eq: arith v62. -Theorem eq_nat_elim : (n:nat)(P:nat->Prop)(P n)->(m:nat)(eq_nat n m)->(P m). -Intros; Replace m with n; Auto with arith. +Theorem eq_nat_elim : + forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m. +intros; replace m with n; auto with arith. Qed. -Theorem eq_nat_decide : (n,m:nat){(eq_nat n m)}+{~(eq_nat n m)}. -NewInduction n. -NewDestruct m. -Auto with arith. -Intros; Right; Red; Trivial with arith. -NewDestruct m. -Right; Red; Auto with arith. -Intros. -Simpl. -Apply IHn. +Theorem eq_nat_decide : forall n m, {eq_nat n m} + {~ eq_nat n m}. +induction n. +destruct m as [| n]. +auto with arith. +intros; right; red in |- *; trivial with arith. +destruct m as [| n0]. +right; red in |- *; auto with arith. +intros. +simpl in |- *. +apply IHn. Defined. -Fixpoint beq_nat [n:nat] : nat -> bool := - [m:nat]Cases n m of - O O => true - | O (S _) => false - | (S _) O => false - | (S n1) (S m1) => (beq_nat n1 m1) - end. +Fixpoint beq_nat n m {struct n} : bool := + match n, m with + | O, O => true + | O, S _ => false + | S _, O => false + | S n1, S m1 => beq_nat n1 m1 + end. -Lemma beq_nat_refl : (x:nat)true=(beq_nat x x). +Lemma beq_nat_refl : forall n, true = beq_nat n n. Proof. - Intro x; NewInduction x; Simpl; Auto. + intro x; induction x; simpl in |- *; auto. Qed. -Definition beq_nat_eq : (x,y:nat)true=(beq_nat x y)->x=y. +Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y. Proof. - Double Induction x y; Simpl. - Reflexivity. - Intros; Discriminate H0. - Intros; Discriminate H0. - Intros; Case (H0 ? H1); Reflexivity. + double induction x y; simpl in |- *. + reflexivity. + intros; discriminate H0. + intros; discriminate H0. + intros; case (H0 _ H1); reflexivity. Defined. - diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v index f64d932e7..02c48f028 100644 --- a/theories/Arith/Euclid.v +++ b/theories/Arith/Euclid.v @@ -8,58 +8,61 @@ (*i $Id$ i*) -Require Mult. -Require Compare_dec. -Require Wf_nat. +Require Import Mult. +Require Import Compare_dec. +Require Import Wf_nat. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type a,b,n,q,r:nat. +Implicit Types a b n q r : nat. -Inductive diveucl [a,b:nat] : Set - := divex : (q,r:nat)(gt b r)->(a=(plus (mult q b) r))->(diveucl a b). +Inductive diveucl a b : Set := + divex : forall q r, b > r -> a = q * b + r -> diveucl a b. -Lemma eucl_dev : (b:nat)(gt b O)->(a:nat)(diveucl a b). -Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0. -Elim (le_gt_dec b n). -Intro lebn. -Elim (H0 (minus n b)); Auto with arith. -Intros q r g e. -Apply divex with (S q) r; Simpl; Auto with arith. -Elim plus_assoc_l. -Elim e; Auto with arith. -Intros gtbn. -Apply divex with O n; Simpl; Auto with arith. +Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n. +intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. +elim (le_gt_dec b n). +intro lebn. +elim (H0 (n - b)); auto with arith. +intros q r g e. +apply divex with (S q) r; simpl in |- *; auto with arith. +elim plus_assoc. +elim e; auto with arith. +intros gtbn. +apply divex with 0 n; simpl in |- *; auto with arith. Qed. -Lemma quotient : (b:nat)(gt b O)-> - (a:nat){q:nat|(EX r:nat | (a=(plus (mult q b) r))/\(gt b r))}. -Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0. -Elim (le_gt_dec b n). -Intro lebn. -Elim (H0 (minus n b)); Auto with arith. -Intros q Hq; Exists (S q). -Elim Hq; Intros r Hr. -Exists r; Simpl; Elim Hr; Intros. -Elim plus_assoc_l. -Elim H1; Auto with arith. -Intros gtbn. -Exists O; Exists n; Simpl; Auto with arith. +Lemma quotient : + forall n, + n > 0 -> + forall m:nat, {q : nat | exists r : nat | m = q * n + r /\ n > r}. +intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. +elim (le_gt_dec b n). +intro lebn. +elim (H0 (n - b)); auto with arith. +intros q Hq; exists (S q). +elim Hq; intros r Hr. +exists r; simpl in |- *; elim Hr; intros. +elim plus_assoc. +elim H1; auto with arith. +intros gtbn. +exists 0; exists n; simpl in |- *; auto with arith. Qed. -Lemma modulo : (b:nat)(gt b O)-> - (a:nat){r:nat|(EX q:nat | (a=(plus (mult q b) r))/\(gt b r))}. -Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0. -Elim (le_gt_dec b n). -Intro lebn. -Elim (H0 (minus n b)); Auto with arith. -Intros r Hr; Exists r. -Elim Hr; Intros q Hq. -Elim Hq; Intros; Exists (S q); Simpl. -Elim plus_assoc_l. -Elim H1; Auto with arith. -Intros gtbn. -Exists n; Exists O; Simpl; Auto with arith. -Qed. +Lemma modulo : + forall n, + n > 0 -> + forall m:nat, {r : nat | exists q : nat | m = q * n + r /\ n > r}. +intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. +elim (le_gt_dec b n). +intro lebn. +elim (H0 (n - b)); auto with arith. +intros r Hr; exists r. +elim Hr; intros q Hq. +elim Hq; intros; exists (S q); simpl in |- *. +elim plus_assoc. +elim H1; auto with arith. +intros gtbn. +exists n; exists 0; simpl in |- *; auto with arith. +Qed.
\ No newline at end of file diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v index 88ad1851b..0017a464b 100644 --- a/theories/Arith/Even.v +++ b/theories/Arith/Even.v @@ -12,299 +12,294 @@ and we prove the decidability and the exclusion of those predicates. The main results about parity are proved in the module Div2. *) -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n:nat. +Implicit Types m n : nat. -Inductive even : nat->Prop := - even_O : (even O) - | even_S : (n:nat)(odd n)->(even (S n)) -with odd : nat->Prop := - odd_S : (n:nat)(even n)->(odd (S n)). +Inductive even : nat -> Prop := + | even_O : even 0 + | even_S : forall n, odd n -> even (S n) +with odd : nat -> Prop := + odd_S : forall n, even n -> odd (S n). -Hint constr_even : arith := Constructors even. -Hint constr_odd : arith := Constructors odd. +Hint Constructors even: arith. +Hint Constructors odd: arith. -Lemma even_or_odd : (n:nat) (even n)\/(odd n). +Lemma even_or_odd : forall n, even n \/ odd n. Proof. -NewInduction n. -Auto with arith. -Elim IHn; Auto with arith. +induction n. +auto with arith. +elim IHn; auto with arith. Qed. -Lemma even_odd_dec : (n:nat) { (even n) }+{ (odd n) }. +Lemma even_odd_dec : forall n, {even n} + {odd n}. Proof. -NewInduction n. -Auto with arith. -Elim IHn; Auto with arith. +induction n. +auto with arith. +elim IHn; auto with arith. Qed. -Lemma not_even_and_odd : (n:nat) (even n) -> (odd n) -> False. +Lemma not_even_and_odd : forall n, even n -> odd n -> False. Proof. -NewInduction n. -Intros. Inversion H0. -Intros. Inversion H. Inversion H0. Auto with arith. +induction n. +intros. inversion H0. +intros. inversion H. inversion H0. auto with arith. Qed. -Lemma even_plus_aux: - (n,m:nat) - (iff (odd (plus n m)) (odd n) /\ (even m) \/ (even n) /\ (odd m)) /\ - (iff (even (plus n m)) (even n) /\ (even m) \/ (odd n) /\ (odd m)). +Lemma even_plus_aux : + forall n m, + (odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\ + (even (n + m) <-> even n /\ even m \/ odd n /\ odd m). Proof. -Intros n; Elim n; Simpl; Auto with arith. -Intros m; Split; Auto. -Split. -Intros H; Right; Split; Auto with arith. -Intros H'; Case H'; Auto with arith. -Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1. -Intros H; Elim H; Auto. -Split; Auto with arith. -Intros H'; Elim H'; Auto with arith. -Intros H; Elim H; Auto. -Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1. -Intros n0 H' m; Elim (H' m); Intros H'1 H'2; Elim H'1; Intros E1 E2; Elim H'2; - Intros E3 E4; Clear H'1 H'2. -Split; Split. -Intros H'0; Case E3. -Inversion H'0; Auto. -Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith. -Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith. -Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2. -Apply odd_S. -Apply E4; Left; Split; Auto with arith. -Inversion C1; Auto. -Apply odd_S. -Apply E4; Right; Split; Auto with arith. -Inversion C1; Auto. -Intros H'0. -Case E1. -Inversion H'0; Auto. -Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith. -Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith. -Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2. -Apply even_S. -Apply E2; Left; Split; Auto with arith. -Inversion C1; Auto. -Apply even_S. -Apply E2; Right; Split; Auto with arith. -Inversion C1; Auto. +intros n; elim n; simpl in |- *; auto with arith. +intros m; split; auto. +split. +intros H; right; split; auto with arith. +intros H'; case H'; auto with arith. +intros H'0; elim H'0; intros H'1 H'2; inversion H'1. +intros H; elim H; auto. +split; auto with arith. +intros H'; elim H'; auto with arith. +intros H; elim H; auto. +intros H'0; elim H'0; intros H'1 H'2; inversion H'1. +intros n0 H' m; elim (H' m); intros H'1 H'2; elim H'1; intros E1 E2; elim H'2; + intros E3 E4; clear H'1 H'2. +split; split. +intros H'0; case E3. +inversion H'0; auto. +intros H; elim H; intros H0 H1; clear H; auto with arith. +intros H; elim H; intros H0 H1; clear H; auto with arith. +intros H'0; case H'0; intros C0; case C0; intros C1 C2. +apply odd_S. +apply E4; left; split; auto with arith. +inversion C1; auto. +apply odd_S. +apply E4; right; split; auto with arith. +inversion C1; auto. +intros H'0. +case E1. +inversion H'0; auto. +intros H; elim H; intros H0 H1; clear H; auto with arith. +intros H; elim H; intros H0 H1; clear H; auto with arith. +intros H'0; case H'0; intros C0; case C0; intros C1 C2. +apply even_S. +apply E2; left; split; auto with arith. +inversion C1; auto. +apply even_S. +apply E2; right; split; auto with arith. +inversion C1; auto. Qed. -Lemma even_even_plus : (n,m:nat) (even n) -> (even m) -> (even (plus n m)). +Lemma even_even_plus : forall n m, even n -> even m -> even (n + m). Proof. -Intros n m; Case (even_plus_aux n m). -Intros H H0; Case H0; Auto. +intros n m; case (even_plus_aux n m). +intros H H0; case H0; auto. Qed. -Lemma odd_even_plus : (n,m:nat) (odd n) -> (odd m) -> (even (plus n m)). +Lemma odd_even_plus : forall n m, odd n -> odd m -> even (n + m). Proof. -Intros n m; Case (even_plus_aux n m). -Intros H H0; Case H0; Auto. +intros n m; case (even_plus_aux n m). +intros H H0; case H0; auto. Qed. -Lemma even_plus_even_inv_r : - (n,m:nat) (even (plus n m)) -> (even n) -> (even m). +Lemma even_plus_even_inv_r : forall n m, even (n + m) -> even n -> even m. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'0. -Intros H'1; Case H'1; Auto. -Intros H0; Elim H0; Auto. -Intros H0 H1 H2; Case (not_even_and_odd n); Auto. -Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'0. +intros H'1; case H'1; auto. +intros H0; elim H0; auto. +intros H0 H1 H2; case (not_even_and_odd n); auto. +case H0; auto. Qed. -Lemma even_plus_even_inv_l : - (n,m:nat) (even (plus n m)) -> (even m) -> (even n). +Lemma even_plus_even_inv_l : forall n m, even (n + m) -> even m -> even n. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'0. -Intros H'1; Case H'1; Auto. -Intros H0; Elim H0; Auto. -Intros H0 H1 H2; Case (not_even_and_odd m); Auto. -Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'0. +intros H'1; case H'1; auto. +intros H0; elim H0; auto. +intros H0 H1 H2; case (not_even_and_odd m); auto. +case H0; auto. Qed. -Lemma even_plus_odd_inv_r : (n,m:nat) (even (plus n m)) -> (odd n) -> (odd m). +Lemma even_plus_odd_inv_r : forall n m, even (n + m) -> odd n -> odd m. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'0. -Intros H'1; Case H'1; Auto. -Intros H0 H1 H2; Case (not_even_and_odd n); Auto. -Case H0; Auto. -Intros H0; Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'0. +intros H'1; case H'1; auto. +intros H0 H1 H2; case (not_even_and_odd n); auto. +case H0; auto. +intros H0; case H0; auto. Qed. -Lemma even_plus_odd_inv_l : (n,m:nat) (even (plus n m)) -> (odd m) -> (odd n). +Lemma even_plus_odd_inv_l : forall n m, even (n + m) -> odd m -> odd n. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'0. -Intros H'1; Case H'1; Auto. -Intros H0 H1 H2; Case (not_even_and_odd m); Auto. -Case H0; Auto. -Intros H0; Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'0. +intros H'1; case H'1; auto. +intros H0 H1 H2; case (not_even_and_odd m); auto. +case H0; auto. +intros H0; case H0; auto. Qed. -Hints Resolve even_even_plus odd_even_plus :arith. +Hint Resolve even_even_plus odd_even_plus: arith. -Lemma odd_plus_l : (n,m:nat) (odd n) -> (even m) -> (odd (plus n m)). +Lemma odd_plus_l : forall n m, odd n -> even m -> odd (n + m). Proof. -Intros n m; Case (even_plus_aux n m). -Intros H; Case H; Auto. +intros n m; case (even_plus_aux n m). +intros H; case H; auto. Qed. -Lemma odd_plus_r : (n,m:nat) (even n) -> (odd m) -> (odd (plus n m)). +Lemma odd_plus_r : forall n m, even n -> odd m -> odd (n + m). Proof. -Intros n m; Case (even_plus_aux n m). -Intros H; Case H; Auto. +intros n m; case (even_plus_aux n m). +intros H; case H; auto. Qed. -Lemma odd_plus_even_inv_l : (n,m:nat) (odd (plus n m)) -> (odd m) -> (even n). +Lemma odd_plus_even_inv_l : forall n m, odd (n + m) -> odd m -> even n. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'. -Intros H'1; Case H'1; Auto. -Intros H0 H1 H2; Case (not_even_and_odd m); Auto. -Case H0; Auto. -Intros H0; Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'. +intros H'1; case H'1; auto. +intros H0 H1 H2; case (not_even_and_odd m); auto. +case H0; auto. +intros H0; case H0; auto. Qed. -Lemma odd_plus_even_inv_r : (n,m:nat) (odd (plus n m)) -> (odd n) -> (even m). +Lemma odd_plus_even_inv_r : forall n m, odd (n + m) -> odd n -> even m. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'. -Intros H'1; Case H'1; Auto. -Intros H0; Case H0; Auto. -Intros H0 H1 H2; Case (not_even_and_odd n); Auto. -Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'. +intros H'1; case H'1; auto. +intros H0; case H0; auto. +intros H0 H1 H2; case (not_even_and_odd n); auto. +case H0; auto. Qed. -Lemma odd_plus_odd_inv_l : (n,m:nat) (odd (plus n m)) -> (even m) -> (odd n). +Lemma odd_plus_odd_inv_l : forall n m, odd (n + m) -> even m -> odd n. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'. -Intros H'1; Case H'1; Auto. -Intros H0; Case H0; Auto. -Intros H0 H1 H2; Case (not_even_and_odd m); Auto. -Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'. +intros H'1; case H'1; auto. +intros H0; case H0; auto. +intros H0 H1 H2; case (not_even_and_odd m); auto. +case H0; auto. Qed. -Lemma odd_plus_odd_inv_r : (n,m:nat) (odd (plus n m)) -> (even n) -> (odd m). +Lemma odd_plus_odd_inv_r : forall n m, odd (n + m) -> even n -> odd m. Proof. -Intros n m H; Case (even_plus_aux n m). -Intros H' H'0; Elim H'. -Intros H'1; Case H'1; Auto. -Intros H0 H1 H2; Case (not_even_and_odd n); Auto. -Case H0; Auto. -Intros H0; Case H0; Auto. +intros n m H; case (even_plus_aux n m). +intros H' H'0; elim H'. +intros H'1; case H'1; auto. +intros H0 H1 H2; case (not_even_and_odd n); auto. +case H0; auto. +intros H0; case H0; auto. Qed. -Hints Resolve odd_plus_l odd_plus_r :arith. +Hint Resolve odd_plus_l odd_plus_r: arith. Lemma even_mult_aux : - (n,m:nat) - (iff (odd (mult n m)) (odd n) /\ (odd m)) /\ - (iff (even (mult n m)) (even n) \/ (even m)). + forall n m, + (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m). Proof. -Intros n; Elim n; Simpl; Auto with arith. -Intros m; Split; Split; Auto with arith. -Intros H'; Inversion H'. -Intros H'; Elim H'; Auto. -Intros n0 H' m; Split; Split; Auto with arith. -Intros H'0. -Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'3; Intros H'1 H'2; - Case H'1; Auto. -Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith. -Split; Auto with arith. -Case (H' m). -Intros H'8 H'9; Case H'9. -Intros H'10; Case H'10; Auto with arith. -Intros H'11 H'12; Case (not_even_and_odd m); Auto with arith. -Intros H'5; Elim H'5; Intros H'6 H'7; Case (not_even_and_odd (mult n0 m)); Auto. -Case (H' m). -Intros H'8 H'9; Case H'9; Auto. -Intros H'0; Elim H'0; Intros H'1 H'2; Clear H'0. -Elim (even_plus_aux m (mult n0 m)); Auto. -Intros H'0 H'3. -Elim H'0. -Intros H'4 H'5; Apply H'5; Auto. -Left; Split; Auto with arith. -Case (H' m). -Intros H'6 H'7; Elim H'7. -Intros H'8 H'9; Apply H'9. -Left. -Inversion H'1; Auto. -Intros H'0. -Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'4. -Intros H'1 H'2. -Elim H'1; Auto. -Intros H; Case H; Auto. -Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith. -Left. -Case (H' m). -Intros H'8; Elim H'8. -Intros H'9; Elim H'9; Auto with arith. -Intros H'0; Elim H'0; Intros H'1. -Case (even_or_odd m); Intros H'2. -Apply even_even_plus; Auto. -Case (H' m). -Intros H H0; Case H0; Auto. -Apply odd_even_plus; Auto. -Inversion H'1; Case (H' m); Auto. -Intros H1; Case H1; Auto. -Apply even_even_plus; Auto. -Case (H' m). -Intros H H0; Case H0; Auto. +intros n; elim n; simpl in |- *; auto with arith. +intros m; split; split; auto with arith. +intros H'; inversion H'. +intros H'; elim H'; auto. +intros n0 H' m; split; split; auto with arith. +intros H'0. +elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'3; intros H'1 H'2; + case H'1; auto. +intros H'5; elim H'5; intros H'6 H'7; auto with arith. +split; auto with arith. +case (H' m). +intros H'8 H'9; case H'9. +intros H'10; case H'10; auto with arith. +intros H'11 H'12; case (not_even_and_odd m); auto with arith. +intros H'5; elim H'5; intros H'6 H'7; case (not_even_and_odd (n0 * m)); auto. +case (H' m). +intros H'8 H'9; case H'9; auto. +intros H'0; elim H'0; intros H'1 H'2; clear H'0. +elim (even_plus_aux m (n0 * m)); auto. +intros H'0 H'3. +elim H'0. +intros H'4 H'5; apply H'5; auto. +left; split; auto with arith. +case (H' m). +intros H'6 H'7; elim H'7. +intros H'8 H'9; apply H'9. +left. +inversion H'1; auto. +intros H'0. +elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'4. +intros H'1 H'2. +elim H'1; auto. +intros H; case H; auto. +intros H'5; elim H'5; intros H'6 H'7; auto with arith. +left. +case (H' m). +intros H'8; elim H'8. +intros H'9; elim H'9; auto with arith. +intros H'0; elim H'0; intros H'1. +case (even_or_odd m); intros H'2. +apply even_even_plus; auto. +case (H' m). +intros H H0; case H0; auto. +apply odd_even_plus; auto. +inversion H'1; case (H' m); auto. +intros H1; case H1; auto. +apply even_even_plus; auto. +case (H' m). +intros H H0; case H0; auto. Qed. -Lemma even_mult_l : (n,m:nat) (even n) -> (even (mult n m)). +Lemma even_mult_l : forall n m, even n -> even (n * m). Proof. -Intros n m; Case (even_mult_aux n m); Auto. -Intros H H0; Case H0; Auto. +intros n m; case (even_mult_aux n m); auto. +intros H H0; case H0; auto. Qed. -Lemma even_mult_r: (n,m:nat) (even m) -> (even (mult n m)). +Lemma even_mult_r : forall n m, even m -> even (n * m). Proof. -Intros n m; Case (even_mult_aux n m); Auto. -Intros H H0; Case H0; Auto. +intros n m; case (even_mult_aux n m); auto. +intros H H0; case H0; auto. Qed. -Hints Resolve even_mult_l even_mult_r :arith. +Hint Resolve even_mult_l even_mult_r: arith. -Lemma even_mult_inv_r: (n,m:nat) (even (mult n m)) -> (odd n) -> (even m). +Lemma even_mult_inv_r : forall n m, even (n * m) -> odd n -> even m. Proof. -Intros n m H' H'0. -Case (even_mult_aux n m). -Intros H'1 H'2; Elim H'2. -Intros H'3; Elim H'3; Auto. -Intros H; Case (not_even_and_odd n); Auto. +intros n m H' H'0. +case (even_mult_aux n m). +intros H'1 H'2; elim H'2. +intros H'3; elim H'3; auto. +intros H; case (not_even_and_odd n); auto. Qed. -Lemma even_mult_inv_l : (n,m:nat) (even (mult n m)) -> (odd m) -> (even n). +Lemma even_mult_inv_l : forall n m, even (n * m) -> odd m -> even n. Proof. -Intros n m H' H'0. -Case (even_mult_aux n m). -Intros H'1 H'2; Elim H'2. -Intros H'3; Elim H'3; Auto. -Intros H; Case (not_even_and_odd m); Auto. +intros n m H' H'0. +case (even_mult_aux n m). +intros H'1 H'2; elim H'2. +intros H'3; elim H'3; auto. +intros H; case (not_even_and_odd m); auto. Qed. -Lemma odd_mult : (n,m:nat) (odd n) -> (odd m) -> (odd (mult n m)). +Lemma odd_mult : forall n m, odd n -> odd m -> odd (n * m). Proof. -Intros n m; Case (even_mult_aux n m); Intros H; Case H; Auto. +intros n m; case (even_mult_aux n m); intros H; case H; auto. Qed. -Hints Resolve even_mult_l even_mult_r odd_mult :arith. +Hint Resolve even_mult_l even_mult_r odd_mult: arith. -Lemma odd_mult_inv_l : (n,m:nat) (odd (mult n m)) -> (odd n). +Lemma odd_mult_inv_l : forall n m, odd (n * m) -> odd n. Proof. -Intros n m H'. -Case (even_mult_aux n m). -Intros H'1 H'2; Elim H'1. -Intros H'3; Elim H'3; Auto. +intros n m H'. +case (even_mult_aux n m). +intros H'1 H'2; elim H'1. +intros H'3; elim H'3; auto. Qed. -Lemma odd_mult_inv_r : (n,m:nat) (odd (mult n m)) -> (odd m). +Lemma odd_mult_inv_r : forall n m, odd (n * m) -> odd m. Proof. -Intros n m H'. -Case (even_mult_aux n m). -Intros H'1 H'2; Elim H'1. -Intros H'3; Elim H'3; Auto. +intros n m H'. +case (even_mult_aux n m). +intros H'1 H'2; elim H'1. +intros H'3; elim H'3; auto. Qed. - diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v index 1d1ee00af..69b55e009 100644 --- a/theories/Arith/Factorial.v +++ b/theories/Arith/Factorial.v @@ -8,44 +8,43 @@ (*i $Id$ i*) -Require Plus. -Require Mult. -Require Lt. -V7only [Import nat_scope.]. +Require Import Plus. +Require Import Mult. +Require Import Lt. Open Local Scope nat_scope. (** Factorial *) -Fixpoint fact [n:nat]:nat:= - Cases n of - O => (S O) - |(S n) => (mult (S n) (fact n)) +Fixpoint fact (n:nat) : nat := + match n with + | O => 1 + | S n => S n * fact n end. -Arguments Scope fact [ nat_scope ]. +Arguments Scope fact [nat_scope]. -Lemma lt_O_fact : (n:nat)(lt O (fact n)). +Lemma lt_O_fact : forall n:nat, 0 < fact n. Proof. -Induction n; Unfold lt; Simpl; Auto with arith. +simple induction n; unfold lt in |- *; simpl in |- *; auto with arith. Qed. -Lemma fact_neq_0:(n:nat)~(fact n)=O. +Lemma fact_neq_0 : forall n:nat, fact n <> 0. Proof. -Intro. -Apply sym_not_eq. -Apply lt_O_neq. -Apply lt_O_fact. +intro. +apply sym_not_eq. +apply lt_O_neq. +apply lt_O_fact. Qed. -Lemma fact_growing : (n,m:nat) (le n m) -> (le (fact n) (fact m)). +Lemma fact_le : forall n m:nat, n <= m -> fact n <= fact m. Proof. -NewInduction 1. -Apply le_n. -Assert (le (mult (S O) (fact n)) (mult (S m) (fact m))). -Apply le_mult_mult. -Apply lt_le_S; Apply lt_O_Sn. -Assumption. -Simpl (mult (S O) (fact n)) in H0. -Rewrite <- plus_n_O in H0. -Assumption. -Qed. +induction 1. +apply le_n. +assert (1 * fact n <= S m * fact m). +apply mult_le_compat. +apply lt_le_S; apply lt_O_Sn. +assumption. +simpl (1 * fact n) in H0. +rewrite <- plus_n_O in H0. +assumption. +Qed.
\ No newline at end of file diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v index ce4661df6..c0afdb0ae 100755 --- a/theories/Arith/Gt.v +++ b/theories/Arith/Gt.v @@ -8,142 +8,141 @@ (*i $Id$ i*) -Require Le. -Require Lt. -Require Plus. -V7only [Import nat_scope.]. +Require Import Le. +Require Import Lt. +Require Import Plus. Open Local Scope nat_scope. -Implicit Variables Type m,n,p:nat. +Implicit Types m n p : nat. (** Order and successor *) -Theorem gt_Sn_O : (n:nat)(gt (S n) O). +Theorem gt_Sn_O : forall n, S n > 0. Proof. - Auto with arith. + auto with arith. Qed. -Hints Resolve gt_Sn_O : arith v62. +Hint Resolve gt_Sn_O: arith v62. -Theorem gt_Sn_n : (n:nat)(gt (S n) n). +Theorem gt_Sn_n : forall n, S n > n. Proof. - Auto with arith. + auto with arith. Qed. -Hints Resolve gt_Sn_n : arith v62. +Hint Resolve gt_Sn_n: arith v62. -Theorem gt_n_S : (n,m:nat)(gt n m)->(gt (S n) (S m)). +Theorem gt_n_S : forall n m, n > m -> S n > S m. Proof. - Auto with arith. + auto with arith. Qed. -Hints Resolve gt_n_S : arith v62. +Hint Resolve gt_n_S: arith v62. -Lemma gt_S_n : (n,p:nat)(gt (S p) (S n))->(gt p n). +Lemma gt_S_n : forall n m, S m > S n -> m > n. Proof. - Auto with arith. + auto with arith. Qed. -Hints Immediate gt_S_n : arith v62. +Hint Immediate gt_S_n: arith v62. -Theorem gt_S : (n,m:nat)(gt (S n) m)->((gt n m)\/(m=n)). +Theorem gt_S : forall n m, S n > m -> n > m \/ m = n. Proof. - Intros n m H; Unfold gt; Apply le_lt_or_eq; Auto with arith. + intros n m H; unfold gt in |- *; apply le_lt_or_eq; auto with arith. Qed. -Lemma gt_pred : (n,p:nat)(gt p (S n))->(gt (pred p) n). +Lemma gt_pred : forall n m, m > S n -> pred m > n. Proof. - Auto with arith. + auto with arith. Qed. -Hints Immediate gt_pred : arith v62. +Hint Immediate gt_pred: arith v62. (** Irreflexivity *) -Lemma gt_antirefl : (n:nat)~(gt n n). -Proof lt_n_n. -Hints Resolve gt_antirefl : arith v62. +Lemma gt_irrefl : forall n, ~ n > n. +Proof lt_irrefl. +Hint Resolve gt_irrefl: arith v62. (** Asymmetry *) -Lemma gt_not_sym : (n,m:nat)(gt n m) -> ~(gt m n). -Proof [n,m:nat](lt_not_sym m n). +Lemma gt_asym : forall n m, n > m -> ~ m > n. +Proof fun n m => lt_asym m n. -Hints Resolve gt_not_sym : arith v62. +Hint Resolve gt_asym: arith v62. (** Relating strict and large orders *) -Lemma le_not_gt : (n,m:nat)(le n m) -> ~(gt n m). +Lemma le_not_gt : forall n m, n <= m -> ~ n > m. Proof le_not_lt. -Hints Resolve le_not_gt : arith v62. +Hint Resolve le_not_gt: arith v62. -Lemma gt_not_le : (n,m:nat)(gt n m) -> ~(le n m). +Lemma gt_not_le : forall n m, n > m -> ~ n <= m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve gt_not_le : arith v62. +Hint Resolve gt_not_le: arith v62. -Theorem le_S_gt : (n,m:nat)(le (S n) m)->(gt m n). +Theorem le_S_gt : forall n m, S n <= m -> m > n. Proof. - Auto with arith. + auto with arith. Qed. -Hints Immediate le_S_gt : arith v62. +Hint Immediate le_S_gt: arith v62. -Lemma gt_S_le : (n,p:nat)(gt (S p) n)->(le n p). +Lemma gt_S_le : forall n m, S m > n -> n <= m. Proof. - Intros n p; Exact (lt_n_Sm_le n p). + intros n p; exact (lt_n_Sm_le n p). Qed. -Hints Immediate gt_S_le : arith v62. +Hint Immediate gt_S_le: arith v62. -Lemma gt_le_S : (n,p:nat)(gt p n)->(le (S n) p). +Lemma gt_le_S : forall n m, m > n -> S n <= m. Proof. - Auto with arith. + auto with arith. Qed. -Hints Resolve gt_le_S : arith v62. +Hint Resolve gt_le_S: arith v62. -Lemma le_gt_S : (n,p:nat)(le n p)->(gt (S p) n). +Lemma le_gt_S : forall n m, n <= m -> S m > n. Proof. - Auto with arith. + auto with arith. Qed. -Hints Resolve le_gt_S : arith v62. +Hint Resolve le_gt_S: arith v62. (** Transitivity *) -Theorem le_gt_trans : (n,m,p:nat)(le m n)->(gt m p)->(gt n p). +Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p. Proof. - Red; Intros; Apply lt_le_trans with m; Auto with arith. + red in |- *; intros; apply lt_le_trans with m; auto with arith. Qed. -Theorem gt_le_trans : (n,m,p:nat)(gt n m)->(le p m)->(gt n p). +Theorem gt_le_trans : forall n m p, n > m -> p <= m -> n > p. Proof. - Red; Intros; Apply le_lt_trans with m; Auto with arith. + red in |- *; intros; apply le_lt_trans with m; auto with arith. Qed. -Lemma gt_trans : (n,m,p:nat)(gt n m)->(gt m p)->(gt n p). +Lemma gt_trans : forall n m p, n > m -> m > p -> n > p. Proof. - Red; Intros n m p H1 H2. - Apply lt_trans with m; Auto with arith. + red in |- *; intros n m p H1 H2. + apply lt_trans with m; auto with arith. Qed. -Theorem gt_trans_S : (n,m,p:nat)(gt (S n) m)->(gt m p)->(gt n p). +Theorem gt_trans_S : forall n m p, S n > m -> m > p -> n > p. Proof. - Red; Intros; Apply lt_le_trans with m; Auto with arith. + red in |- *; intros; apply lt_le_trans with m; auto with arith. Qed. -Hints Resolve gt_trans_S le_gt_trans gt_le_trans : arith v62. +Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62. (** Comparison to 0 *) -Theorem gt_O_eq : (n:nat)((gt n O)\/(O=n)). +Theorem gt_O_eq : forall n, n > 0 \/ 0 = n. Proof. - Intro n ; Apply gt_S ; Auto with arith. + intro n; apply gt_S; auto with arith. Qed. (** Simplification and compatibility *) -Lemma simpl_gt_plus_l : (n,m,p:nat)(gt (plus p n) (plus p m))->(gt n m). +Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m. Proof. - Red; Intros n m p H; Apply simpl_lt_plus_l with p; Auto with arith. + red in |- *; intros n m p H; apply plus_lt_reg_l with p; auto with arith. Qed. -Lemma gt_reg_l : (n,m,p:nat)(gt n m)->(gt (plus p n) (plus p m)). +Lemma plus_gt_compat_l : forall n m p, n > m -> p + n > p + m. Proof. - Auto with arith. + auto with arith. Qed. -Hints Resolve gt_reg_l : arith v62. +Hint Resolve plus_gt_compat_l: arith v62.
\ No newline at end of file diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v index c80689836..d31104665 100755 --- a/theories/Arith/Le.v +++ b/theories/Arith/Le.v @@ -9,114 +9,114 @@ (*i $Id$ i*) (** Order on natural numbers *) -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,p:nat. +Implicit Types m n p : nat. (** Reflexivity *) -Theorem le_refl : (n:nat)(le n n). +Theorem le_refl : forall n, n <= n. Proof. -Exact le_n. +exact le_n. Qed. (** Transitivity *) -Theorem le_trans : (n,m,p:nat)(le n m)->(le m p)->(le n p). +Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p. Proof. - NewInduction 2; Auto. + induction 2; auto. Qed. -Hints Resolve le_trans : arith v62. +Hint Resolve le_trans: arith v62. (** Order, successor and predecessor *) -Theorem le_n_S : (n,m:nat)(le n m)->(le (S n) (S m)). +Theorem le_n_S : forall n m, n <= m -> S n <= S m. Proof. - NewInduction 1; Auto. + induction 1; auto. Qed. -Theorem le_n_Sn : (n:nat)(le n (S n)). +Theorem le_n_Sn : forall n, n <= S n. Proof. - Auto. + auto. Qed. -Theorem le_O_n : (n:nat)(le O n). +Theorem le_O_n : forall n, 0 <= n. Proof. - NewInduction n ; Auto. + induction n; auto. Qed. -Hints Resolve le_n_S le_n_Sn le_O_n le_n_S : arith v62. +Hint Resolve le_n_S le_n_Sn le_O_n le_n_S: arith v62. -Theorem le_pred_n : (n:nat)(le (pred n) n). +Theorem le_pred_n : forall n, pred n <= n. Proof. -NewInduction n ; Auto with arith. +induction n; auto with arith. Qed. -Hints Resolve le_pred_n : arith v62. +Hint Resolve le_pred_n: arith v62. -Theorem le_trans_S : (n,m:nat)(le (S n) m)->(le n m). +Theorem le_Sn_le : forall n m, S n <= m -> n <= m. Proof. -Intros n m H ; Apply le_trans with (S n); Auto with arith. +intros n m H; apply le_trans with (S n); auto with arith. Qed. -Hints Immediate le_trans_S : arith v62. +Hint Immediate le_Sn_le: arith v62. -Theorem le_S_n : (n,m:nat)(le (S n) (S m))->(le n m). +Theorem le_S_n : forall n m, S n <= S m -> n <= m. Proof. -Intros n m H ; Change (le (pred (S n)) (pred (S m))). -Elim H ; Simpl ; Auto with arith. +intros n m H; change (pred (S n) <= pred (S m)) in |- *. +elim H; simpl in |- *; auto with arith. Qed. -Hints Immediate le_S_n : arith v62. +Hint Immediate le_S_n: arith v62. -Theorem le_pred : (n,m:nat)(le n m)->(le (pred n) (pred m)). +Theorem le_pred : forall n m, n <= m -> pred n <= pred m. Proof. -NewInduction n as [|n IHn]. Simpl. Auto with arith. -NewDestruct m as [|m]. Simpl. Intro H. Inversion H. -Simpl. Auto with arith. +induction n as [| n IHn]. simpl in |- *. auto with arith. +destruct m as [| m]. simpl in |- *. intro H. inversion H. +simpl in |- *. auto with arith. Qed. (** Comparison to 0 *) -Theorem le_Sn_O : (n:nat)~(le (S n) O). +Theorem le_Sn_O : forall n, ~ S n <= 0. Proof. -Red ; Intros n H. -Change (IsSucc O) ; Elim H ; Simpl ; Auto with arith. +red in |- *; intros n H. +change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith. Qed. -Hints Resolve le_Sn_O : arith v62. +Hint Resolve le_Sn_O: arith v62. -Theorem le_n_O_eq : (n:nat)(le n O)->(O=n). +Theorem le_n_O_eq : forall n, n <= 0 -> 0 = n. Proof. -NewInduction n; Auto with arith. -Intro; Contradiction le_Sn_O with n. +induction n; auto with arith. +intro; contradiction le_Sn_O with n. Qed. -Hints Immediate le_n_O_eq : arith v62. +Hint Immediate le_n_O_eq: arith v62. (** Negative properties *) -Theorem le_Sn_n : (n:nat)~(le (S n) n). +Theorem le_Sn_n : forall n, ~ S n <= n. Proof. -NewInduction n; Auto with arith. +induction n; auto with arith. Qed. -Hints Resolve le_Sn_n : arith v62. +Hint Resolve le_Sn_n: arith v62. (** Antisymmetry *) -Theorem le_antisym : (n,m:nat)(le n m)->(le m n)->(n=m). +Theorem le_antisym : forall n m, n <= m -> m <= n -> n = m. Proof. -Intros n m h ; NewDestruct h as [|m0]; Auto with arith. -Intros H1. -Absurd (le (S m0) m0) ; Auto with arith. -Apply le_trans with n ; Auto with arith. +intros n m h; destruct h as [| m0 H]; auto with arith. +intros H1. +absurd (S m0 <= m0); auto with arith. +apply le_trans with n; auto with arith. Qed. -Hints Immediate le_antisym : arith v62. +Hint Immediate le_antisym: arith v62. (** A different elimination principle for the order on natural numbers *) -Lemma le_elim_rel : (P:nat->nat->Prop) - ((p:nat)(P O p))-> - ((p,q:nat)(le p q)->(P p q)->(P (S p) (S q)))-> - (n,m:nat)(le n m)->(P n m). +Lemma le_elim_rel : + forall P:nat -> nat -> Prop, + (forall p, P 0 p) -> + (forall p (q:nat), p <= q -> P p q -> P (S p) (S q)) -> + forall n m, n <= m -> P n m. Proof. -NewInduction n; Auto with arith. -Intros m Le. -Elim Le; Auto with arith. -Qed. +induction n; auto with arith. +intros m Le. +elim Le; auto with arith. +Qed.
\ No newline at end of file diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index 8c80e64c2..425087ea5 100755 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -8,169 +8,168 @@ (*i $Id$ i*) -Require Le. -V7only [Import nat_scope.]. +Require Import Le. Open Local Scope nat_scope. -Implicit Variables Type m,n,p:nat. +Implicit Types m n p : nat. (** Irreflexivity *) -Theorem lt_n_n : (n:nat)~(lt n n). +Theorem lt_irrefl : forall n, ~ n < n. Proof le_Sn_n. -Hints Resolve lt_n_n : arith v62. +Hint Resolve lt_irrefl: arith v62. (** Relationship between [le] and [lt] *) -Theorem lt_le_S : (n,p:nat)(lt n p)->(le (S n) p). +Theorem lt_le_S : forall n m, n < m -> S n <= m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Immediate lt_le_S : arith v62. +Hint Immediate lt_le_S: arith v62. -Theorem lt_n_Sm_le : (n,m:nat)(lt n (S m))->(le n m). +Theorem lt_n_Sm_le : forall n m, n < S m -> n <= m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Immediate lt_n_Sm_le : arith v62. +Hint Immediate lt_n_Sm_le: arith v62. -Theorem le_lt_n_Sm : (n,m:nat)(le n m)->(lt n (S m)). +Theorem le_lt_n_Sm : forall n m, n <= m -> n < S m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Immediate le_lt_n_Sm : arith v62. +Hint Immediate le_lt_n_Sm: arith v62. -Theorem le_not_lt : (n,m:nat)(le n m) -> ~(lt m n). +Theorem le_not_lt : forall n m, n <= m -> ~ m < n. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Theorem lt_not_le : (n,m:nat)(lt n m) -> ~(le m n). +Theorem lt_not_le : forall n m, n < m -> ~ m <= n. Proof. -Red; Intros n m Lt Le; Exact (le_not_lt m n Le Lt). +red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt). Qed. -Hints Immediate le_not_lt lt_not_le : arith v62. +Hint Immediate le_not_lt lt_not_le: arith v62. (** Asymmetry *) -Theorem lt_not_sym : (n,m:nat)(lt n m) -> ~(lt m n). +Theorem lt_asym : forall n m, n < m -> ~ m < n. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. (** Order and successor *) -Theorem lt_n_Sn : (n:nat)(lt n (S n)). +Theorem lt_n_Sn : forall n, n < S n. Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve lt_n_Sn : arith v62. +Hint Resolve lt_n_Sn: arith v62. -Theorem lt_S : (n,m:nat)(lt n m)->(lt n (S m)). +Theorem lt_S : forall n m, n < m -> n < S m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve lt_S : arith v62. +Hint Resolve lt_S: arith v62. -Theorem lt_n_S : (n,m:nat)(lt n m)->(lt (S n) (S m)). +Theorem lt_n_S : forall n m, n < m -> S n < S m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve lt_n_S : arith v62. +Hint Resolve lt_n_S: arith v62. -Theorem lt_S_n : (n,m:nat)(lt (S n) (S m))->(lt n m). +Theorem lt_S_n : forall n m, S n < S m -> n < m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Immediate lt_S_n : arith v62. +Hint Immediate lt_S_n: arith v62. -Theorem lt_O_Sn : (n:nat)(lt O (S n)). +Theorem lt_O_Sn : forall n, 0 < S n. Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve lt_O_Sn : arith v62. +Hint Resolve lt_O_Sn: arith v62. -Theorem lt_n_O : (n:nat)~(lt n O). +Theorem lt_n_O : forall n, ~ n < 0. Proof le_Sn_O. -Hints Resolve lt_n_O : arith v62. +Hint Resolve lt_n_O: arith v62. (** Predecessor *) -Lemma S_pred : (n,m:nat)(lt m n)->n=(S (pred n)). +Lemma S_pred : forall n m, m < n -> n = S (pred n). Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Lemma lt_pred : (n,p:nat)(lt (S n) p)->(lt n (pred p)). +Lemma lt_pred : forall n m, S n < m -> n < pred m. Proof. -NewInduction 1; Simpl; Auto with arith. +induction 1; simpl in |- *; auto with arith. Qed. -Hints Immediate lt_pred : arith v62. +Hint Immediate lt_pred: arith v62. -Lemma lt_pred_n_n : (n:nat)(lt O n)->(lt (pred n) n). -NewDestruct 1; Simpl; Auto with arith. +Lemma lt_pred_n_n : forall n, 0 < n -> pred n < n. +destruct 1; simpl in |- *; auto with arith. Qed. -Hints Resolve lt_pred_n_n : arith v62. +Hint Resolve lt_pred_n_n: arith v62. (** Transitivity properties *) -Theorem lt_trans : (n,m,p:nat)(lt n m)->(lt m p)->(lt n p). +Theorem lt_trans : forall n m p, n < m -> m < p -> n < p. Proof. -NewInduction 2; Auto with arith. +induction 2; auto with arith. Qed. -Theorem lt_le_trans : (n,m,p:nat)(lt n m)->(le m p)->(lt n p). +Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p. Proof. -NewInduction 2; Auto with arith. +induction 2; auto with arith. Qed. -Theorem le_lt_trans : (n,m,p:nat)(le n m)->(lt m p)->(lt n p). +Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p. Proof. -NewInduction 2; Auto with arith. +induction 2; auto with arith. Qed. -Hints Resolve lt_trans lt_le_trans le_lt_trans : arith v62. +Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62. (** Large = strict or equal *) -Theorem le_lt_or_eq : (n,m:nat)(le n m)->((lt n m) \/ n=m). +Theorem le_lt_or_eq : forall n m, n <= m -> n < m \/ n = m. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Theorem lt_le_weak : (n,m:nat)(lt n m)->(le n m). +Theorem lt_le_weak : forall n m, n < m -> n <= m. Proof. -Auto with arith. +auto with arith. Qed. -Hints Immediate lt_le_weak : arith v62. +Hint Immediate lt_le_weak: arith v62. (** Dichotomy *) -Theorem le_or_lt : (n,m:nat)((le n m)\/(lt m n)). +Theorem le_or_lt : forall n m, n <= m \/ m < n. Proof. -Intros n m; Pattern n m; Apply nat_double_ind; Auto with arith. -NewInduction 1; Auto with arith. +intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith. +induction 1; auto with arith. Qed. -Theorem nat_total_order: (m,n: nat) ~ m = n -> (lt m n) \/ (lt n m). +Theorem nat_total_order : forall n m, n <> m -> n < m \/ m < n. Proof. -Intros m n diff. -Elim (le_or_lt n m); [Intro H'0 | Auto with arith]. -Elim (le_lt_or_eq n m); Auto with arith. -Intro H'; Elim diff; Auto with arith. +intros m n diff. +elim (le_or_lt n m); [ intro H'0 | auto with arith ]. +elim (le_lt_or_eq n m); auto with arith. +intro H'; elim diff; auto with arith. Qed. (** Comparison to 0 *) -Theorem neq_O_lt : (n:nat)(~O=n)->(lt O n). +Theorem neq_O_lt : forall n, 0 <> n -> 0 < n. Proof. -NewInduction n; Auto with arith. -Intros; Absurd O=O; Trivial with arith. +induction n; auto with arith. +intros; absurd (0 = 0); trivial with arith. Qed. -Hints Immediate neq_O_lt : arith v62. +Hint Immediate neq_O_lt: arith v62. -Theorem lt_O_neq : (n:nat)(lt O n)->(~O=n). +Theorem lt_O_neq : forall n, 0 < n -> 0 <> n. Proof. -NewInduction 1; Auto with arith. +induction 1; auto with arith. Qed. -Hints Immediate lt_O_neq : arith v62. +Hint Immediate lt_O_neq: arith v62.
\ No newline at end of file diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v index ac8ff97a1..c915c0690 100755 --- a/theories/Arith/Max.v +++ b/theories/Arith/Max.v @@ -8,80 +8,78 @@ (*i $Id$ i*) -Require Arith. +Require Import Arith. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n:nat. +Implicit Types m n : nat. (** maximum of two natural numbers *) -Fixpoint max [n:nat] : nat -> nat := -[m:nat]Cases n m of - O _ => m - | (S n') O => n - | (S n') (S m') => (S (max n' m')) - end. +Fixpoint max n m {struct n} : nat := + match n, m with + | O, _ => m + | S n', O => n + | S n', S m' => S (max n' m') + end. (** Simplifications of [max] *) -Lemma max_SS : (n,m:nat)((S (max n m))=(max (S n) (S m))). +Lemma max_SS : forall n m, S (max n m) = max (S n) (S m). Proof. -Auto with arith. +auto with arith. Qed. -Lemma max_sym : (n,m:nat)(max n m)=(max m n). +Lemma max_comm : forall n m, max n m = max m n. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. +induction n; induction m; simpl in |- *; auto with arith. Qed. (** [max] and [le] *) -Lemma max_l : (n,m:nat)(le m n)->(max n m)=n. +Lemma max_l : forall n m, m <= n -> max n m = n. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. +induction n; induction m; simpl in |- *; auto with arith. Qed. -Lemma max_r : (n,m:nat)(le n m)->(max n m)=m. +Lemma max_r : forall n m, n <= m -> max n m = m. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. +induction n; induction m; simpl in |- *; auto with arith. Qed. -Lemma le_max_l : (n,m:nat)(le n (max n m)). +Lemma le_max_l : forall n m, n <= max n m. Proof. -NewInduction n; Intros; Simpl; Auto with arith. -Elim m; Intros; Simpl; Auto with arith. +induction n; intros; simpl in |- *; auto with arith. +elim m; intros; simpl in |- *; auto with arith. Qed. -Lemma le_max_r : (n,m:nat)(le m (max n m)). +Lemma le_max_r : forall n m, m <= max n m. Proof. -NewInduction n; Simpl; Auto with arith. -NewInduction m; Simpl; Auto with arith. +induction n; simpl in |- *; auto with arith. +induction m; simpl in |- *; auto with arith. Qed. -Hints Resolve max_r max_l le_max_l le_max_r: arith v62. +Hint Resolve max_r max_l le_max_l le_max_r: arith v62. (** [max n m] is equal to [n] or [m] *) -Lemma max_dec : (n,m:nat){(max n m)=n}+{(max n m)=m}. +Lemma max_dec : forall n m, {max n m = n} + {max n m = m}. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. -Elim (IHn m);Intro H;Elim H;Auto. +induction n; induction m; simpl in |- *; auto with arith. +elim (IHn m); intro H; elim H; auto. Qed. -Lemma max_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (max n m)). +Lemma max_case : forall n m (P:nat -> Set), P n -> P m -> P (max n m). Proof. -NewInduction n; Simpl; Auto with arith. -NewInduction m; Intros; Simpl; Auto with arith. -Pattern (max n m); Apply IHn ; Auto with arith. +induction n; simpl in |- *; auto with arith. +induction m; intros; simpl in |- *; auto with arith. +pattern (max n m) in |- *; apply IHn; auto with arith. Qed. -Lemma max_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (max n m)). +Lemma max_case2 : forall n m (P:nat -> Prop), P n -> P m -> P (max n m). Proof. -NewInduction n; Simpl; Auto with arith. -NewInduction m; Intros; Simpl; Auto with arith. -Pattern (max n m); Apply IHn ; Auto with arith. +induction n; simpl in |- *; auto with arith. +induction m; intros; simpl in |- *; auto with arith. +pattern (max n m) in |- *; apply IHn; auto with arith. Qed. - diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v index 81559526b..18fba26a2 100755 --- a/theories/Arith/Min.v +++ b/theories/Arith/Min.v @@ -8,77 +8,76 @@ (*i $Id$ i*) -Require Arith. +Require Import Arith. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n:nat. +Implicit Types m n : nat. (** minimum of two natural numbers *) -Fixpoint min [n:nat] : nat -> nat := -[m:nat]Cases n m of - O _ => O - | (S n') O => O - | (S n') (S m') => (S (min n' m')) - end. +Fixpoint min n m {struct n} : nat := + match n, m with + | O, _ => 0 + | S n', O => 0 + | S n', S m' => S (min n' m') + end. (** Simplifications of [min] *) -Lemma min_SS : (n,m:nat)((S (min n m))=(min (S n) (S m))). +Lemma min_SS : forall n m, S (min n m) = min (S n) (S m). Proof. -Auto with arith. +auto with arith. Qed. -Lemma min_sym : (n,m:nat)(min n m)=(min m n). +Lemma min_comm : forall n m, min n m = min m n. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. +induction n; induction m; simpl in |- *; auto with arith. Qed. (** [min] and [le] *) -Lemma min_l : (n,m:nat)(le n m)->(min n m)=n. +Lemma min_l : forall n m, n <= m -> min n m = n. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. +induction n; induction m; simpl in |- *; auto with arith. Qed. -Lemma min_r : (n,m:nat)(le m n)->(min n m)=m. +Lemma min_r : forall n m, m <= n -> min n m = m. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. +induction n; induction m; simpl in |- *; auto with arith. Qed. -Lemma le_min_l : (n,m:nat)(le (min n m) n). +Lemma le_min_l : forall n m, min n m <= n. Proof. -NewInduction n; Intros; Simpl; Auto with arith. -Elim m; Intros; Simpl; Auto with arith. +induction n; intros; simpl in |- *; auto with arith. +elim m; intros; simpl in |- *; auto with arith. Qed. -Lemma le_min_r : (n,m:nat)(le (min n m) m). +Lemma le_min_r : forall n m, min n m <= m. Proof. -NewInduction n; Simpl; Auto with arith. -NewInduction m; Simpl; Auto with arith. +induction n; simpl in |- *; auto with arith. +induction m; simpl in |- *; auto with arith. Qed. -Hints Resolve min_l min_r le_min_l le_min_r : arith v62. +Hint Resolve min_l min_r le_min_l le_min_r: arith v62. (** [min n m] is equal to [n] or [m] *) -Lemma min_dec : (n,m:nat){(min n m)=n}+{(min n m)=m}. +Lemma min_dec : forall n m, {min n m = n} + {min n m = m}. Proof. -NewInduction n;NewInduction m;Simpl;Auto with arith. -Elim (IHn m);Intro H;Elim H;Auto. +induction n; induction m; simpl in |- *; auto with arith. +elim (IHn m); intro H; elim H; auto. Qed. -Lemma min_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (min n m)). +Lemma min_case : forall n m (P:nat -> Set), P n -> P m -> P (min n m). Proof. -NewInduction n; Simpl; Auto with arith. -NewInduction m; Intros; Simpl; Auto with arith. -Pattern (min n m); Apply IHn ; Auto with arith. +induction n; simpl in |- *; auto with arith. +induction m; intros; simpl in |- *; auto with arith. +pattern (min n m) in |- *; apply IHn; auto with arith. Qed. -Lemma min_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (min n m)). +Lemma min_case2 : forall n m (P:nat -> Prop), P n -> P m -> P (min n m). Proof. -NewInduction n; Simpl; Auto with arith. -NewInduction m; Intros; Simpl; Auto with arith. -Pattern (min n m); Apply IHn ; Auto with arith. -Qed. +induction n; simpl in |- *; auto with arith. +induction m; intros; simpl in |- *; auto with arith. +pattern (min n m) in |- *; apply IHn; auto with arith. +Qed.
\ No newline at end of file diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index 658c25194..783c494a2 100755 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -10,111 +10,114 @@ (** Subtraction (difference between two natural numbers) *) -Require Lt. -Require Le. +Require Import Lt. +Require Import Le. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,p:nat. +Implicit Types m n p : nat. (** 0 is right neutral *) -Lemma minus_n_O : (n:nat)(n=(minus n O)). +Lemma minus_n_O : forall n, n = n - 0. Proof. -NewInduction n; Simpl; Auto with arith. +induction n; simpl in |- *; auto with arith. Qed. -Hints Resolve minus_n_O : arith v62. +Hint Resolve minus_n_O: arith v62. (** Permutation with successor *) -Lemma minus_Sn_m : (n,m:nat)(le m n)->((S (minus n m))=(minus (S n) m)). +Lemma minus_Sn_m : forall n m, m <= n -> S (n - m) = S n - m. Proof. -Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith. +intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *; + auto with arith. Qed. -Hints Resolve minus_Sn_m : arith v62. +Hint Resolve minus_Sn_m: arith v62. -Theorem pred_of_minus : (x:nat)(pred x)=(minus x (S O)). -Intro x; NewInduction x; Simpl; Auto with arith. +Theorem pred_of_minus : forall n, pred n = n - 1. +intro x; induction x; simpl in |- *; auto with arith. Qed. (** Diagonal *) -Lemma minus_n_n : (n:nat)(O=(minus n n)). +Lemma minus_n_n : forall n, 0 = n - n. Proof. -NewInduction n; Simpl; Auto with arith. +induction n; simpl in |- *; auto with arith. Qed. -Hints Resolve minus_n_n : arith v62. +Hint Resolve minus_n_n: arith v62. (** Simplification *) -Lemma minus_plus_simpl : - (n,m,p:nat)((minus n m)=(minus (plus p n) (plus p m))). +Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m). Proof. - NewInduction p; Simpl; Auto with arith. + induction p; simpl in |- *; auto with arith. Qed. -Hints Resolve minus_plus_simpl : arith v62. +Hint Resolve minus_plus_simpl_l_reverse: arith v62. (** Relation with plus *) -Lemma plus_minus : (n,m,p:nat)(n=(plus m p))->(p=(minus n m)). +Lemma plus_minus : forall n m p, n = m + p -> p = n - m. Proof. -Intros n m p; Pattern m n; Apply nat_double_ind; Simpl; Intros. -Replace (minus n0 O) with n0; Auto with arith. -Absurd O=(S (plus n0 p)); Auto with arith. -Auto with arith. +intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *; + intros. +replace (n0 - 0) with n0; auto with arith. +absurd (0 = S (n0 + p)); auto with arith. +auto with arith. Qed. -Hints Immediate plus_minus : arith v62. +Hint Immediate plus_minus: arith v62. -Lemma minus_plus : (n,m:nat)(minus (plus n m) n)=m. -Symmetry; Auto with arith. +Lemma minus_plus : forall n m, n + m - n = m. +symmetry in |- *; auto with arith. Qed. -Hints Resolve minus_plus : arith v62. +Hint Resolve minus_plus: arith v62. -Lemma le_plus_minus : (n,m:nat)(le n m)->(m=(plus n (minus m n))). +Lemma le_plus_minus : forall n m, n <= m -> m = n + (m - n). Proof. -Intros n m Le; Pattern n m; Apply le_elim_rel; Simpl; Auto with arith. +intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *; + auto with arith. Qed. -Hints Resolve le_plus_minus : arith v62. +Hint Resolve le_plus_minus: arith v62. -Lemma le_plus_minus_r : (n,m:nat)(le n m)->(plus n (minus m n))=m. +Lemma le_plus_minus_r : forall n m, n <= m -> n + (m - n) = m. Proof. -Symmetry; Auto with arith. +symmetry in |- *; auto with arith. Qed. -Hints Resolve le_plus_minus_r : arith v62. +Hint Resolve le_plus_minus_r: arith v62. (** Relation with order *) -Theorem le_minus: (i,h:nat) (le (minus i h) i). +Theorem le_minus : forall n m, n - m <= n. Proof. -Intros i h;Pattern i h; Apply nat_double_ind; [ - Auto -| Auto -| Intros m n H; Simpl; Apply le_trans with m:=m; Auto ]. +intros i h; pattern i, h in |- *; apply nat_double_ind; + [ auto + | auto + | intros m n H; simpl in |- *; apply le_trans with (m := m); auto ]. Qed. -Lemma lt_minus : (n,m:nat)(le m n)->(lt O m)->(lt (minus n m) n). +Lemma lt_minus : forall n m, m <= n -> 0 < m -> n - m < n. Proof. -Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith. -Intros; Absurd (lt O O); Auto with arith. -Intros p q lepq Hp gtp. -Elim (le_lt_or_eq O p); Auto with arith. -Auto with arith. -NewInduction 1; Elim minus_n_O; Auto with arith. +intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *; + auto with arith. +intros; absurd (0 < 0); auto with arith. +intros p q lepq Hp gtp. +elim (le_lt_or_eq 0 p); auto with arith. +auto with arith. +induction 1; elim minus_n_O; auto with arith. Qed. -Hints Resolve lt_minus : arith v62. +Hint Resolve lt_minus: arith v62. -Lemma lt_O_minus_lt : (n,m:nat)(lt O (minus n m))->(lt m n). +Lemma lt_O_minus_lt : forall n m, 0 < n - m -> m < n. Proof. -Intros n m; Pattern n m; Apply nat_double_ind; Simpl; Auto with arith. -Intros; Absurd (lt O O); Trivial with arith. -Qed. -Hints Immediate lt_O_minus_lt : arith v62. - -Theorem inj_minus_aux: (x,y:nat) ~(le y x) -> (minus x y) = O. -Intros y x; Pattern y x ; Apply nat_double_ind; [ - Simpl; Trivial with arith -| Intros n H; Absurd (le O (S n)); [ Assumption | Apply le_O_n] -| Simpl; Intros n m H1 H2; Apply H1; - Unfold not ; Intros H3; Apply H2; Apply le_n_S; Assumption]. +intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; + auto with arith. +intros; absurd (0 < 0); trivial with arith. Qed. +Hint Immediate lt_O_minus_lt: arith v62. + +Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0. +intros y x; pattern y, x in |- *; apply nat_double_ind; + [ simpl in |- *; trivial with arith + | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ] + | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3; + apply H2; apply le_n_S; assumption ]. +Qed.
\ No newline at end of file diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index eb36ffa24..49fcb06e0 100755 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -13,178 +13,166 @@ Require Export Minus. Require Export Lt. Require Export Le. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,p:nat. +Implicit Types m n p : nat. (** Zero property *) -Lemma mult_0_r : (n:nat) (mult n O)=O. +Lemma mult_0_r : forall n, n * 0 = 0. Proof. -Intro; Symmetry; Apply mult_n_O. +intro; symmetry in |- *; apply mult_n_O. Qed. -Lemma mult_0_l : (n:nat) (mult O n)=O. +Lemma mult_0_l : forall n, 0 * n = 0. Proof. -Reflexivity. +reflexivity. Qed. (** Distributivity *) -Lemma mult_plus_distr : - (n,m,p:nat)((mult (plus n m) p)=(plus (mult n p) (mult m p))). +Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p. Proof. -Intros; Elim n; Simpl; Intros; Auto with arith. -Elim plus_assoc_l; Elim H; Auto with arith. +intros; elim n; simpl in |- *; intros; auto with arith. +elim plus_assoc; elim H; auto with arith. Qed. -Hints Resolve mult_plus_distr : arith v62. +Hint Resolve mult_plus_distr_r: arith v62. -Lemma mult_plus_distr_r : (n,m,p:nat) (mult n (plus m p))=(plus (mult n m) (mult n p)). +Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p. Proof. - NewInduction n. Trivial. - Intros. Simpl. Rewrite (IHn m p). Apply sym_eq. Apply plus_permute_2_in_4. + induction n. trivial. + intros. simpl in |- *. rewrite (IHn m p). apply sym_eq. apply plus_permute_2_in_4. Qed. -Lemma mult_minus_distr : (n,m,p:nat)((mult (minus n m) p)=(minus (mult n p) (mult m p))). +Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p. Proof. -Intros; Pattern n m; Apply nat_double_ind; Simpl; Intros; Auto with arith. -Elim minus_plus_simpl; Auto with arith. +intros; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; intros; + auto with arith. +elim minus_plus_simpl_l_reverse; auto with arith. Qed. -Hints Resolve mult_minus_distr : arith v62. +Hint Resolve mult_minus_distr_r: arith v62. (** Associativity *) -Lemma mult_assoc_r : (n,m,p:nat)((mult (mult n m) p) = (mult n (mult m p))). +Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p). Proof. -Intros; Elim n; Intros; Simpl; Auto with arith. -Rewrite mult_plus_distr. -Elim H; Auto with arith. +intros; elim n; intros; simpl in |- *; auto with arith. +rewrite mult_plus_distr_r. +elim H; auto with arith. Qed. -Hints Resolve mult_assoc_r : arith v62. +Hint Resolve mult_assoc_reverse: arith v62. -Lemma mult_assoc_l : (n,m,p:nat)(mult n (mult m p)) = (mult (mult n m) p). +Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p. Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve mult_assoc_l : arith v62. +Hint Resolve mult_assoc: arith v62. (** Commutativity *) -Lemma mult_sym : (n,m:nat)(mult n m)=(mult m n). +Lemma mult_comm : forall n m, n * m = m * n. Proof. -Intros; Elim n; Intros; Simpl; Auto with arith. -Elim mult_n_Sm. -Elim H; Apply plus_sym. +intros; elim n; intros; simpl in |- *; auto with arith. +elim mult_n_Sm. +elim H; apply plus_comm. Qed. -Hints Resolve mult_sym : arith v62. +Hint Resolve mult_comm: arith v62. (** 1 is neutral *) -Lemma mult_1_n : (n:nat)(mult (S O) n)=n. +Lemma mult_1_l : forall n, 1 * n = n. Proof. -Simpl; Auto with arith. +simpl in |- *; auto with arith. Qed. -Hints Resolve mult_1_n : arith v62. +Hint Resolve mult_1_l: arith v62. -Lemma mult_n_1 : (n:nat)(mult n (S O))=n. +Lemma mult_1_r : forall n, n * 1 = n. Proof. -Intro; Elim mult_sym; Auto with arith. +intro; elim mult_comm; auto with arith. Qed. -Hints Resolve mult_n_1 : arith v62. +Hint Resolve mult_1_r: arith v62. (** Compatibility with orders *) -Lemma mult_O_le : (n,m:nat)(m=O)\/(le n (mult m n)). +Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n. Proof. -NewInduction m; Simpl; Auto with arith. +induction m; simpl in |- *; auto with arith. Qed. -Hints Resolve mult_O_le : arith v62. +Hint Resolve mult_O_le: arith v62. -Lemma mult_le_compat_l : (n,m,p:nat) (le n m) -> (le (mult p n) (mult p m)). +Lemma mult_le_compat_l : forall n m p, n <= m -> p * n <= p * m. Proof. - NewInduction p as [|p IHp]. Intros. Simpl. Apply le_n. - Intros. Simpl. Apply le_plus_plus. Assumption. - Apply IHp. Assumption. + induction p as [| p IHp]. intros. simpl in |- *. apply le_n. + intros. simpl in |- *. apply plus_le_compat. assumption. + apply IHp. assumption. Qed. -Hints Resolve mult_le_compat_l : arith. -V7only [ -Notation mult_le := [m,n,p:nat](mult_le_compat_l p n m). -]. +Hint Resolve mult_le_compat_l: arith. -Lemma le_mult_right : (m,n,p:nat)(le m n)->(le (mult m p) (mult n p)). -Intros m n p H. -Rewrite mult_sym. Rewrite (mult_sym n). -Auto with arith. +Lemma mult_le_compat_r : forall n m p, n <= m -> n * p <= m * p. +intros m n p H. +rewrite mult_comm. rewrite (mult_comm n). +auto with arith. Qed. -Lemma le_mult_mult : - (m,n,p,q:nat)(le m n)->(le p q)->(le (mult m p) (mult n q)). +Lemma mult_le_compat : + forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q. Proof. -Intros m n p q Hmn Hpq; NewInduction Hmn. -NewInduction Hpq. +intros m n p q Hmn Hpq; induction Hmn. +induction Hpq. (* m*p<=m*p *) -Apply le_n. +apply le_n. (* m*p<=m*m0 -> m*p<=m*(S m0) *) -Rewrite <- mult_n_Sm; Apply le_trans with (mult m m0). -Assumption. -Apply le_plus_l. +rewrite <- mult_n_Sm; apply le_trans with (m * m0). +assumption. +apply le_plus_l. (* m*p<=m0*q -> m*p<=(S m0)*q *) -Simpl; Apply le_trans with (mult m0 q). -Assumption. -Apply le_plus_r. +simpl in |- *; apply le_trans with (m0 * q). +assumption. +apply le_plus_r. Qed. -Lemma mult_lt : (m,n,p:nat) (lt n p) -> (lt (mult (S m) n) (mult (S m) p)). +Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p. Proof. - Intro m; NewInduction m. Intros. Simpl. Rewrite <- plus_n_O. Rewrite <- plus_n_O. Assumption. - Intros. Exact (lt_plus_plus ? ? ? ? H (IHm ? ? H)). + intro m; induction m. intros. simpl in |- *. rewrite <- plus_n_O. rewrite <- plus_n_O. assumption. + intros. exact (plus_lt_compat _ _ _ _ H (IHm _ _ H)). Qed. -Hints Resolve mult_lt : arith. -V7only [ -Notation lt_mult_left := mult_lt. -(* Theorem lt_mult_left : - (x,y,z:nat) (lt x y) -> (lt (mult (S z) x) (mult (S z) y)). -*) -]. +Hint Resolve mult_S_lt_compat_l: arith. -Lemma lt_mult_right : - (m,n,p:nat) (lt m n) -> (lt (0) p) -> (lt (mult m p) (mult n p)). -Intros m n p H H0. -NewInduction p. -Elim (lt_n_n ? H0). -Rewrite mult_sym. -Replace (mult n (S p)) with (mult (S p) n); Auto with arith. +Lemma mult_lt_compat_r : forall n m p, n < m -> 0 < p -> n * p < m * p. +intros m n p H H0. +induction p. +elim (lt_irrefl _ H0). +rewrite mult_comm. +replace (n * S p) with (S p * n); auto with arith. Qed. -Lemma mult_le_conv_1 : (m,n,p:nat) (le (mult (S m) n) (mult (S m) p)) -> (le n p). +Lemma mult_S_le_reg_l : forall n m p, S n * m <= S n * p -> m <= p. Proof. - Intros m n p H. Elim (le_or_lt n p). Trivial. - Intro H0. Cut (lt (mult (S m) n) (mult (S m) n)). Intro. Elim (lt_n_n ? H1). - Apply le_lt_trans with m:=(mult (S m) p). Assumption. - Apply mult_lt. Assumption. + intros m n p H. elim (le_or_lt n p). trivial. + intro H0. cut (S m * n < S m * n). intro. elim (lt_irrefl _ H1). + apply le_lt_trans with (m := S m * p). assumption. + apply mult_S_lt_compat_l. assumption. Qed. (** n|->2*n and n|->2n+1 have disjoint image *) -V7only [ (* From Zdivides *) ]. -Theorem odd_even_lem: - (p, q : ?) ~ (plus (mult (2) p) (1)) = (mult (2) q). -Intros p; Elim p; Auto. -Intros q; Case q; Simpl. -Red; Intros; Discriminate. -Intros q'; Rewrite [x, y : ?] (plus_sym x (S y)); Simpl; Red; Intros; - Discriminate. -Intros p' H q; Case q. -Simpl; Red; Intros; Discriminate. -Intros q'; Red; Intros H0; Case (H q'). -Replace (mult (S (S O)) q') with (minus (mult (S (S O)) (S q')) (2)). -Rewrite <- H0; Simpl; Auto. -Repeat Rewrite [x, y : ?] (plus_sym x (S y)); Simpl; Auto. -Simpl; Repeat Rewrite [x, y : ?] (plus_sym x (S y)); Simpl; Auto. -Case q'; Simpl; Auto. +Theorem odd_even_lem : forall p q, 2 * p + 1 <> 2 * q. +intros p; elim p; auto. +intros q; case q; simpl in |- *. +red in |- *; intros; discriminate. +intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *; + intros; discriminate. +intros p' H q; case q. +simpl in |- *; red in |- *; intros; discriminate. +intros q'; red in |- *; intros H0; case (H q'). +replace (2 * q') with (2 * S q' - 2). +rewrite <- H0; simpl in |- *; auto. +repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto. +simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; + auto. +case q'; simpl in |- *; auto. Qed. @@ -194,31 +182,30 @@ Qed. tail-recursive, whereas [mult] is not. This can be useful when extracting programs. *) -Fixpoint mult_acc [s,m,n:nat] : nat := - Cases n of - O => s - | (S p) => (mult_acc (tail_plus m s) m p) - end. +Fixpoint mult_acc (s:nat) m n {struct n} : nat := + match n with + | O => s + | S p => mult_acc (tail_plus m s) m p + end. -Lemma mult_acc_aux : (n,s,m:nat)(plus s (mult n m))= (mult_acc s m n). +Lemma mult_acc_aux : forall n m p, m + n * p = mult_acc m p n. Proof. -NewInduction n as [|p IHp]; Simpl;Auto. -Intros s m; Rewrite <- plus_tail_plus; Rewrite <- IHp. -Rewrite <- plus_assoc_r; Apply (f_equal2 nat nat);Auto. -Rewrite plus_sym;Auto. +induction n as [| p IHp]; simpl in |- *; auto. +intros s m; rewrite <- plus_tail_plus; rewrite <- IHp. +rewrite <- plus_assoc_reverse; apply (f_equal2 (A1:=nat) (A2:=nat)); auto. +rewrite plus_comm; auto. Qed. -Definition tail_mult := [n,m:nat](mult_acc O m n). +Definition tail_mult n m := mult_acc 0 m n. -Lemma mult_tail_mult : (n,m:nat)(mult n m)=(tail_mult n m). +Lemma mult_tail_mult : forall n m, n * m = tail_mult n m. Proof. -Intros; Unfold tail_mult; Rewrite <- mult_acc_aux;Auto. +intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto. Qed. (** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] and [mult] and simplify *) -Tactic Definition TailSimpl := - Repeat Rewrite <- plus_tail_plus; - Repeat Rewrite <- mult_tail_mult; - Simpl. +Ltac tail_simpl := + repeat rewrite <- plus_tail_plus; repeat rewrite <- mult_tail_mult; + simpl in |- *.
\ No newline at end of file diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v index 96a8523f9..4d657d060 100755 --- a/theories/Arith/Peano_dec.v +++ b/theories/Arith/Peano_dec.v @@ -8,29 +8,27 @@ (*i $Id$ i*) -Require Decidable. +Require Import Decidable. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,x,y:nat. +Implicit Types m n x y : nat. -Theorem O_or_S : (n:nat)({m:nat|(S m)=n})+{O=n}. +Theorem O_or_S : forall n, {m : nat | S m = n} + {0 = n}. Proof. -NewInduction n. -Auto. -Left; Exists n; Auto. +induction n. +auto. +left; exists n; auto. Defined. -Theorem eq_nat_dec : (n,m:nat){n=m}+{~(n=m)}. +Theorem eq_nat_dec : forall n m, {n = m} + {n <> m}. Proof. -NewInduction n; NewInduction m; Auto. -Elim (IHn m); Auto. +induction n; induction m; auto. +elim (IHn m); auto. Defined. -Hints Resolve O_or_S eq_nat_dec : arith. +Hint Resolve O_or_S eq_nat_dec: arith. -Theorem dec_eq_nat:(x,y:nat)(decidable (x=y)). -Intros x y; Unfold decidable; Elim (eq_nat_dec x y); Auto with 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. Defined. - diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v index ffa94fcd0..496ac3330 100755 --- a/theories/Arith/Plus.v +++ b/theories/Arith/Plus.v @@ -10,183 +10,176 @@ (** Properties of addition *) -Require Le. -Require Lt. +Require Import Le. +Require Import Lt. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,p,q:nat. +Implicit Types m n p q : nat. (** Zero is neutral *) -Lemma plus_0_l : (n:nat) (O+n)=n. +Lemma plus_0_l : forall n, 0 + n = n. Proof. -Reflexivity. +reflexivity. Qed. -Lemma plus_0_r : (n:nat) (n+O)=n. +Lemma plus_0_r : forall n, n + 0 = n. Proof. -Intro; Symmetry; Apply plus_n_O. +intro; symmetry in |- *; apply plus_n_O. Qed. (** Commutativity *) -Lemma plus_sym : (n,m:nat)(n+m)=(m+n). +Lemma plus_comm : forall n m, n + m = m + n. Proof. -Intros n m ; Elim n ; Simpl ; Auto with arith. -Intros y H ; Elim (plus_n_Sm m y) ; Auto with arith. +intros n m; elim n; simpl in |- *; auto with arith. +intros y H; elim (plus_n_Sm m y); auto with arith. Qed. -Hints Immediate plus_sym : arith v62. +Hint Immediate plus_comm: arith v62. (** Associativity *) -Lemma plus_Snm_nSm : (n,m:nat)((S n)+m)=(n+(S m)). -Intros. -Simpl. -Rewrite -> (plus_sym n m). -Rewrite -> (plus_sym n (S m)). -Trivial with arith. +Lemma plus_Snm_nSm : forall n m, S n + m = n + S m. +intros. +simpl in |- *. +rewrite (plus_comm n m). +rewrite (plus_comm n (S m)). +trivial with arith. Qed. -Lemma plus_assoc_l : (n,m,p:nat)((n+(m+p))=((n+m)+p)). +Lemma plus_assoc : forall n m p, n + (m + p) = n + m + p. Proof. -Intros n m p; Elim n; Simpl; Auto with arith. +intros n m p; elim n; simpl in |- *; auto with arith. Qed. -Hints Resolve plus_assoc_l : arith v62. +Hint Resolve plus_assoc: arith v62. -Lemma plus_permute : (n,m,p:nat) ((n+(m+p))=(m+(n+p))). +Lemma plus_permute : forall n m p, n + (m + p) = m + (n + p). Proof. -Intros; Rewrite (plus_assoc_l m n p); Rewrite (plus_sym m n); Auto with arith. +intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith. Qed. -Lemma plus_assoc_r : (n,m,p:nat)(((n+m)+p)=(n+(m+p))). +Lemma plus_assoc_reverse : forall n m p, n + m + p = n + (m + p). Proof. -Auto with arith. +auto with arith. Qed. -Hints Resolve plus_assoc_r : arith v62. +Hint Resolve plus_assoc_reverse: arith v62. (** Simplification *) -Lemma plus_reg_l : (n,m,p:nat)((p+n)=(p+m))->(n=m). +Lemma plus_reg_l : forall n m p, p + n = p + m -> n = m. Proof. -Intros m p n; NewInduction n ; Simpl ; Auto with arith. +intros m p n; induction n; simpl in |- *; auto with arith. Qed. -V7only [ -Notation simpl_plus_l := [n,m,p:nat](plus_reg_l m p n). -]. -Lemma plus_le_reg_l : (n,m,p:nat) (p+n)<=(p+m) -> n<=m. +Lemma plus_le_reg_l : forall n m p, p + n <= p + m -> n <= m. Proof. -NewInduction p; Simpl; Auto with arith. +induction p; simpl in |- *; auto with arith. Qed. -V7only [ -Notation simpl_le_plus_l := [p,n,m:nat](plus_le_reg_l n m p). -]. -Lemma simpl_lt_plus_l : (n,m,p:nat) (p+n)<(p+m) -> n<m. +Lemma plus_lt_reg_l : forall n m p, p + n < p + m -> n < m. Proof. -NewInduction p; Simpl; Auto with arith. +induction p; simpl in |- *; auto with arith. Qed. (** Compatibility with order *) -Lemma le_reg_l : (n,m,p:nat) n<=m -> (p+n)<=(p+m). +Lemma plus_le_compat_l : forall n m p, n <= m -> p + n <= p + m. Proof. -NewInduction p; Simpl; Auto with arith. +induction p; simpl in |- *; auto with arith. Qed. -Hints Resolve le_reg_l : arith v62. +Hint Resolve plus_le_compat_l: arith v62. -Lemma le_reg_r : (a,b,c:nat) a<=b -> (a+c)<=(b+c). +Lemma plus_le_compat_r : forall n m p, n <= m -> n + p <= m + p. Proof. -NewInduction 1 ; Simpl; Auto with arith. +induction 1; simpl in |- *; auto with arith. Qed. -Hints Resolve le_reg_r : arith v62. +Hint Resolve plus_le_compat_r: arith v62. -Lemma le_plus_l : (n,m:nat) n<=(n+m). +Lemma le_plus_l : forall n m, n <= n + m. Proof. -NewInduction n; Simpl; Auto with arith. +induction n; simpl in |- *; auto with arith. Qed. -Hints Resolve le_plus_l : arith v62. +Hint Resolve le_plus_l: arith v62. -Lemma le_plus_r : (n,m:nat) m<=(n+m). +Lemma le_plus_r : forall n m, m <= n + m. Proof. -Intros n m; Elim n; Simpl; Auto with arith. +intros n m; elim n; simpl in |- *; auto with arith. Qed. -Hints Resolve le_plus_r : arith v62. +Hint Resolve le_plus_r: arith v62. -Theorem le_plus_trans : (n,m,p:nat) n<=m -> n<=(m+p). +Theorem le_plus_trans : forall n m p, n <= m -> n <= m + p. Proof. -Intros; Apply le_trans with m:=m; Auto with arith. +intros; apply le_trans with (m := m); auto with arith. Qed. -Hints Resolve le_plus_trans : arith v62. +Hint Resolve le_plus_trans: arith v62. -Theorem lt_plus_trans : (n,m,p:nat) n<m -> n<(m+p). +Theorem lt_plus_trans : forall n m p, n < m -> n < m + p. Proof. -Intros; Apply lt_le_trans with m:=m; Auto with arith. +intros; apply lt_le_trans with (m := m); auto with arith. Qed. -Hints Immediate lt_plus_trans : arith v62. +Hint Immediate lt_plus_trans: arith v62. -Lemma lt_reg_l : (n,m,p:nat) n<m -> (p+n)<(p+m). +Lemma plus_lt_compat_l : forall n m p, n < m -> p + n < p + m. Proof. -NewInduction p; Simpl; Auto with arith. +induction p; simpl in |- *; auto with arith. Qed. -Hints Resolve lt_reg_l : arith v62. +Hint Resolve plus_lt_compat_l: arith v62. -Lemma lt_reg_r : (n,m,p:nat) n<m -> (n+p)<(m+p). +Lemma plus_lt_compat_r : forall n m p, n < m -> n + p < m + p. Proof. -Intros n m p H ; Rewrite (plus_sym n p) ; Rewrite (plus_sym m p). -Elim p; Auto with arith. +intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p). +elim p; auto with arith. Qed. -Hints Resolve lt_reg_r : arith v62. +Hint Resolve plus_lt_compat_r: arith v62. -Lemma le_plus_plus : (n,m,p,q:nat) n<=m -> p<=q -> (n+p)<=(m+q). +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; Auto with arith. +intros n m p q H H0. +elim H; simpl in |- *; auto with arith. Qed. -Lemma le_lt_plus_plus : (n,m,p,q:nat) n<=m -> p<q -> (n+p)<(m+q). +Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q. Proof. - Unfold lt. Intros. Change ((S n)+p)<=(m+q). Rewrite plus_Snm_nSm. - Apply le_plus_plus; Assumption. + unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. rewrite plus_Snm_nSm. + apply plus_le_compat; assumption. Qed. -Lemma lt_le_plus_plus : (n,m,p,q:nat) n<m -> p<=q -> (n+p)<(m+q). +Lemma plus_lt_le_compat : forall n m p q, n < m -> p <= q -> n + p < m + q. Proof. - Unfold lt. Intros. Change ((S n)+p)<=(m+q). Apply le_plus_plus; Assumption. + unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. apply plus_le_compat; assumption. Qed. -Lemma lt_plus_plus : (n,m,p,q:nat) n<m -> p<q -> (n+p)<(m+q). +Lemma plus_lt_compat : forall n m p q, n < m -> p < q -> n + p < m + q. Proof. - Intros. Apply lt_le_plus_plus. Assumption. - Apply lt_le_weak. Assumption. + intros. apply plus_lt_le_compat. assumption. + apply lt_le_weak. assumption. Qed. (** Inversion lemmas *) -Lemma plus_is_O : (m,n:nat) (m+n)=O -> m=O /\ n=O. +Lemma plus_is_O : forall n m, n + m = 0 -> n = 0 /\ m = 0. Proof. - Intro m; NewDestruct m; Auto. - Intros. Discriminate H. + intro m; destruct m as [| n]; auto. + intros. discriminate H. Qed. -Definition plus_is_one : - (m,n:nat) (m+n)=(S O) -> {m=O /\ n=(S O)}+{m=(S O) /\ n=O}. +Definition plus_is_one : + forall m n, m + n = 1 -> {m = 0 /\ n = 1} + {m = 1 /\ n = 0}. Proof. - Intro m; NewDestruct m; Auto. - NewDestruct n; Auto. - Intros. - Simpl in H. Discriminate H. + intro m; destruct m as [| n]; auto. + destruct n; auto. + intros. + simpl in H. discriminate H. Defined. (** Derived properties *) -Lemma plus_permute_2_in_4 : (m,n,p,q:nat) ((m+n)+(p+q))=((m+p)+(n+q)). +Lemma plus_permute_2_in_4 : forall n m p q, n + m + (p + q) = n + p + (m + q). Proof. - Intros m n p q. - Rewrite <- (plus_assoc_l m n (p+q)). Rewrite (plus_assoc_l n p q). - Rewrite (plus_sym n p). Rewrite <- (plus_assoc_l p n q). Apply plus_assoc_l. + intros m n p q. + rewrite <- (plus_assoc m n (p + q)). rewrite (plus_assoc n p q). + rewrite (plus_comm n p). rewrite <- (plus_assoc p n q). apply plus_assoc. Qed. (** Tail-recursive plus *) @@ -195,15 +188,15 @@ Qed. tail-recursive, whereas [plus] is not. This can be useful when extracting programs. *) -Fixpoint plus_acc [q,n:nat] : nat := - Cases n of - O => q - | (S p) => (plus_acc (S q) p) - end. +Fixpoint plus_acc q n {struct n} : nat := + match n with + | O => q + | S p => plus_acc (S q) p + end. -Definition tail_plus := [n,m:nat](plus_acc m n). +Definition tail_plus n m := plus_acc m n. -Lemma plus_tail_plus : (n,m:nat)(n+m)=(tail_plus n m). -Unfold tail_plus; NewInduction n as [|n IHn]; Simpl; Auto. -Intro m; Rewrite <- IHn; Simpl; Auto. -Qed. +Lemma plus_tail_plus : forall n m, n + m = tail_plus n m. +unfold tail_plus in |- *; induction n as [| n IHn]; simpl in |- *; auto. +intro m; rewrite <- IHn; simpl in |- *; auto. +Qed.
\ No newline at end of file diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v index 51df19b29..a7a50795e 100755 --- a/theories/Arith/Wf_nat.v +++ b/theories/Arith/Wf_nat.v @@ -10,36 +10,35 @@ (** Well-founded relations and natural numbers *) -Require Lt. +Require Import Lt. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Implicit Variables Type m,n,p:nat. +Implicit Types m n p : nat. -Chapter Well_founded_Nat. +Section Well_founded_Nat. Variable A : Set. Variable f : A -> nat. -Definition ltof := [a,b:A](lt (f a) (f b)). -Definition gtof := [a,b:A](gt (f b) (f a)). +Definition ltof (a b:A) := f a < f b. +Definition gtof (a b:A) := f b > f a. -Theorem well_founded_ltof : (well_founded A ltof). +Theorem well_founded_ltof : well_founded ltof. Proof. -Red. -Cut (n:nat)(a:A)(lt (f a) n)->(Acc A ltof a). -Intros H a; Apply (H (S (f a))); Auto with arith. -NewInduction n. -Intros; Absurd (lt (f a) O); Auto with arith. -Intros a ltSma. -Apply Acc_intro. -Unfold ltof; Intros b ltfafb. -Apply IHn. -Apply lt_le_trans with (f a); Auto with arith. +red in |- *. +cut (forall n (a:A), f a < n -> Acc ltof a). +intros H a; apply (H (S (f a))); auto with arith. +induction n. +intros; absurd (f a < 0); auto with arith. +intros a ltSma. +apply Acc_intro. +unfold ltof in |- *; intros b ltfafb. +apply IHn. +apply lt_le_trans with (f a); auto with arith. Qed. -Theorem well_founded_gtof : (well_founded A gtof). +Theorem well_founded_gtof : well_founded gtof. Proof well_founded_ltof. (** It is possible to directly prove the induction principle going @@ -59,142 +58,149 @@ the ML-like program for [induction_ltof2] is : [[ where rec indrec a = F a indrec;; ]] *) -Theorem induction_ltof1 - : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a). +Theorem induction_ltof1 : + forall P:A -> Set, + (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. Proof. -Intros P F; Cut (n:nat)(a:A)(lt (f a) n)->(P a). -Intros H a; Apply (H (S (f a))); Auto with arith. -NewInduction n. -Intros; Absurd (lt (f a) O); Auto with arith. -Intros a ltSma. -Apply F. -Unfold ltof; Intros b ltfafb. -Apply IHn. -Apply lt_le_trans with (f a); Auto with arith. +intros P F; cut (forall n (a:A), f a < n -> P a). +intros H a; apply (H (S (f a))); auto with arith. +induction n. +intros; absurd (f a < 0); auto with arith. +intros a ltSma. +apply F. +unfold ltof in |- *; intros b ltfafb. +apply IHn. +apply lt_le_trans with (f a); auto with arith. Defined. -Theorem induction_gtof1 - : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a). +Theorem induction_gtof1 : + forall P:A -> Set, + (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. Proof. -Exact induction_ltof1. +exact induction_ltof1. Defined. -Theorem induction_ltof2 - : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a). +Theorem induction_ltof2 : + forall P:A -> Set, + (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. Proof. -Exact (well_founded_induction A ltof well_founded_ltof). +exact (well_founded_induction well_founded_ltof). Defined. -Theorem induction_gtof2 - : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a). +Theorem induction_gtof2 : + forall P:A -> Set, + (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. Proof. -Exact induction_ltof2. +exact induction_ltof2. Defined. (** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)] then [R] is well-founded. *) -Variable R : A->A->Prop. +Variable R : A -> A -> Prop. -Hypothesis H_compat : (x,y:A) (R x y) -> (lt (f x) (f y)). +Hypothesis H_compat : forall x y:A, R x y -> f x < f y. -Theorem well_founded_lt_compat : (well_founded A R). +Theorem well_founded_lt_compat : well_founded R. Proof. -Red. -Cut (n:nat)(a:A)(lt (f a) n)->(Acc A R a). -Intros H a; Apply (H (S (f a))); Auto with arith. -NewInduction n. -Intros; Absurd (lt (f a) O); Auto with arith. -Intros a ltSma. -Apply Acc_intro. -Intros b ltfafb. -Apply IHn. -Apply lt_le_trans with (f a); Auto with arith. +red in |- *. +cut (forall n (a:A), f a < n -> Acc R a). +intros H a; apply (H (S (f a))); auto with arith. +induction n. +intros; absurd (f a < 0); auto with arith. +intros a ltSma. +apply Acc_intro. +intros b ltfafb. +apply IHn. +apply lt_le_trans with (f a); auto with arith. Qed. End Well_founded_Nat. -Lemma lt_wf : (well_founded nat lt). -Proof (well_founded_ltof nat [m:nat]m). +Lemma lt_wf : well_founded lt. +Proof well_founded_ltof nat (fun m => m). -Lemma lt_wf_rec1 : (p:nat)(P:nat->Set) - ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p). +Lemma lt_wf_rec1 : + forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. -Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)] - (induction_ltof1 nat [m:nat]m P F p). +exact + (fun p (P:nat -> Set) (F:forall n, (forall m, m < n -> P m) -> P n) => + induction_ltof1 nat (fun m => m) P F p). Defined. -Lemma lt_wf_rec : (p:nat)(P:nat->Set) - ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p). +Lemma lt_wf_rec : + forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. -Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)] - (induction_ltof2 nat [m:nat]m P F p). +exact + (fun p (P:nat -> Set) (F:forall n, (forall m, m < n -> P m) -> P n) => + induction_ltof2 nat (fun m => m) P F p). Defined. -Lemma lt_wf_ind : (p:nat)(P:nat->Prop) - ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p). -Intro p; Intros; Elim (lt_wf p); Auto with arith. +Lemma lt_wf_ind : + forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n. +intro p; intros; elim (lt_wf p); auto with arith. Qed. -Lemma gt_wf_rec : (p:nat)(P:nat->Set) - ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p). +Lemma gt_wf_rec : + forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof. -Exact lt_wf_rec. +exact lt_wf_rec. Defined. -Lemma gt_wf_ind : (p:nat)(P:nat->Prop) - ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p). +Lemma gt_wf_ind : + forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof lt_wf_ind. -Lemma lt_wf_double_rec : - (P:nat->nat->Set) - ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m)) - -> (p,q:nat)(P p q). -Intros P Hrec p; Pattern p; Apply lt_wf_rec. -Intros n H q; Pattern q; Apply lt_wf_rec; Auto with arith. +Lemma lt_wf_double_rec : + forall P:nat -> nat -> Set, + (forall n m, + (forall p (q:nat), p < n -> P p q) -> + (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. +intros P Hrec p; pattern p in |- *; apply lt_wf_rec. +intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith. Defined. -Lemma lt_wf_double_ind : - (P:nat->nat->Prop) - ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m)) - -> (p,q:nat)(P p q). -Intros P Hrec p; Pattern p; Apply lt_wf_ind. -Intros n H q; Pattern q; Apply lt_wf_ind; Auto with arith. +Lemma lt_wf_double_ind : + forall P:nat -> nat -> Prop, + (forall n m, + (forall p (q:nat), p < n -> P p q) -> + (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. +intros P Hrec p; pattern p in |- *; apply lt_wf_ind. +intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith. Qed. -Hints Resolve lt_wf : arith. -Hints Resolve well_founded_lt_compat : arith. +Hint Resolve lt_wf: arith. +Hint Resolve well_founded_lt_compat: arith. Section LT_WF_REL. -Variable A :Set. -Variable R:A->A->Prop. +Variable A : Set. +Variable R : A -> A -> Prop. (* Relational form of inversion *) Variable F : A -> nat -> Prop. -Definition inv_lt_rel - [x,y]:=(EX n | (F x n) & (m:nat)(F y m)->(lt n m)). - -Hypothesis F_compat : (x,y:A) (R x y) -> (inv_lt_rel x y). -Remark acc_lt_rel : - (x:A)(EX n | (F x n))->(Acc A R x). -Intros x (n,fxn); Generalize x fxn; Clear x fxn. -Pattern n; Apply lt_wf_ind; Intros. -Constructor; Intros. -Case (F_compat y x); Trivial; Intros. -Apply (H x0); Auto. -Save. - -Theorem well_founded_inv_lt_rel_compat : (well_founded A R). -Constructor; Intros. -Case (F_compat y a); Trivial; Intros. -Apply acc_lt_rel; Trivial. -Exists x; Trivial. -Save. +Definition inv_lt_rel x y := + exists2 n : _ | F x n & (forall m, F y m -> n < m). + +Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y. +Remark acc_lt_rel : forall x:A, ( exists n : _ | F x n) -> Acc R x. +intros x [n fxn]; generalize x fxn; clear x fxn. +pattern n in |- *; apply lt_wf_ind; intros. +constructor; intros. +case (F_compat y x); trivial; intros. +apply (H x0); auto. +Qed. + +Theorem well_founded_inv_lt_rel_compat : well_founded R. +constructor; intros. +case (F_compat y a); trivial; intros. +apply acc_lt_rel; trivial. +exists x; trivial. +Qed. End LT_WF_REL. -Lemma well_founded_inv_rel_inv_lt_rel - : (A:Set)(F:A->nat->Prop)(well_founded A (inv_lt_rel A F)). -Intros; Apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); Trivial. -Save. +Lemma well_founded_inv_rel_inv_lt_rel : + forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F). +intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial. +Qed.
\ No newline at end of file diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index 3d0a7a2f1..fa786550c 100755 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -14,131 +14,130 @@ [Inductive bool : Set := true : bool | false : bool] *) (** Interpretation of booleans as Proposition *) -Definition Is_true := [b:bool](Cases b of - true => True - | false => False - end). -Hints Unfold Is_true : bool. +Definition Is_true (b:bool) := + match b with + | true => True + | false => False + end. +Hint Unfold Is_true: bool. -Lemma Is_true_eq_left : (x:bool)x=true -> (Is_true x). +Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x. Proof. - Intros; Rewrite H; Auto with bool. + intros; rewrite H; auto with bool. Qed. -Lemma Is_true_eq_right : (x:bool)true=x -> (Is_true x). +Lemma Is_true_eq_right : forall x:bool, true = x -> Is_true x. Proof. - Intros; Rewrite <- H; Auto with bool. + intros; rewrite <- H; auto with bool. Qed. -Hints Immediate Is_true_eq_right Is_true_eq_left : bool. +Hint Immediate Is_true_eq_right Is_true_eq_left: bool. (*******************) (** Discrimination *) (*******************) -Lemma diff_true_false : ~true=false. +Lemma diff_true_false : true <> false. Proof. -Unfold not; Intro contr; Change (Is_true false). -Elim contr; Simpl; Trivial with bool. +unfold not in |- *; intro contr; change (Is_true false) in |- *. +elim contr; simpl in |- *; trivial with bool. Qed. -Hints Resolve diff_true_false : bool v62. +Hint Resolve diff_true_false: bool v62. -Lemma diff_false_true : ~false=true. +Lemma diff_false_true : false <> true. Proof. -Red; Intros H; Apply diff_true_false. -Symmetry. -Assumption. +red in |- *; intros H; apply diff_true_false. +symmetry in |- *. +assumption. Qed. -Hints Resolve diff_false_true : bool v62. +Hint Resolve diff_false_true: bool v62. -Lemma eq_true_false_abs : (b:bool)(b=true)->(b=false)->False. -Intros b H; Rewrite H; Auto with bool. +Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False. +intros b H; rewrite H; auto with bool. Qed. -Hints Resolve eq_true_false_abs : bool. +Hint Resolve eq_true_false_abs: bool. -Lemma not_true_is_false : (b:bool)~b=true->b=false. -NewDestruct b. -Intros. -Red in H; Elim H. -Reflexivity. -Intros abs. -Reflexivity. +Lemma not_true_is_false : forall b:bool, b <> true -> b = false. +destruct b. +intros. +red in H; elim H. +reflexivity. +intros abs. +reflexivity. Qed. -Lemma not_false_is_true : (b:bool)~b=false->b=true. -NewDestruct b. -Intros. -Reflexivity. -Intro H; Red in H; Elim H. -Reflexivity. +Lemma not_false_is_true : forall b:bool, b <> false -> b = true. +destruct b. +intros. +reflexivity. +intro H; red in H; elim H. +reflexivity. Qed. (**********************) (** Order on booleans *) (**********************) -Definition leb := [b1,b2:bool] - Cases b1 of - | true => b2=true - | false => True +Definition leb (b1 b2:bool) := + match b1 with + | true => b2 = true + | false => True end. -Hints Unfold leb : bool v62. +Hint Unfold leb: bool v62. (*************) (** Equality *) (*************) -Definition eqb : bool->bool->bool := - [b1,b2:bool] - Cases b1 b2 of - true true => true - | true false => false - | false true => false - | false false => true - end. +Definition eqb (b1 b2:bool) : bool := + match b1, b2 with + | true, true => true + | true, false => false + | false, true => false + | false, false => true + end. -Lemma eqb_refl : (x:bool)(Is_true (eqb x x)). -NewDestruct x; Simpl; Auto with bool. +Lemma eqb_refl : forall x:bool, Is_true (eqb x x). +destruct x; simpl in |- *; auto with bool. Qed. -Lemma eqb_eq : (x,y:bool)(Is_true (eqb x y))->x=y. -NewDestruct x; NewDestruct y; Simpl; Tauto. +Lemma eqb_eq : forall x y:bool, Is_true (eqb x y) -> x = y. +destruct x; destruct y; simpl in |- *; tauto. Qed. -Lemma Is_true_eq_true : (x:bool) (Is_true x) -> x=true. -NewDestruct x; Simpl; Tauto. +Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true. +destruct x; simpl in |- *; tauto. Qed. -Lemma Is_true_eq_true2 : (x:bool) x=true -> (Is_true x). -NewDestruct x; Simpl; Auto with bool. +Lemma Is_true_eq_true2 : forall x:bool, x = true -> Is_true x. +destruct x; simpl in |- *; auto with bool. Qed. -Lemma eqb_subst : - (P:bool->Prop)(b1,b2:bool)(eqb b1 b2)=true->(P b1)->(P b2). -Unfold eqb . -Intros P b1. -Intros b2. -Case b1. -Case b2. -Trivial with bool. -Intros H. -Inversion_clear H. -Case b2. -Intros H. -Inversion_clear H. -Trivial with bool. +Lemma eqb_subst : + forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2. +unfold eqb in |- *. +intros P b1. +intros b2. +case b1. +case b2. +trivial with bool. +intros H. +inversion_clear H. +case b2. +intros H. +inversion_clear H. +trivial with bool. Qed. -Lemma eqb_reflx : (b:bool)(eqb b b)=true. -Intro b. -Case b. -Trivial with bool. -Trivial with bool. +Lemma eqb_reflx : forall b:bool, eqb b b = true. +intro b. +case b. +trivial with bool. +trivial with bool. Qed. -Lemma eqb_prop : (a,b:bool)(eqb a b)=true -> a=b. -NewDestruct a; NewDestruct b; Simpl; Intro; - Discriminate H Orelse Reflexivity. +Lemma eqb_prop : forall a b:bool, eqb a b = true -> a = b. +destruct a; destruct b; simpl in |- *; intro; discriminate H || reflexivity. Qed. @@ -146,36 +145,34 @@ Qed. (** Logical combinators *) (************************) -Definition ifb : bool -> bool -> bool -> bool - := [b1,b2,b3:bool](Cases b1 of true => b2 | false => b3 end). +Definition ifb (b1 b2 b3:bool) : bool := + match b1 with + | true => b2 + | false => b3 + end. -Definition andb : bool -> bool -> bool - := [b1,b2:bool](ifb b1 b2 false). +Definition andb (b1 b2:bool) : bool := ifb b1 b2 false. -Definition orb : bool -> bool -> bool - := [b1,b2:bool](ifb b1 true b2). +Definition orb (b1 b2:bool) : bool := ifb b1 true b2. -Definition implb : bool -> bool -> bool - := [b1,b2:bool](ifb b1 b2 true). +Definition implb (b1 b2:bool) : bool := ifb b1 b2 true. -Definition xorb : bool -> bool -> bool - := [b1,b2:bool] - Cases b1 b2 of - true true => false - | true false => true - | false true => true - | false false => false - end. +Definition xorb (b1 b2:bool) : bool := + match b1, b2 with + | true, true => false + | true, false => true + | false, true => true + | false, false => false + end. -Definition negb := [b:bool]Cases b of - true => false - | false => true - end. +Definition negb (b:bool) := match b with + | true => false + | false => true + end. -Infix "||" orb (at level 4, left associativity) : bool_scope. -Infix "&&" andb (at level 3, no associativity) : bool_scope - V8only (at level 40, left associativity). -V8Notation "- b" := (negb b) : bool_scope. +Infix "||" := orb (at level 50, left associativity) : bool_scope. +Infix "&&" := andb (at level 40, left associativity) : bool_scope. +Notation "- b" := (negb b) : bool_scope. Open Local Scope bool_scope. @@ -183,54 +180,55 @@ Open Local Scope bool_scope. (** Lemmas about [negb] *) (**************************) -Lemma negb_intro : (b:bool)b=(negb (negb b)). +Lemma negb_intro : forall b:bool, b = - - b. Proof. -NewDestruct b; Reflexivity. +destruct b; reflexivity. Qed. -Lemma negb_elim : (b:bool)(negb (negb b))=b. +Lemma negb_elim : forall b:bool, - - b = b. Proof. -NewDestruct b; Reflexivity. +destruct b; reflexivity. Qed. -Lemma negb_orb : (b1,b2:bool) - (negb (orb b1 b2)) = (andb (negb b1) (negb b2)). +Lemma negb_orb : forall b1 b2:bool, - (b1 || b2) = - b1 && - b2. Proof. - NewDestruct b1; NewDestruct b2; Simpl; Reflexivity. + destruct b1; destruct b2; simpl in |- *; reflexivity. Qed. -Lemma negb_andb : (b1,b2:bool) - (negb (andb b1 b2)) = (orb (negb b1) (negb b2)). +Lemma negb_andb : forall b1 b2:bool, - (b1 && b2) = - b1 || - b2. Proof. - NewDestruct b1; NewDestruct b2; Simpl; Reflexivity. + destruct b1; destruct b2; simpl in |- *; reflexivity. Qed. -Lemma negb_sym : (b,b':bool)(b'=(negb b))->(b=(negb b')). +Lemma negb_sym : forall b b':bool, b' = - b -> b = - b'. Proof. -NewDestruct b; NewDestruct b'; Intros; Simpl; Trivial with bool. +destruct b; destruct b'; intros; simpl in |- *; trivial with bool. Qed. -Lemma no_fixpoint_negb : (b:bool)~(negb b)=b. +Lemma no_fixpoint_negb : forall b:bool, - b <> b. Proof. -NewDestruct b; Simpl; Unfold not; Intro; Apply diff_true_false; Auto with bool. +destruct b; simpl in |- *; unfold not in |- *; intro; apply diff_true_false; + auto with bool. Qed. -Lemma eqb_negb1 : (b:bool)(eqb (negb b) b)=false. -NewDestruct b. -Trivial with bool. -Trivial with bool. +Lemma eqb_negb1 : forall b:bool, eqb (- b) b = false. +destruct b. +trivial with bool. +trivial with bool. Qed. -Lemma eqb_negb2 : (b:bool)(eqb b (negb b))=false. -NewDestruct b. -Trivial with bool. -Trivial with bool. +Lemma eqb_negb2 : forall b:bool, eqb b (- b) = false. +destruct b. +trivial with bool. +trivial with bool. Qed. -Lemma if_negb : (A:Set) (b:bool) (x,y:A) (if (negb b) then x else y)=(if b then y else x). +Lemma if_negb : + forall (A:Set) (b:bool) (x y:A), + (if - b then x else y) = (if b then y else x). Proof. - NewDestruct b;Trivial. + destruct b; trivial. Qed. @@ -238,304 +236,305 @@ Qed. (** A few lemmas about [or] *) (****************************) -Lemma orb_prop : - (a,b:bool)(orb a b)=true -> (a = true)\/(b = true). -NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool. +Lemma orb_prop : forall a b:bool, a || b = true -> a = true \/ b = true. +destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); + auto with bool. Qed. -Lemma orb_prop2 : - (a,b:bool)(Is_true (orb a b)) -> (Is_true a)\/(Is_true b). -NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool. +Lemma orb_prop2 : forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b. +destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); + auto with bool. Qed. -Lemma orb_true_intro - : (b1,b2:bool)(b1=true)\/(b2=true)->(orb b1 b2)=true. -NewDestruct b1; Auto with bool. -NewDestruct 1; Intros. -Elim diff_true_false; Auto with bool. -Rewrite H; Trivial with bool. +Lemma orb_true_intro : + forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true. +destruct b1; auto with bool. +destruct 1; intros. +elim diff_true_false; auto with bool. +rewrite H; trivial with bool. Qed. -Hints Resolve orb_true_intro : bool v62. +Hint Resolve orb_true_intro: bool v62. -Lemma orb_b_true : (b:bool)(orb b true)=true. -Auto with bool. +Lemma orb_b_true : forall b:bool, b || true = true. +auto with bool. Qed. -Hints Resolve orb_b_true : bool v62. +Hint Resolve orb_b_true: bool v62. -Lemma orb_true_b : (b:bool)(orb true b)=true. -Trivial with bool. +Lemma orb_true_b : forall b:bool, true || b = true. +trivial with bool. Qed. -Definition orb_true_elim : (b1,b2:bool)(orb b1 b2)=true -> {b1=true}+{b2=true}. -NewDestruct b1; Simpl; Auto with bool. +Definition orb_true_elim : + forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}. +destruct b1; simpl in |- *; auto with bool. Defined. -Lemma orb_false_intro - : (b1,b2:bool)(b1=false)->(b2=false)->(orb b1 b2)=false. -Intros b1 b2 H1 H2; Rewrite H1; Rewrite H2; Trivial with bool. +Lemma orb_false_intro : + forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false. +intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool. Qed. -Hints Resolve orb_false_intro : bool v62. +Hint Resolve orb_false_intro: bool v62. -Lemma orb_b_false : (b:bool)(orb b false)=b. +Lemma orb_b_false : forall b:bool, b || false = b. Proof. - NewDestruct b; Trivial with bool. + destruct b; trivial with bool. Qed. -Hints Resolve orb_b_false : bool v62. +Hint Resolve orb_b_false: bool v62. -Lemma orb_false_b : (b:bool)(orb false b)=b. +Lemma orb_false_b : forall b:bool, false || b = b. Proof. - NewDestruct b; Trivial with bool. + destruct b; trivial with bool. Qed. -Hints Resolve orb_false_b : bool v62. +Hint Resolve orb_false_b: bool v62. -Lemma orb_false_elim : - (b1,b2:bool)(orb b1 b2)=false -> (b1=false)/\(b2=false). +Lemma orb_false_elim : + forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false. Proof. - NewDestruct b1. - Intros; Elim diff_true_false; Auto with bool. - NewDestruct b2. - Intros; Elim diff_true_false; Auto with bool. - Auto with bool. + destruct b1. + intros; elim diff_true_false; auto with bool. + destruct b2. + intros; elim diff_true_false; auto with bool. + auto with bool. Qed. -Lemma orb_neg_b : - (b:bool)(orb b (negb b))=true. +Lemma orb_neg_b : forall b:bool, b || - b = true. Proof. - NewDestruct b; Reflexivity. + destruct b; reflexivity. Qed. -Hints Resolve orb_neg_b : bool v62. +Hint Resolve orb_neg_b: bool v62. -Lemma orb_sym : (b1,b2:bool)(orb b1 b2)=(orb b2 b1). -NewDestruct b1; NewDestruct b2; Reflexivity. +Lemma orb_comm : forall b1 b2:bool, b1 || b2 = b2 || b1. +destruct b1; destruct b2; reflexivity. Qed. -Lemma orb_assoc : (b1,b2,b3:bool)(orb b1 (orb b2 b3))=(orb (orb b1 b2) b3). +Lemma orb_assoc : forall b1 b2 b3:bool, b1 || (b2 || b3) = b1 || b2 || b3. Proof. - NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity. + destruct b1; destruct b2; destruct b3; reflexivity. Qed. -Hints Resolve orb_sym orb_assoc orb_b_false orb_false_b : bool v62. +Hint Resolve orb_comm orb_assoc orb_b_false orb_false_b: bool v62. (*****************************) (** A few lemmas about [and] *) (*****************************) -Lemma andb_prop : - (a,b:bool)(andb a b) = true -> (a = true)/\(b = true). +Lemma andb_prop : forall a b:bool, a && b = true -> a = true /\ b = true. Proof. - NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); - Auto with bool. + destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); + auto with bool. Qed. -Hints Resolve andb_prop : bool v62. +Hint Resolve andb_prop: bool v62. -Definition andb_true_eq : (a,b:bool) true = (andb a b) -> true = a /\ true = b. +Definition andb_true_eq : + forall a b:bool, true = a && b -> true = a /\ true = b. Proof. - NewDestruct a; NewDestruct b; Auto. + destruct a; destruct b; auto. Defined. -Lemma andb_prop2 : - (a,b:bool)(Is_true (andb a b)) -> (Is_true a)/\(Is_true b). +Lemma andb_prop2 : + forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b. Proof. - NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); - Auto with bool. + destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); + auto with bool. Qed. -Hints Resolve andb_prop2 : bool v62. +Hint Resolve andb_prop2: bool v62. -Lemma andb_true_intro : (b1,b2:bool)(b1=true)/\(b2=true)->(andb b1 b2)=true. +Lemma andb_true_intro : + forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true. Proof. - NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool. + destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. Qed. -Hints Resolve andb_true_intro : bool v62. +Hint Resolve andb_true_intro: bool v62. -Lemma andb_true_intro2 : - (b1,b2:bool)(Is_true b1)->(Is_true b2)->(Is_true (andb b1 b2)). +Lemma andb_true_intro2 : + forall b1 b2:bool, Is_true b1 -> Is_true b2 -> Is_true (b1 && b2). Proof. - NewDestruct b1; NewDestruct b2; Simpl; Tauto. + destruct b1; destruct b2; simpl in |- *; tauto. Qed. -Hints Resolve andb_true_intro2 : bool v62. +Hint Resolve andb_true_intro2: bool v62. -Lemma andb_false_intro1 - : (b1,b2:bool)(b1=false)->(andb b1 b2)=false. -NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool. +Lemma andb_false_intro1 : forall b1 b2:bool, b1 = false -> b1 && b2 = false. +destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. Qed. -Lemma andb_false_intro2 - : (b1,b2:bool)(b2=false)->(andb b1 b2)=false. -NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool. +Lemma andb_false_intro2 : forall b1 b2:bool, b2 = false -> b1 && b2 = false. +destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. Qed. -Lemma andb_b_false : (b:bool)(andb b false)=false. -NewDestruct b; Auto with bool. +Lemma andb_b_false : forall b:bool, b && false = false. +destruct b; auto with bool. Qed. -Lemma andb_false_b : (b:bool)(andb false b)=false. -Trivial with bool. +Lemma andb_false_b : forall b:bool, false && b = false. +trivial with bool. Qed. -Lemma andb_b_true : (b:bool)(andb b true)=b. -NewDestruct b; Auto with bool. +Lemma andb_b_true : forall b:bool, b && true = b. +destruct b; auto with bool. Qed. -Lemma andb_true_b : (b:bool)(andb true b)=b. -Trivial with bool. +Lemma andb_true_b : forall b:bool, true && b = b. +trivial with bool. Qed. -Definition andb_false_elim : - (b1,b2:bool)(andb b1 b2)=false -> {b1=false}+{b2=false}. -NewDestruct b1; Simpl; Auto with bool. +Definition andb_false_elim : + forall b1 b2:bool, b1 && b2 = false -> {b1 = false} + {b2 = false}. +destruct b1; simpl in |- *; auto with bool. Defined. -Hints Resolve andb_false_elim : bool v62. +Hint Resolve andb_false_elim: bool v62. -Lemma andb_neg_b : - (b:bool)(andb b (negb b))=false. -NewDestruct b; Reflexivity. +Lemma andb_neg_b : forall b:bool, b && - b = false. +destruct b; reflexivity. Qed. -Hints Resolve andb_neg_b : bool v62. +Hint Resolve andb_neg_b: bool v62. -Lemma andb_sym : (b1,b2:bool)(andb b1 b2)=(andb b2 b1). -NewDestruct b1; NewDestruct b2; Reflexivity. +Lemma andb_comm : forall b1 b2:bool, b1 && b2 = b2 && b1. +destruct b1; destruct b2; reflexivity. Qed. -Lemma andb_assoc : (b1,b2,b3:bool)(andb b1 (andb b2 b3))=(andb (andb b1 b2) b3). -NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity. +Lemma andb_assoc : forall b1 b2 b3:bool, b1 && (b2 && b3) = b1 && b2 && b3. +destruct b1; destruct b2; destruct b3; reflexivity. Qed. -Hints Resolve andb_sym andb_assoc : bool v62. +Hint Resolve andb_comm andb_assoc: bool v62. (*******************************) (** Properties of [xorb] *) (*******************************) -Lemma xorb_false : (b:bool) (xorb b false)=b. +Lemma xorb_false : forall b:bool, xorb b false = b. Proof. - NewDestruct b; Trivial. + destruct b; trivial. Qed. -Lemma false_xorb : (b:bool) (xorb false b)=b. +Lemma false_xorb : forall b:bool, xorb false b = b. Proof. - NewDestruct b; Trivial. + destruct b; trivial. Qed. -Lemma xorb_true : (b:bool) (xorb b true)=(negb b). +Lemma xorb_true : forall b:bool, xorb b true = - b. Proof. - Trivial. + trivial. Qed. -Lemma true_xorb : (b:bool) (xorb true b)=(negb b). +Lemma true_xorb : forall b:bool, xorb true b = - b. Proof. - NewDestruct b; Trivial. + destruct b; trivial. Qed. -Lemma xorb_nilpotent : (b:bool) (xorb b b)=false. +Lemma xorb_nilpotent : forall b:bool, xorb b b = false. Proof. - NewDestruct b; Trivial. + destruct b; trivial. Qed. -Lemma xorb_comm : (b,b':bool) (xorb b b')=(xorb b' b). +Lemma xorb_comm : forall b b':bool, xorb b b' = xorb b' b. Proof. - NewDestruct b; NewDestruct b'; Trivial. + destruct b; destruct b'; trivial. Qed. -Lemma xorb_assoc : (b,b',b'':bool) (xorb (xorb b b') b'')=(xorb b (xorb b' b'')). +Lemma xorb_assoc : + forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b''). Proof. - NewDestruct b; NewDestruct b'; NewDestruct b''; Trivial. + destruct b; destruct b'; destruct b''; trivial. Qed. -Lemma xorb_eq : (b,b':bool) (xorb b b')=false -> b=b'. +Lemma xorb_eq : forall b b':bool, xorb b b' = false -> b = b'. Proof. - NewDestruct b; NewDestruct b'; Trivial. - Unfold xorb. Intros. Rewrite H. Reflexivity. + destruct b; destruct b'; trivial. + unfold xorb in |- *. intros. rewrite H. reflexivity. Qed. -Lemma xorb_move_l_r_1 : (b,b',b'':bool) (xorb b b')=b'' -> b'=(xorb b b''). +Lemma xorb_move_l_r_1 : + forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''. Proof. - Intros. Rewrite <- (false_xorb b'). Rewrite <- (xorb_nilpotent b). Rewrite xorb_assoc. - Rewrite H. Reflexivity. + intros. rewrite <- (false_xorb b'). rewrite <- (xorb_nilpotent b). rewrite xorb_assoc. + rewrite H. reflexivity. Qed. -Lemma xorb_move_l_r_2 : (b,b',b'':bool) (xorb b b')=b'' -> b=(xorb b'' b'). +Lemma xorb_move_l_r_2 : + forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'. Proof. - Intros. Rewrite xorb_comm in H. Rewrite (xorb_move_l_r_1 b' b b'' H). Apply xorb_comm. + intros. rewrite xorb_comm in H. rewrite (xorb_move_l_r_1 b' b b'' H). apply xorb_comm. Qed. -Lemma xorb_move_r_l_1 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b' b)=b''. +Lemma xorb_move_r_l_1 : + forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''. Proof. - Intros. Rewrite H. Rewrite <- xorb_assoc. Rewrite xorb_nilpotent. Apply false_xorb. + intros. rewrite H. rewrite <- xorb_assoc. rewrite xorb_nilpotent. apply false_xorb. Qed. -Lemma xorb_move_r_l_2 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b b'')=b'. +Lemma xorb_move_r_l_2 : + forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'. Proof. - Intros. Rewrite H. Rewrite xorb_assoc. Rewrite xorb_nilpotent. Apply xorb_false. + intros. rewrite H. rewrite xorb_assoc. rewrite xorb_nilpotent. apply xorb_false. Qed. (*******************************) (** De Morgan's law *) (*******************************) -Lemma demorgan1 : (b1,b2,b3:bool) - (andb b1 (orb b2 b3)) = (orb (andb b1 b2) (andb b1 b3)). -NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity. +Lemma demorgan1 : + forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3. +destruct b1; destruct b2; destruct b3; reflexivity. Qed. -Lemma demorgan2 : (b1,b2,b3:bool) - (andb (orb b1 b2) b3) = (orb (andb b1 b3) (andb b2 b3)). -NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity. +Lemma demorgan2 : + forall b1 b2 b3:bool, (b1 || b2) && b3 = b1 && b3 || b2 && b3. +destruct b1; destruct b2; destruct b3; reflexivity. Qed. -Lemma demorgan3 : (b1,b2,b3:bool) - (orb b1 (andb b2 b3)) = (andb (orb b1 b2) (orb b1 b3)). -NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity. +Lemma demorgan3 : + forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3). +destruct b1; destruct b2; destruct b3; reflexivity. Qed. -Lemma demorgan4 : (b1,b2,b3:bool) - (orb (andb b1 b2) b3) = (andb (orb b1 b3) (orb b2 b3)). -NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity. +Lemma demorgan4 : + forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3). +destruct b1; destruct b2; destruct b3; reflexivity. Qed. -Lemma absoption_andb : (b1,b2:bool) - (andb b1 (orb b1 b2)) = b1. +Lemma absoption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1. Proof. - NewDestruct b1; NewDestruct b2; Simpl; Reflexivity. + destruct b1; destruct b2; simpl in |- *; reflexivity. Qed. -Lemma absoption_orb : (b1,b2:bool) - (orb b1 (andb b1 b2)) = b1. +Lemma absoption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1. Proof. - NewDestruct b1; NewDestruct b2; Simpl; Reflexivity. + destruct b1; destruct b2; simpl in |- *; reflexivity. Qed. (** Misc. equalities between booleans (to be used by Auto) *) -Lemma bool_1 : (b1,b2:bool)(b1=true <-> b2=true) -> b1=b2. +Lemma bool_1 : forall b1 b2:bool, (b1 = true <-> b2 = true) -> b1 = b2. Proof. - Intros b1 b2; Case b1; Case b2; Intuition. + intros b1 b2; case b1; case b2; intuition. Qed. -Lemma bool_2 : (b1,b2:bool)b1=b2 -> b1=true -> b2=true. +Lemma bool_2 : forall b1 b2:bool, b1 = b2 -> b1 = true -> b2 = true. Proof. - Intros b1 b2; Case b1; Case b2; Intuition. + intros b1 b2; case b1; case b2; intuition. Qed. -Lemma bool_3 : (b:bool) ~(negb b)=true -> b=true. +Lemma bool_3 : forall b:bool, - b <> true -> b = true. Proof. - NewDestruct b; Intuition. + destruct b; intuition. Qed. -Lemma bool_4 : (b:bool) b=true -> ~(negb b)=true. +Lemma bool_4 : forall b:bool, b = true -> - b <> true. Proof. - NewDestruct b; Intuition. + destruct b; intuition. Qed. -Lemma bool_5 : (b:bool) (negb b)=true -> ~b=true. +Lemma bool_5 : forall b:bool, - b = true -> b <> true. Proof. - NewDestruct b; Intuition. + destruct b; intuition. Qed. -Lemma bool_6 : (b:bool) ~b=true -> (negb b)=true. +Lemma bool_6 : forall b:bool, b <> true -> - b = true. Proof. - NewDestruct b; Intuition. + destruct b; intuition. Qed. -Hints Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6. +Hint Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6.
\ No newline at end of file diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v index 61204ba30..ef48e6272 100644 --- a/theories/Bool/BoolEq.v +++ b/theories/Bool/BoolEq.v @@ -20,53 +20,54 @@ Section Bool_eq_dec. Variable beq : A -> A -> bool. - Variable beq_refl : (x:A)true=(beq x x). + Variable beq_refl : forall x:A, true = beq x x. - Variable beq_eq : (x,y:A)true=(beq x y)->x=y. + Variable beq_eq : forall x y:A, true = beq x y -> x = y. - Definition beq_eq_true : (x,y:A)x=y->true=(beq x y). + Definition beq_eq_true : forall x y:A, x = y -> true = beq x y. Proof. - Intros x y H. - Case H. - Apply beq_refl. + intros x y H. + case H. + apply beq_refl. Defined. - Definition beq_eq_not_false : (x,y:A)x=y->~false=(beq x y). + Definition beq_eq_not_false : forall x y:A, x = y -> false <> beq x y. Proof. - Intros x y e. - Rewrite <- beq_eq_true; Trivial; Discriminate. + intros x y e. + rewrite <- beq_eq_true; trivial; discriminate. Defined. - Definition beq_false_not_eq : (x,y:A)false=(beq x y)->~x=y. + Definition beq_false_not_eq : forall x y:A, false = beq x y -> x <> y. Proof. - Exact [x,y:A; H:(false=(beq x y)); e:(x=y)](beq_eq_not_false x y e H). + exact + (fun (x y:A) (H:false = beq x y) (e:x = y) => beq_eq_not_false x y e H). Defined. - Definition exists_beq_eq : (x,y:A){b:bool | b=(beq x y)}. + Definition exists_beq_eq : forall x y:A, {b : bool | b = beq x y}. Proof. - Intros. - Exists (beq x y). - Constructor. + intros. + exists (beq x y). + constructor. Defined. - Definition not_eq_false_beq : (x,y:A)~x=y->false=(beq x y). + Definition not_eq_false_beq : forall x y:A, x <> y -> false = beq x y. Proof. - Intros x y H. - Symmetry. - Apply not_true_is_false. - Intro. - Apply H. - Apply beq_eq. - Symmetry. - Assumption. + intros x y H. + symmetry in |- *. + apply not_true_is_false. + intro. + apply H. + apply beq_eq. + symmetry in |- *. + assumption. Defined. - Definition eq_dec : (x,y:A){x=y}+{~x=y}. + Definition eq_dec : forall x y:A, {x = y} + {x <> y}. Proof. - Intros x y; Case (exists_beq_eq x y). - Intros b; Case b; Intro H. - Left; Apply beq_eq; Assumption. - Right; Apply beq_false_not_eq; Assumption. + intros x y; case (exists_beq_eq x y). + intros b; case b; intro H. + left; apply beq_eq; assumption. + right; apply beq_false_not_eq; assumption. Defined. -End Bool_eq_dec. +End Bool_eq_dec.
\ No newline at end of file diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v index 792d6a067..86b59db26 100644 --- a/theories/Bool/Bvector.v +++ b/theories/Bool/Bvector.v @@ -12,9 +12,8 @@ Require Export Bool. Require Export Sumbool. -Require Arith. +Require Import Arith. -V7only [Import nat_scope.]. Open Local Scope nat_scope. (* @@ -82,64 +81,64 @@ de taille n dans les vecteurs de taille n en appliquant f terme à terme. Variable A : Set. -Inductive vector: nat -> Set := - | Vnil : (vector O) - | Vcons : (a:A) (n:nat) (vector n) -> (vector (S n)). +Inductive vector : nat -> Set := + | Vnil : vector 0 + | Vcons : forall (a:A) (n:nat), vector n -> vector (S n). -Definition Vhead : (n:nat) (vector (S n)) -> A. +Definition Vhead : forall n:nat, vector (S n) -> A. Proof. - Intros n v; Inversion v; Exact a. + intros n v; inversion v; exact a. Defined. -Definition Vtail : (n:nat) (vector (S n)) -> (vector n). +Definition Vtail : forall n:nat, vector (S n) -> vector n. Proof. - Intros n v; Inversion v; Exact H0. + intros n v; inversion v; exact H0. Defined. -Definition Vlast : (n:nat) (vector (S n)) -> A. +Definition Vlast : forall n:nat, vector (S n) -> A. Proof. - NewInduction n as [|n f]; Intro v. - Inversion v. - Exact a. + induction n as [| n f]; intro v. + inversion v. + exact a. - Inversion v. - Exact (f H0). + inversion v. + exact (f H0). Defined. -Definition Vconst : (a:A) (n:nat) (vector n). +Definition Vconst : forall (a:A) (n:nat), vector n. Proof. - NewInduction n as [|n v]. - Exact Vnil. + induction n as [| n v]. + exact Vnil. - Exact (Vcons a n v). + exact (Vcons a n v). Defined. -Lemma Vshiftout : (n:nat) (vector (S n)) -> (vector n). +Lemma Vshiftout : forall n:nat, vector (S n) -> vector n. Proof. - NewInduction n as [|n f]; Intro v. - Exact Vnil. + induction n as [| n f]; intro v. + exact Vnil. - Inversion v. - Exact (Vcons a n (f H0)). + inversion v. + exact (Vcons a n (f H0)). Defined. -Lemma Vshiftin : (n:nat) A -> (vector n) -> (vector (S n)). +Lemma Vshiftin : forall n:nat, A -> vector n -> vector (S n). Proof. - NewInduction n as [|n f]; Intros a v. - Exact (Vcons a O v). + induction n as [| n f]; intros a v. + exact (Vcons a 0 v). - Inversion v. - Exact (Vcons a (S n) (f a H0)). + inversion v. + exact (Vcons a (S n) (f a H0)). Defined. -Lemma Vshiftrepeat : (n:nat) (vector (S n)) -> (vector (S (S n))). +Lemma Vshiftrepeat : forall n:nat, vector (S n) -> vector (S (S n)). Proof. - NewInduction n as [|n f]; Intro v. - Inversion v. - Exact (Vcons a (1) v). + induction n as [| n f]; intro v. + inversion v. + exact (Vcons a 1 v). - Inversion v. - Exact (Vcons a (S (S n)) (f H0)). + inversion v. + exact (Vcons a (S (S n)) (f H0)). Defined. (* @@ -149,50 +148,50 @@ Proof. Save. *) -Lemma Vtrunc : (n,p:nat) (gt n p) -> (vector n) -> (vector (minus n p)). +Lemma Vtrunc : forall n p:nat, n > p -> vector n -> vector (n - p). Proof. - NewInduction p as [|p f]; Intros H v. - Rewrite <- minus_n_O. - Exact v. + induction p as [| p f]; intros H v. + rewrite <- minus_n_O. + exact v. - Apply (Vshiftout (minus n (S p))). + apply (Vshiftout (n - S p)). -Rewrite minus_Sn_m. -Apply f. -Auto with *. -Exact v. -Auto with *. +rewrite minus_Sn_m. +apply f. +auto with *. +exact v. +auto with *. Defined. -Lemma Vextend : (n,p:nat) (vector n) -> (vector p) -> (vector (plus n p)). +Lemma Vextend : forall n p:nat, vector n -> vector p -> vector (n + p). Proof. - NewInduction n as [|n f]; Intros p v v0. - Simpl; Exact v0. + induction n as [| n f]; intros p v v0. + simpl in |- *; exact v0. - Inversion v. - Simpl; Exact (Vcons a (plus n p) (f p H0 v0)). + inversion v. + simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)). Defined. Variable f : A -> A. -Lemma Vunary : (n:nat)(vector n)->(vector n). +Lemma Vunary : forall n:nat, vector n -> vector n. Proof. - NewInduction n as [|n g]; Intro v. - Exact Vnil. + induction n as [| n g]; intro v. + exact Vnil. - Inversion v. - Exact (Vcons (f a) n (g H0)). + inversion v. + exact (Vcons (f a) n (g H0)). Defined. Variable g : A -> A -> A. -Lemma Vbinary : (n:nat)(vector n)->(vector n)->(vector n). +Lemma Vbinary : forall n:nat, vector n -> vector n -> vector n. Proof. - NewInduction n as [|n h]; Intros v v0. - Exact Vnil. + induction n as [| n h]; intros v v0. + exact Vnil. - Inversion v; Inversion v0. - Exact (Vcons (g a a0) n (h H0 H2)). + inversion v; inversion v0. + exact (Vcons (g a a0) n (h H0 H2)). Defined. End VECTORS. @@ -211,56 +210,58 @@ ATTENTION : Tous les décalages prennent la taille moins un comme paramètre (ils ne travaillent que sur des vecteurs au moins de longueur un). *) -Definition Bvector := (vector bool). +Definition Bvector := vector bool. -Definition Bnil := (Vnil bool). +Definition Bnil := Vnil bool. -Definition Bcons := (Vcons bool). +Definition Bcons := Vcons bool. -Definition Bvect_true := (Vconst bool true). +Definition Bvect_true := Vconst bool true. -Definition Bvect_false := (Vconst bool false). +Definition Bvect_false := Vconst bool false. -Definition Blow := (Vhead bool). +Definition Blow := Vhead bool. -Definition Bhigh := (Vtail bool). +Definition Bhigh := Vtail bool. -Definition Bsign := (Vlast bool). +Definition Bsign := Vlast bool. -Definition Bneg := (Vunary bool negb). +Definition Bneg := Vunary bool negb. -Definition BVand := (Vbinary bool andb). +Definition BVand := Vbinary bool andb. -Definition BVor := (Vbinary bool orb). +Definition BVor := Vbinary bool orb. -Definition BVxor := (Vbinary bool xorb). +Definition BVxor := Vbinary bool xorb. -Definition BshiftL := [n:nat; bv : (Bvector (S n)); carry:bool] - (Bcons carry n (Vshiftout bool n bv)). +Definition BshiftL (n:nat) (bv:Bvector (S n)) (carry:bool) := + Bcons carry n (Vshiftout bool n bv). -Definition BshiftRl := [n:nat; bv : (Bvector (S n)); carry:bool] - (Bhigh (S n) (Vshiftin bool (S n) carry bv)). +Definition BshiftRl (n:nat) (bv:Bvector (S n)) (carry:bool) := + Bhigh (S n) (Vshiftin bool (S n) carry bv). -Definition BshiftRa := [n:nat; bv : (Bvector (S n))] - (Bhigh (S n) (Vshiftrepeat bool n bv)). +Definition BshiftRa (n:nat) (bv:Bvector (S n)) := + Bhigh (S n) (Vshiftrepeat bool n bv). -Fixpoint BshiftL_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) := -Cases p of - | O => bv - | (S p') => (BshiftL n (BshiftL_iter n bv p') false) -end. +Fixpoint BshiftL_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} : + Bvector (S n) := + match p with + | O => bv + | S p' => BshiftL n (BshiftL_iter n bv p') false + end. -Fixpoint BshiftRl_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) := -Cases p of - | O => bv - | (S p') => (BshiftRl n (BshiftRl_iter n bv p') false) -end. +Fixpoint BshiftRl_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} : + Bvector (S n) := + match p with + | O => bv + | S p' => BshiftRl n (BshiftRl_iter n bv p') false + end. -Fixpoint BshiftRa_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) := -Cases p of - | O => bv - | (S p') => (BshiftRa n (BshiftRa_iter n bv p')) -end. +Fixpoint BshiftRa_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} : + Bvector (S n) := + match p with + | O => bv + | S p' => BshiftRa n (BshiftRa_iter n bv p') + end. End BOOLEAN_VECTORS. - diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v index 28ef57eac..8a15e7624 100755 --- a/theories/Bool/DecBool.v +++ b/theories/Bool/DecBool.v @@ -10,18 +10,22 @@ Set Implicit Arguments. -Definition ifdec : (A,B:Prop)(C:Set)({A}+{B})->C->C->C - := [A,B,C,H,x,y]if H then [_]x else [_]y. +Definition ifdec (A B:Prop) (C:Set) (H:{A} + {B}) (x y:C) : C := + if H then fun _ => x else fun _ => y. -Theorem ifdec_left : (A,B:Prop)(C:Set)(H:{A}+{B})~B->(x,y:C)(ifdec H x y)=x. -Intros; Case H; Auto. -Intro; Absurd B; Trivial. +Theorem ifdec_left : + forall (A B:Prop) (C:Set) (H:{A} + {B}), + ~ B -> forall x y:C, ifdec H x y = x. +intros; case H; auto. +intro; absurd B; trivial. Qed. -Theorem ifdec_right : (A,B:Prop)(C:Set)(H:{A}+{B})~A->(x,y:C)(ifdec H x y)=y. -Intros; Case H; Auto. -Intro; Absurd A; Trivial. +Theorem ifdec_right : + forall (A B:Prop) (C:Set) (H:{A} + {B}), + ~ A -> forall x y:C, ifdec H x y = y. +intros; case H; auto. +intro; absurd A; trivial. Qed. -Unset Implicit Arguments. +Unset Implicit Arguments.
\ No newline at end of file diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v index 48180678f..bde404cf7 100755 --- a/theories/Bool/IfProp.v +++ b/theories/Bool/IfProp.v @@ -8,42 +8,43 @@ (*i $Id$ i*) -Require Bool. +Require Import Bool. -Inductive IfProp [A,B:Prop] : bool-> Prop - := Iftrue : A -> (IfProp A B true) - | Iffalse : B -> (IfProp A B false). +Inductive IfProp (A B:Prop) : bool -> Prop := + | Iftrue : A -> IfProp A B true + | Iffalse : B -> IfProp A B false. -Hints Resolve Iftrue Iffalse : bool v62. +Hint Resolve Iftrue Iffalse: bool v62. -Lemma Iftrue_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=true -> A. -NewDestruct 1; Intros; Auto with bool. -Case diff_true_false; Auto with bool. +Lemma Iftrue_inv : forall (A B:Prop) (b:bool), IfProp A B b -> b = true -> A. +destruct 1; intros; auto with bool. +case diff_true_false; auto with bool. Qed. -Lemma Iffalse_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=false -> B. -NewDestruct 1; Intros; Auto with bool. -Case diff_true_false; Trivial with bool. +Lemma Iffalse_inv : + forall (A B:Prop) (b:bool), IfProp A B b -> b = false -> B. +destruct 1; intros; auto with bool. +case diff_true_false; trivial with bool. Qed. -Lemma IfProp_true : (A,B:Prop)(IfProp A B true) -> A. -Intros. -Inversion H. -Assumption. +Lemma IfProp_true : forall A B:Prop, IfProp A B true -> A. +intros. +inversion H. +assumption. Qed. -Lemma IfProp_false : (A,B:Prop)(IfProp A B false) -> B. -Intros. -Inversion H. -Assumption. +Lemma IfProp_false : forall A B:Prop, IfProp A B false -> B. +intros. +inversion H. +assumption. Qed. -Lemma IfProp_or : (A,B:Prop)(b:bool)(IfProp A B b) -> A\/B. -NewDestruct 1; Auto with bool. +Lemma IfProp_or : forall (A B:Prop) (b:bool), IfProp A B b -> A \/ B. +destruct 1; auto with bool. Qed. -Lemma IfProp_sum : (A,B:Prop)(b:bool)(IfProp A B b) -> {A}+{B}. -NewDestruct b; Intro H. -Left; Inversion H; Auto with bool. -Right; Inversion H; Auto with bool. -Qed. +Lemma IfProp_sum : forall (A B:Prop) (b:bool), IfProp A B b -> {A} + {B}. +destruct b; intro H. +left; inversion H; auto with bool. +right; inversion H; auto with bool. +Qed.
\ No newline at end of file diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v index 779969e6f..815bcda41 100644 --- a/theories/Bool/Sumbool.v +++ b/theories/Bool/Sumbool.v @@ -15,21 +15,23 @@ (** A boolean is either [true] or [false], and this is decidable *) -Definition sumbool_of_bool : (b:bool) {b=true}+{b=false}. +Definition sumbool_of_bool : forall b:bool, {b = true} + {b = false}. Proof. - NewDestruct b; Auto. + destruct b; auto. Defined. -Hints Resolve sumbool_of_bool : bool. +Hint Resolve sumbool_of_bool: bool. -Definition bool_eq_rec : (b:bool)(P:bool->Set) - ((b=true)->(P true))->((b=false)->(P false))->(P b). -NewDestruct b; Auto. +Definition bool_eq_rec : + forall (b:bool) (P:bool -> Set), + (b = true -> P true) -> (b = false -> P false) -> P b. +destruct b; auto. Defined. -Definition bool_eq_ind : (b:bool)(P:bool->Prop) - ((b=true)->(P true))->((b=false)->(P false))->(P b). -NewDestruct b; Auto. +Definition bool_eq_ind : + forall (b:bool) (P:bool -> Prop), + (b = true -> P true) -> (b = false -> P false) -> P b. +destruct b; auto. Defined. @@ -39,39 +41,38 @@ Defined. Section connectives. -Variables A,B,C,D : Prop. +Variables A B C D : Prop. -Hypothesis H1 : {A}+{B}. -Hypothesis H2 : {C}+{D}. +Hypothesis H1 : {A} + {B}. +Hypothesis H2 : {C} + {D}. -Definition sumbool_and : {A/\C}+{B\/D}. +Definition sumbool_and : {A /\ C} + {B \/ D}. Proof. -Case H1; Case H2; Auto. +case H1; case H2; auto. Defined. -Definition sumbool_or : {A\/C}+{B/\D}. +Definition sumbool_or : {A \/ C} + {B /\ D}. Proof. -Case H1; Case H2; Auto. +case H1; case H2; auto. Defined. -Definition sumbool_not : {B}+{A}. +Definition sumbool_not : {B} + {A}. Proof. -Case H1; Auto. +case H1; auto. Defined. End connectives. -Hints Resolve sumbool_and sumbool_or sumbool_not : core. +Hint Resolve sumbool_and sumbool_or sumbool_not: core. (** Any decidability function in type [sumbool] can be turned into a function returning a boolean with the corresponding specification: *) -Definition bool_of_sumbool : - (A,B:Prop) {A}+{B} -> { b:bool | if b then A else B }. +Definition bool_of_sumbool : + forall A B:Prop, {A} + {B} -> {b : bool | if b then A else B}. Proof. -Intros A B H. -Elim H; [ Intro; Exists true; Assumption - | Intro; Exists false; Assumption ]. +intros A B H. +elim H; [ intro; exists true; assumption | intro; exists false; assumption ]. Defined. -Implicits bool_of_sumbool. +Implicit Arguments bool_of_sumbool.
\ No newline at end of file diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v index 788025161..6487d08e9 100755 --- a/theories/Bool/Zerob.v +++ b/theories/Bool/Zerob.v @@ -8,29 +8,31 @@ (*i $Id$ i*) -Require Arith. -Require Bool. +Require Import Arith. +Require Import Bool. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -Definition zerob : nat->bool - := [n:nat]Cases n of O => true | (S _) => false end. +Definition zerob (n:nat) : bool := + match n with + | O => true + | S _ => false + end. -Lemma zerob_true_intro : (n:nat)(n=O)->(zerob n)=true. -NewDestruct n; [Trivial with bool | Inversion 1]. +Lemma zerob_true_intro : forall n:nat, n = 0 -> zerob n = true. +destruct n; [ trivial with bool | inversion 1 ]. Qed. -Hints Resolve zerob_true_intro : bool. +Hint Resolve zerob_true_intro: bool. -Lemma zerob_true_elim : (n:nat)(zerob n)=true->(n=O). -NewDestruct n; [Trivial with bool | Inversion 1]. +Lemma zerob_true_elim : forall n:nat, zerob n = true -> n = 0. +destruct n; [ trivial with bool | inversion 1 ]. Qed. -Lemma zerob_false_intro : (n:nat)~(n=O)->(zerob n)=false. -NewDestruct n; [NewDestruct 1; Auto with bool | Trivial with bool]. +Lemma zerob_false_intro : forall n:nat, n <> 0 -> zerob n = false. +destruct n; [ destruct 1; auto with bool | trivial with bool ]. Qed. -Hints Resolve zerob_false_intro : bool. +Hint Resolve zerob_false_intro: bool. -Lemma zerob_false_elim : (n:nat)(zerob n)=false -> ~(n=O). -NewDestruct n; [Intro H; Inversion H | Auto with bool]. -Qed. +Lemma zerob_false_elim : forall n:nat, zerob n = false -> n <> 0. +destruct n; [ intro H; inversion H | auto with bool ]. +Qed.
\ No newline at end of file diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index d93bbbac1..d5a1179c8 100755 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -8,117 +8,114 @@ (*i $Id$ i*) -Require Notations. -Require Logic. +Require Import Notations. +Require Import Logic. Set Implicit Arguments. -V7only [Unset Implicit Arguments.]. (** [unit] is a singleton datatype with sole inhabitant [tt] *) -Inductive unit : Set := tt : unit. +Inductive unit : Set := + tt : unit. (** [bool] is the datatype of the booleans values [true] and [false] *) -Inductive bool : Set := true : bool - | false : bool. +Inductive bool : Set := + | true : bool + | false : bool. Add Printing If bool. (** [nat] is the datatype of natural numbers built from [O] and successor [S]; note that zero is the letter O, not the numeral 0 *) -Inductive nat : Set := O : nat - | S : nat->nat. +Inductive nat : Set := + | O : nat + | S : nat -> nat. -Delimits Scope nat_scope with nat. +Delimit Scope nat_scope with nat. Bind Scope nat_scope with nat. -Arguments Scope S [ nat_scope ]. +Arguments Scope S [nat_scope]. (** [Empty_set] has no inhabitant *) -Inductive Empty_set:Set :=. +Inductive Empty_set : Set :=. (** [identity A a] is the family of datatypes on [A] whose sole non-empty member is the singleton datatype [identity A a a] whose sole inhabitant is denoted [refl_identity A a] *) -Inductive identity [A:Type; a:A] : A->Set := - refl_identity: (identity A a a). -Hints Resolve refl_identity : core v62. +Inductive identity (A:Type) (a:A) : A -> Set := + refl_identity : identity (A:=A) a a. +Hint Resolve refl_identity: core v62. -Implicits identity_ind [1]. -Implicits identity_rec [1]. -Implicits identity_rect [1]. -V7only [ -Implicits identity_ind []. -Implicits identity_rec []. -Implicits identity_rect []. -]. +Implicit Arguments identity_ind [A]. +Implicit Arguments identity_rec [A]. +Implicit Arguments identity_rect [A]. (** [option A] is the extension of A with a dummy element None *) -Inductive option [A:Set] : Set := Some : A -> (option A) | None : (option A). +Inductive option (A:Set) : Set := + | Some : A -> option A + | None : option A. -Implicits None [1]. -V7only [Implicits None [].]. +Implicit Arguments None [A]. (** [sum A B], equivalently [A + B], is the disjoint sum of [A] and [B] *) (* Syntax defined in Specif.v *) -Inductive sum [A,B:Set] : Set - := inl : A -> (sum A B) - | inr : B -> (sum A B). +Inductive sum (A B:Set) : Set := + | inl : A -> sum A B + | inr : B -> sum A B. Notation "x + y" := (sum x y) : type_scope. (** [prod A B], written [A * B], is the product of [A] and [B]; the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *) -Inductive prod [A,B:Set] : Set := pair : A -> B -> (prod A B). +Inductive prod (A B:Set) : Set := + pair : A -> B -> prod A B. Add Printing Let prod. Notation "x * y" := (prod x y) : type_scope. -Notation "( x , y )" := (pair ? ? x y) : core_scope V8only "x , y". +Notation "x , y" := (pair x y) : core_scope. Section projections. - Variables A,B:Set. - Definition fst := [p:(prod A B)]Cases p of (pair x y) => x end. - Definition snd := [p:(prod A B)]Cases p of (pair x y) => y end. + Variables A B : Set. + Definition fst (p:A * B) := match p with + | (x, y) => x + end. + Definition snd (p:A * B) := match p with + | (x, y) => y + end. End projections. -V7only [ -Notation Fst := (fst ? ?). -Notation Snd := (snd ? ?). -]. -Hints Resolve pair inl inr : core v62. +Hint Resolve pair inl inr: core v62. -Lemma surjective_pairing : (A,B:Set;p:A*B)p=(pair A B (Fst p) (Snd p)). +Lemma surjective_pairing : + forall (A B:Set) (p:A * B), p = pair (fst p) (snd p). Proof. -NewDestruct p; Reflexivity. +destruct p; reflexivity. Qed. -Lemma injective_projections : - (A,B:Set;p1,p2:A*B)(Fst p1)=(Fst p2)->(Snd p1)=(Snd p2)->p1=p2. +Lemma injective_projections : + forall (A B:Set) (p1 p2:A * B), + fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2. Proof. -NewDestruct p1; NewDestruct p2; Simpl; Intros Hfst Hsnd. -Rewrite Hfst; Rewrite Hsnd; Reflexivity. +destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd. +rewrite Hfst; rewrite Hsnd; reflexivity. Qed. -V7only[ -(** Parsing only of things in [Datatypes.v] *) -Notation "< A , B > ( x , y )" := (pair A B x y) (at level 1, only parsing, A annot). -Notation "< A , B > 'Fst' ( p )" := (fst A B p) (at level 1, only parsing, A annot). -Notation "< A , B > 'Snd' ( p )" := (snd A B p) (at level 1, only parsing, A annot). -]. (** Comparison *) -Inductive relation : Set := - EGAL :relation | INFERIEUR : relation | SUPERIEUR : relation. - -Definition Op := [r:relation] - Cases r of - EGAL => EGAL - | INFERIEUR => SUPERIEUR - | SUPERIEUR => INFERIEUR - end. +Inductive comparison : Set := + | Eq : comparison + | Lt : comparison + | Gt : comparison. + +Definition CompOpp (r:comparison) := + match r with + | Eq => Eq + | Lt => Gt + | Gt => Lt + end.
\ No newline at end of file diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index dc067a4b7..7cfe160a0 100755 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -9,30 +9,27 @@ (*i $Id$ i*) Set Implicit Arguments. -V7only [Unset Implicit Arguments.]. -Require Notations. +Require Import Notations. (** [True] is the always true proposition *) -Inductive True : Prop := I : True. +Inductive True : Prop := + I : True. (** [False] is the always false proposition *) -Inductive False : Prop := . +Inductive False : Prop :=. (** [not A], written [~A], is the negation of [A] *) -Definition not := [A:Prop]A->False. +Definition not (A:Prop) := A -> False. Notation "~ x" := (not x) : type_scope. -Hints Unfold not : core. +Hint Unfold not: core. -Inductive and [A,B:Prop] : Prop := conj : A -> B -> A /\ B +Inductive and (A B:Prop) : Prop := + conj : A -> B -> A /\ B + where "A /\ B" := (and A B) : type_scope. -where "A /\ B" := (and A B) : type_scope. - -V7only[ -Notation "< P , Q > { p , q }" := (conj P Q p q) (P annot, at level 1). -]. Section Conjunction. @@ -43,61 +40,58 @@ Section Conjunction. [proj1] and [proj2] are first and second projections of a conjunction *) - Variables A,B : Prop. + Variables A B : Prop. - Theorem proj1 : (and A B) -> A. + Theorem proj1 : A /\ B -> A. Proof. - NewDestruct 1; Trivial. + destruct 1; trivial. Qed. - Theorem proj2 : (and A B) -> B. + Theorem proj2 : A /\ B -> B. Proof. - NewDestruct 1; Trivial. + destruct 1; trivial. Qed. End Conjunction. (** [or A B], written [A \/ B], is the disjunction of [A] and [B] *) -Inductive or [A,B:Prop] : Prop := - or_introl : A -> A \/ B - | or_intror : B -> A \/ B - -where "A \/ B" := (or A B) : type_scope. +Inductive or (A B:Prop) : Prop := + | or_introl : A -> A \/ B + | or_intror : B -> A \/ B + where "A \/ B" := (or A B) : type_scope. (** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *) -Definition iff := [A,B:Prop] (and (A->B) (B->A)). +Definition iff (A B:Prop) := (A -> B) /\ (B -> A). Notation "A <-> B" := (iff A B) : type_scope. Section Equivalence. -Theorem iff_refl : (A:Prop) (iff A A). +Theorem iff_refl : forall A:Prop, A <-> A. Proof. - Split; Auto. + split; auto. Qed. -Theorem iff_trans : (a,b,c:Prop) (iff a b) -> (iff b c) -> (iff a c). +Theorem iff_trans : forall A B C:Prop, (A <-> B) -> (B <-> C) -> (A <-> C). Proof. - Intros A B C (H1,H2) (H3,H4); Split; Auto. + intros A B C [H1 H2] [H3 H4]; split; auto. Qed. -Theorem iff_sym : (A,B:Prop) (iff A B) -> (iff B A). +Theorem iff_sym : forall A B:Prop, (A <-> B) -> (B <-> A). Proof. - Intros A B (H1,H2); Split; Auto. + intros A B [H1 H2]; split; auto. Qed. End Equivalence. (** [(IF P Q R)], or more suggestively [(either P and_then Q or_else R)], denotes either [P] and [Q], or [~P] and [Q] *) -Definition IF_then_else := [P,Q,R:Prop] (or (and P Q) (and (not P) R)). -V7only [Notation IF:=IF_then_else.]. +Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R. -Notation "'IF' c1 'then' c2 'else' c3" := (IF c1 c2 c3) - (at level 1, c1, c2, c3 at level 8) : type_scope - V8only (at level 200). +Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3) + (at level 200) : type_scope. (** First-order quantifiers *) @@ -114,57 +108,42 @@ Notation "'IF' c1 'then' c2 'else' c3" := (IF c1 c2 c3) construction [(all A P)], or simply [(All P)], is provided as an abbreviation of [(x:A)(P x)] *) -Inductive ex [A:Type;P:A->Prop] : Prop - := ex_intro : (x:A)(P x)->(ex A P). +Inductive ex (A:Type) (P:A -> Prop) : Prop := + ex_intro : forall x:A, P x -> ex (A:=A) P. -Inductive ex2 [A:Type;P,Q:A->Prop] : Prop - := ex_intro2 : (x:A)(P x)->(Q x)->(ex2 A P Q). +Inductive ex2 (A:Type) (P Q:A -> Prop) : Prop := + ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q. -Definition all := [A:Type][P:A->Prop](x:A)(P x). +Definition all (A:Type) (P:A -> Prop) := forall x:A, P x. (*Rule order is important to give printing priority to fully typed ALL and EX*) -V7only [ Notation Ex := (ex ?). ]. -Notation "'EX' x | p" := (ex ? [x]p) - (at level 10, p at level 8) : type_scope - V8only "'exists' x | p" (at level 200, x ident, p at level 99). -Notation "'EX' x : t | p" := (ex ? [x:t]p) - (at level 10, p at level 8) : type_scope - V8only "'exists' x : t | p" (at level 200, x ident, p at level 99). - -V7only [ Notation Ex2 := (ex2 ?). ]. -Notation "'EX' x | p & q" := (ex2 ? [x]p [x]q) - (at level 10, p, q at level 8) : type_scope - V8only "'exists2' x | p & q" (at level 200, x ident, p, q at level 99). -Notation "'EX' x : t | p & q" := (ex2 ? [x:t]p [x:t]q) - (at level 10, p, q at level 8) : type_scope - V8only "'exists2' x : t | p & q" - (at level 200, x ident, t at level 200, p, q at level 99). - -V7only [Notation All := (all ?). -Notation "'ALL' x | p" := (all ? [x]p) - (at level 10, p at level 8) : type_scope - V8only (at level 200, x ident, p at level 200). -Notation "'ALL' x : t | p" := (all ? [x:t]p) - (at level 10, p at level 8) : type_scope - V8only (at level 200, x ident, t, p at level 200). -]. +Notation "'exists' x | p" := (ex (fun x => p)) + (at level 200, x ident, p at level 99) : type_scope. +Notation "'exists' x : t | p" := (ex (fun x:t => p)) + (at level 200, x ident, p at level 99) : type_scope. + +Notation "'exists2' x | p & q" := (ex2 (fun x => p) (fun x => q)) + (at level 200, x ident, p, q at level 99) : type_scope. +Notation "'exists2' x : t | p & q" := (ex2 (fun x:t => p) (fun x:t => q)) + (at level 200, x ident, t at level 200, p, q at level 99) : type_scope. + (** Universal quantification *) Section universal_quantification. Variable A : Type. - Variable P : A->Prop. + Variable P : A -> Prop. - Theorem inst : (x:A)(all ? [x](P x))->(P x). + Theorem inst : forall x:A, all (fun x => P x) -> P x. Proof. - Unfold all; Auto. + unfold all in |- *; auto. Qed. - Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(all A P). + Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P. Proof. - Red; Auto. + red in |- *; auto. Qed. End universal_quantification. @@ -177,66 +156,60 @@ Section universal_quantification. The others properties (symmetry, transitivity, replacement of equals) are proved below *) -Inductive eq [A:Type;x:A] : A->Prop - := refl_equal : x = x :> A - -where "x = y :> A" := (!eq A x y) : type_scope. +Inductive eq (A:Type) (x:A) : A -> Prop := + refl_equal : x = x :>A + where "x = y :> A" := (@eq A x y) : type_scope. -Notation "x = y" := (eq ? x y) : type_scope. -Notation "x <> y :> T" := ~ (!eq T x y) : type_scope. -Notation "x <> y" := ~ x=y : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. +Notation "x <> y :> T" := (~ x = y :>T) : type_scope. +Notation "x <> y" := (x <> y :>_) : type_scope. -Implicits eq_ind [1]. -Implicits eq_rec [1]. -Implicits eq_rect [1]. -V7only [ -Implicits eq_ind []. -Implicits eq_rec []. -Implicits eq_rect []. -]. +Implicit Arguments eq_ind [A]. +Implicit Arguments eq_rec [A]. +Implicit Arguments eq_rect [A]. -Hints Resolve I conj or_introl or_intror refl_equal : core v62. -Hints Resolve ex_intro ex_intro2 : core v62. +Hint Resolve I conj or_introl or_intror refl_equal: core v62. +Hint Resolve ex_intro ex_intro2: core v62. Section Logic_lemmas. - Theorem absurd : (A:Prop)(C:Prop) A -> (not A) -> C. + Theorem absurd : forall A C:Prop, A -> ~ A -> C. Proof. - Unfold not; Intros A C h1 h2. - NewDestruct (h2 h1). + unfold not in |- *; intros A C h1 h2. + destruct (h2 h1). Qed. Section equality. - Variable A,B : Type. - Variable f : A->B. - Variable x,y,z : A. + Variables A B : Type. + Variable f : A -> B. + Variables x y z : A. - Theorem sym_eq : (eq ? x y) -> (eq ? y x). + Theorem sym_eq : x = y -> y = x. Proof. - NewDestruct 1; Trivial. + destruct 1; trivial. Defined. Opaque sym_eq. - Theorem trans_eq : (eq ? x y) -> (eq ? y z) -> (eq ? x z). + Theorem trans_eq : x = y -> y = z -> x = z. Proof. - NewDestruct 2; Trivial. + destruct 2; trivial. Defined. Opaque trans_eq. - Theorem f_equal : (eq ? x y) -> (eq ? (f x) (f y)). + Theorem f_equal : x = y -> f x = f y. Proof. - NewDestruct 1; Trivial. + destruct 1; trivial. Defined. Opaque f_equal. - Theorem sym_not_eq : (not (eq ? x y)) -> (not (eq ? y x)). + Theorem sym_not_eq : x <> y -> y <> x. Proof. - Red; Intros h1 h2; Apply h1; NewDestruct h2; Trivial. + red in |- *; intros h1 h2; apply h1; destruct h2; trivial. Qed. - Definition sym_equal := sym_eq. + Definition sym_equal := sym_eq. Definition sym_not_equal := sym_not_eq. - Definition trans_equal := trans_eq. + Definition trans_equal := trans_eq. End equality. @@ -250,56 +223,53 @@ Section Logic_lemmas. Qed. *) - Definition eq_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eq ? y x)->(P y). - Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption. + Definition eq_ind_r : + forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y. + intros A x P H y H0; elim sym_eq with (1 := H0); assumption. Defined. - Definition eq_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eq ? y x)->(P y). - Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption. + Definition eq_rec_r : + forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y. + intros A x P H y H0; elim sym_eq with (1 := H0); assumption. Defined. - Definition eq_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? y x)->(P y). - Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption. + Definition eq_rect_r : + forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y. + intros A x P H y H0; elim sym_eq with (1 := H0); assumption. Defined. End Logic_lemmas. -Theorem f_equal2 : (A1,A2,B:Type)(f:A1->A2->B)(x1,y1:A1)(x2,y2:A2) - (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? (f x1 x2) (f y1 y2)). +Theorem f_equal2 : + forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1) + (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2. Proof. - NewDestruct 1; NewDestruct 1; Reflexivity. + destruct 1; destruct 1; reflexivity. Qed. -Theorem f_equal3 : (A1,A2,A3,B:Type)(f:A1->A2->A3->B)(x1,y1:A1)(x2,y2:A2) - (x3,y3:A3)(eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) - -> (eq ? (f x1 x2 x3) (f y1 y2 y3)). +Theorem f_equal3 : + forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) + (x2 y2:A2) (x3 y3:A3), + x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3. Proof. - NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity. + destruct 1; destruct 1; destruct 1; reflexivity. Qed. -Theorem f_equal4 : (A1,A2,A3,A4,B:Type)(f:A1->A2->A3->A4->B) - (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4) - (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4) - -> (eq ? (f x1 x2 x3 x4) (f y1 y2 y3 y4)). +Theorem f_equal4 : + forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B) + (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4), + x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4. Proof. - NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity. + destruct 1; destruct 1; destruct 1; destruct 1; reflexivity. Qed. -Theorem f_equal5 : (A1,A2,A3,A4,A5,B:Type)(f:A1->A2->A3->A4->A5->B) - (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)(x5,y5:A5) - (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4) -> (eq ? x5 y5) - -> (eq ? (f x1 x2 x3 x4 x5) (f y1 y2 y3 y4 y5)). +Theorem f_equal5 : + forall (A1 A2 A3 A4 A5 B:Type) (f:A1 -> A2 -> A3 -> A4 -> A5 -> B) + (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4) (x5 y5:A5), + x1 = y1 -> + x2 = y2 -> + x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5. Proof. - NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; - Reflexivity. + destruct 1; destruct 1; destruct 1; destruct 1; destruct 1; reflexivity. Qed. -Hints Immediate sym_eq sym_not_eq : core v62. - -V7only[ -(** Parsing only of things in [Logic.v] *) -Notation "< A > 'All' ( P )" :=(all A P) (A annot, at level 1, only parsing). -Notation "< A > x = y" := (eq A x y) - (A annot, at level 1, x at level 0, only parsing). -Notation "< A > x <> y" := ~(eq A x y) - (A annot, at level 1, x at level 0, only parsing). -]. +Hint Immediate sym_eq sym_not_eq: core v62. diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index 1249e62ea..7f88476a4 100755 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -9,294 +9,81 @@ (*i $Id$ i*) Set Implicit Arguments. -V7only [Unset Implicit Arguments.]. (** This module defines quantification on the world [Type] ([Logic.v] was defining it on the world [Set]) *) -Require Datatypes. +Require Import Datatypes. Require Export Logic. -V7only [ -(* -(** [allT A P], or simply [(ALLT x | P(x))], stands for [(x:A)(P x)] - when [A] is of type [Type] *) +Definition notT (A:Type) := A -> False. -Definition allT := [A:Type][P:A->Prop](x:A)(P x). -*) - -Notation allT := all (only parsing). -Notation inst := Logic.inst (only parsing). -Notation gen := Logic.gen (only parsing). - -(* Order is important to give printing priority to fully typed ALL and EX *) - -Notation AllT := (all ?). -Notation "'ALLT' x | p" := (all ? [x]p) (at level 10, p at level 8). -Notation "'ALLT' x : t | p" := (all ? [x:t]p) (at level 10, p at level 8). - -(* -Section universal_quantification. - -Variable A : Type. -Variable P : A->Prop. - -Theorem inst : (x:A)(allT ? [x](P x))->(P x). -Proof. -Unfold all; Auto. -Qed. - -Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(allT A P). -Proof. -Red; Auto. -Qed. - -End universal_quantification. -*) - -(* -(** * Existential Quantification *) - -(** [exT A P], or simply [(EXT x | P(x))], stands for the existential - quantification on the predicate [P] when [A] is of type [Type] *) - -(** [exT2 A P Q], or simply [(EXT x | P(x) & Q(x))], stands for the - existential quantification on both [P] and [Q] when [A] is of - type [Type] *) -Inductive exT [A:Type;P:A->Prop] : Prop - := exT_intro : (x:A)(P x)->(exT A P). -*) - -Notation exT := ex (only parsing). -Notation exT_intro := ex_intro (only parsing). -Notation exT_ind := ex_ind (only parsing). - -Notation ExT := (ex ?). -Notation "'EXT' x | p" := (ex ? [x]p) (at level 10, p at level 8). -Notation "'EXT' x : t | p" := (ex ? [x:t]p) (at level 10, p at level 8). - -(* -Inductive exT2 [A:Type;P,Q:A->Prop] : Prop - := exT_intro2 : (x:A)(P x)->(Q x)->(exT2 A P Q). -*) - -Notation exT2 := ex2 (only parsing). -Notation exT_intro2 := ex_intro2 (only parsing). -Notation exT2_ind := ex2_ind (only parsing). - -Notation ExT2 := (ex2 ?). -Notation "'EXT' x | p & q" := (ex2 ? [x]p [x]q) - (at level 10, p, q at level 8). -Notation "'EXT' x : t | p & q" := (ex2 ? [x:t]p [x:t]q) - (at level 10, p, q at level 8). - -(* -(** Leibniz equality : [A:Type][x,y:A] (P:A->Prop)(P x)->(P y) - - [eqT A x y], or simply [x==y], is Leibniz' equality when [A] is of - type [Type]. This equality satisfies reflexivity (by definition), - symmetry, transitivity and stability by congruence *) - - -Inductive eqT [A:Type;x:A] : A -> Prop - := refl_eqT : (eqT A x x). - -Hints Resolve refl_eqT (* exT_intro2 exT_intro *) : core v62. -*) - -Notation eqT := eq (only parsing). -Notation refl_eqT := refl_equal (only parsing). -Notation eqT_ind := eq_ind (only parsing). -Notation eqT_rect := eq_rect (only parsing). -Notation eqT_rec := eq_rec (only parsing). - -Notation "x == y" := (eq ? x y) (at level 5, no associativity, only parsing). - -(** Parsing only of things in [Logic_type.v] *) - -Notation "< A > x == y" := (eq A x y) - (A annot, at level 1, x at level 0, only parsing). - -(* -Section Equality_is_a_congruence. - - Variables A,B : Type. - Variable f : A->B. - - Variable x,y,z : A. - - Lemma sym_eqT : (eqT ? x y) -> (eqT ? y x). - Proof. - NewDestruct 1; Trivial. - Qed. - - Lemma trans_eqT : (eqT ? x y) -> (eqT ? y z) -> (eqT ? x z). - Proof. - NewDestruct 2; Trivial. - Qed. - - Lemma congr_eqT : (eqT ? x y)->(eqT ? (f x) (f y)). - Proof. - NewDestruct 1; Trivial. - Qed. - - Lemma sym_not_eqT : ~(eqT ? x y) -> ~(eqT ? y x). - Proof. - Red; Intros H H'; Apply H; NewDestruct H'; Trivial. - Qed. - -End Equality_is_a_congruence. -*) - -Notation sym_eqT := sym_eq (only parsing). -Notation trans_eqT := trans_eq (only parsing). -Notation congr_eqT := f_equal (only parsing). -Notation sym_not_eqT := sym_not_eq (only parsing). - -(* -Hints Immediate sym_eqT sym_not_eqT : core v62. -*) - -(** This states the replacement of equals by equals *) - -(* -Definition eqT_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eqT ? y x)->(P y). -Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial. -Defined. - -Definition eqT_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eqT ? y x)->(P y). -Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial. -Defined. - -Definition eqT_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eqT ? y x)->(P y). -Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial. -Defined. -*) - -Notation eqT_ind_r := eq_ind_r (only parsing). -Notation eqT_rec_r := eq_rec_r (only parsing). -Notation eqT_rect_r := eq_rect_r (only parsing). - -(** Some datatypes at the [Type] level *) -(* -Inductive EmptyT: Type :=. -Inductive UnitT : Type := IT : UnitT. -*) - -Notation EmptyT := False (only parsing). -Notation UnitT := unit (only parsing). -Notation IT := tt. -]. -Definition notT := [A:Type] A->EmptyT. - -V7only [ -(** Have you an idea of what means [identityT A a b]? No matter! *) - -(* -Inductive identityT [A:Type; a:A] : A -> Type := - refl_identityT : (identityT A a a). -*) - -Notation identityT := identity (only parsing). -Notation refl_identityT := refl_identity (only parsing). - -Notation "< A > x === y" := (!identityT A x y) - (A annot, at level 1, x at level 0, only parsing). - -Notation "x === y" := (identityT ? x y) - (at level 5, no associativity) : type_scope. - -(* -Hints Resolve refl_identityT : core v62. -*) -]. Section identity_is_a_congruence. - Variables A,B : Type. - Variable f : A->B. + Variables A B : Type. + Variable f : A -> B. - Variable x,y,z : A. + Variables x y z : A. - Lemma sym_id : (identityT ? x y) -> (identityT ? y x). + Lemma sym_id : identity x y -> identity y x. Proof. - NewDestruct 1; Trivial. + destruct 1; trivial. Qed. - Lemma trans_id : (identityT ? x y) -> (identityT ? y z) -> (identityT ? x z). + Lemma trans_id : identity x y -> identity y z -> identity x z. Proof. - NewDestruct 2; Trivial. + destruct 2; trivial. Qed. - Lemma congr_id : (identityT ? x y)->(identityT ? (f x) (f y)). + Lemma congr_id : identity x y -> identity (f x) (f y). Proof. - NewDestruct 1; Trivial. + destruct 1; trivial. Qed. - Lemma sym_not_id : (notT (identityT ? x y)) -> (notT (identityT ? y x)). + Lemma sym_not_id : notT (identity x y) -> notT (identity y x). Proof. - Red; Intros H H'; Apply H; NewDestruct H'; Trivial. + red in |- *; intros H H'; apply H; destruct H'; trivial. Qed. End identity_is_a_congruence. Definition identity_ind_r : - (A:Type) - (a:A) - (P:A->Prop) - (P a)->(y:A)(identityT ? y a)->(P y). - Intros A x P H y H0; Case sym_id with 1:= H0; Trivial. + forall (A:Type) (a:A) (P:A -> Prop), P a -> forall y:A, identity y a -> P y. + intros A x P H y H0; case sym_id with (1 := H0); trivial. Defined. -Definition identity_rec_r : - (A:Type) - (a:A) - (P:A->Set) - (P a)->(y:A)(identityT ? y a)->(P y). - Intros A x P H y H0; Case sym_id with 1:= H0; Trivial. +Definition identity_rec_r : + forall (A:Type) (a:A) (P:A -> Set), P a -> forall y:A, identity y a -> P y. + intros A x P H y H0; case sym_id with (1 := H0); trivial. Defined. -Definition identity_rect_r : - (A:Type) - (a:A) - (P:A->Type) - (P a)->(y:A)(identityT ? y a)->(P y). - Intros A x P H y H0; Case sym_id with 1:= H0; Trivial. +Definition identity_rect_r : + forall (A:Type) (a:A) (P:A -> Type), P a -> forall y:A, identity y a -> P y. + intros A x P H y H0; case sym_id with (1 := H0); trivial. Defined. -V7only [ -Notation sym_idT := sym_id (only parsing). -Notation trans_idT := trans_id (only parsing). -Notation congr_idT := congr_id (only parsing). -Notation sym_not_idT := sym_not_id (only parsing). -Notation identityT_ind_r := identityT_ind_r (only parsing). -Notation identityT_rec_r := identityT_rec_r (only parsing). -Notation identityT_rect_r := identityT_rect_r (only parsing). -]. -Inductive prodT [A,B:Type] : Type := pairT : A -> B -> (prodT A B). +Inductive prodT (A B:Type) : Type := + pairT : A -> B -> prodT A B. Section prodT_proj. - Variables A, B : Type. + Variables A B : Type. - Definition fstT := [H:(prodT A B)]Cases H of (pairT x _) => x end. - Definition sndT := [H:(prodT A B)]Cases H of (pairT _ y) => y end. + Definition fstT (H:prodT A B) := match H with + | pairT x _ => x + end. + Definition sndT (H:prodT A B) := match H with + | pairT _ y => y + end. End prodT_proj. -Definition prodT_uncurry : (A,B,C:Type)((prodT A B)->C)->A->B->C := - [A,B,C:Type; f:((prodT A B)->C); x:A; y:B] - (f (pairT A B x y)). - -Definition prodT_curry : (A,B,C:Type)(A->B->C)->(prodT A B)->C := - [A,B,C:Type; f:(A->B->C); p:(prodT A B)] - Cases p of - | (pairT x y) => (f x y) - end. +Definition prodT_uncurry (A B C:Type) (f:prodT A B -> C) + (x:A) (y:B) : C := f (pairT x y). -Hints Immediate sym_id sym_not_id : core v62. +Definition prodT_curry (A B C:Type) (f:A -> B -> C) + (p:prodT A B) : C := match p with + | pairT x y => f x y + end. -V7only [ -Implicits fstT [1 2]. -Implicits sndT [1 2]. -Implicits pairT [1 2]. -]. +Hint Immediate sym_id sym_not_id: core v62. diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v index 624f6c902..ce1d4d7c9 100644 --- a/theories/Init/Notations.v +++ b/theories/Init/Notations.v @@ -12,97 +12,80 @@ (** Notations for logical connectives *) -Uninterpreted Notation "x <-> y" (at level 8, right associativity) - V8only (at level 95, no associativity). -Uninterpreted Notation "x /\ y" (at level 6, right associativity) - V8only (at level 80, right associativity). -Uninterpreted Notation "x \/ y" (at level 7, right associativity) - V8only (at level 85, right associativity). -Uninterpreted Notation "~ x" (at level 5, right associativity) - V8only (at level 75, right associativity). +Reserved Notation "x <-> y" (at level 95, no associativity). +Reserved Notation "x /\ y" (at level 80, right associativity). +Reserved Notation "x \/ y" (at level 85, right associativity). +Reserved Notation "~ x" (at level 75, right associativity). (** Notations for equality and inequalities *) -Uninterpreted Notation "x = y :> T" - (at level 5, y at next level, no associativity). -Uninterpreted Notation "x = y" - (at level 5, no associativity). -Uninterpreted Notation "x = y = z" - (at level 5, no associativity, y at next level). +Reserved Notation "x = y :> T" +(at level 70, y at next level, no associativity). +Reserved Notation "x = y" (at level 70, no associativity). +Reserved Notation "x = y = z" +(at level 70, no associativity, y at next level). -Uninterpreted Notation "x <> y :> T" - (at level 5, y at next level, no associativity). -Uninterpreted Notation "x <> y" - (at level 5, no associativity). +Reserved Notation "x <> y :> T" +(at level 70, y at next level, no associativity). +Reserved Notation "x <> y" (at level 70, no associativity). -Uninterpreted V8Notation "x <= y" (at level 70, no associativity). -Uninterpreted V8Notation "x < y" (at level 70, no associativity). -Uninterpreted V8Notation "x >= y" (at level 70, no associativity). -Uninterpreted V8Notation "x > y" (at level 70, no associativity). +Reserved Notation "x <= y" (at level 70, no associativity). +Reserved Notation "x < y" (at level 70, no associativity). +Reserved Notation "x >= y" (at level 70, no associativity). +Reserved Notation "x > y" (at level 70, no associativity). -Uninterpreted V8Notation "x <= y <= z" (at level 70, y at next level). -Uninterpreted V8Notation "x <= y < z" (at level 70, y at next level). -Uninterpreted V8Notation "x < y < z" (at level 70, y at next level). -Uninterpreted V8Notation "x < y <= z" (at level 70, y at next level). +Reserved Notation "x <= y <= z" (at level 70, y at next level). +Reserved Notation "x <= y < z" (at level 70, y at next level). +Reserved Notation "x < y < z" (at level 70, y at next level). +Reserved Notation "x < y <= z" (at level 70, y at next level). (** Arithmetical notations (also used for type constructors) *) -Uninterpreted Notation "x + y" (at level 4, left associativity). -Uninterpreted V8Notation "x - y" (at level 50, left associativity). -Uninterpreted Notation "x * y" (at level 3, right associativity) - V8only (at level 40, left associativity). -Uninterpreted V8Notation "x / y" (at level 40, left associativity). -Uninterpreted V8Notation "- x" (at level 35, right associativity). -Uninterpreted V8Notation "/ x" (at level 35, right associativity). -Uninterpreted V8Notation "x ^ y" (at level 30, left associativity). +Reserved Notation "x + y" (at level 50, left associativity). +Reserved Notation "x - y" (at level 50, left associativity). +Reserved Notation "x * y" (at level 40, left associativity). +Reserved Notation "x / y" (at level 40, left associativity). +Reserved Notation "- x" (at level 35, right associativity). +Reserved Notation "/ x" (at level 35, right associativity). +Reserved Notation "x ^ y" (at level 30, left associativity). (** Notations for pairs *) -Uninterpreted Notation "( x , y )" (at level 0) - V8only "x , y" (at level 250, left associativity). +Reserved Notation "x , y" (at level 250, left associativity). (** Notations for sum-types *) (* Home-made factorization at level 4 to parse B+{x:A|P} without parentheses *) -Uninterpreted Notation "B + { x : A | P }" - (at level 4, left associativity, only parsing) - V8only (at level 50, x at level 99, left associativity, only parsing). +Reserved Notation "B + { x : A | P }" +(at level 50, x at level 99, left associativity, only parsing). -Uninterpreted Notation "B + { x : A | P & Q }" - (at level 4, left associativity, only parsing) - V8only (at level 50, x at level 99, left associativity, only parsing). +Reserved Notation "B + { x : A | P & Q }" +(at level 50, x at level 99, left associativity, only parsing). -Uninterpreted Notation "B + { x : A & P }" - (at level 4, left associativity, only parsing) - V8only (at level 50, x at level 99, left associativity, only parsing). +Reserved Notation "B + { x : A & P }" +(at level 50, x at level 99, left associativity, only parsing). -Uninterpreted Notation "B + { x : A & P & Q }" - (at level 4, left associativity, only parsing) - V8only (at level 50, x at level 99, left associativity, only parsing). +Reserved Notation "B + { x : A & P & Q }" +(at level 50, x at level 99, left associativity, only parsing). (* At level 1 to factor with {x:A|P} etc *) -Uninterpreted Notation "{ A } + { B }" (at level 1) - V8only (at level 0, A at level 99). +Reserved Notation "{ A } + { B }" (at level 0, A at level 99). -Uninterpreted Notation "A + { B }" (at level 4, left associativity) - V8only (at level 50, B at level 99, left associativity). +Reserved Notation "A + { B }" +(at level 50, B at level 99, left associativity). (** Notations for sigma-types or subsets *) -Uninterpreted Notation "{ x : A | P }" (at level 1) - V8only (at level 0, x at level 99). -Uninterpreted Notation "{ x : A | P & Q }" (at level 1) - V8only (at level 0, x at level 99). +Reserved Notation "{ x : A | P }" (at level 0, x at level 99). +Reserved Notation "{ x : A | P & Q }" (at level 0, x at level 99). -Uninterpreted Notation "{ x : A & P }" (at level 1) - V8only (at level 0, x at level 99). -Uninterpreted Notation "{ x : A & P & Q }" (at level 1) - V8only (at level 0, x at level 99). +Reserved Notation "{ x : A & P }" (at level 0, x at level 99). +Reserved Notation "{ x : A & P & Q }" (at level 0, x at level 99). -Delimits Scope type_scope with type. -Delimits Scope core_scope with core. +Delimit Scope type_scope with type. +Delimit Scope core_scope with core. Open Scope core_scope. -Open Scope type_scope. +Open Scope type_scope.
\ No newline at end of file diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index 2356c9cb5..3506b9bab 100755 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -23,196 +23,188 @@ including Peano's axioms of arithmetic (in Coq, these are in fact provable) Case analysis on [nat] and induction on [nat * nat] are provided too *) -Require Notations. -Require Datatypes. -Require Logic. +Require Import Notations. +Require Import Datatypes. +Require Import Logic. Open Scope nat_scope. -Definition eq_S := (f_equal nat nat S). +Definition eq_S := f_equal S. -Hint eq_S : v62 := Resolve (f_equal nat nat S). -Hint eq_nat_unary : core := Resolve (f_equal nat). +Hint Resolve (f_equal S): v62. +Hint Resolve (f_equal (A:=nat)): core. (** The predecessor function *) -Definition pred : nat->nat := [n:nat](Cases n of O => O | (S u) => u end). -Hint eq_pred : v62 := Resolve (f_equal nat nat pred). +Definition pred (n:nat) : nat := match n with + | O => 0 + | S u => u + end. +Hint Resolve (f_equal pred): v62. -Theorem pred_Sn : (m:nat) m=(pred (S m)). +Theorem pred_Sn : forall n:nat, n = pred (S n). Proof. - Auto. + auto. Qed. -Theorem eq_add_S : (n,m:nat) (S n)=(S m) -> n=m. +Theorem eq_add_S : forall n m:nat, S n = S m -> n = m. Proof. - Intros n m H ; Change (pred (S n))=(pred (S m)); Auto. + intros n m H; change (pred (S n) = pred (S m)) in |- *; auto. Qed. -Hints Immediate eq_add_S : core v62. +Hint Immediate eq_add_S: core v62. (** A consequence of the previous axioms *) -Theorem not_eq_S : (n,m:nat) ~(n=m) -> ~((S n)=(S m)). +Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m. Proof. - Red; Auto. + red in |- *; auto. Qed. -Hints Resolve not_eq_S : core v62. +Hint Resolve not_eq_S: core v62. -Definition IsSucc : nat->Prop - := [n:nat]Cases n of O => False | (S p) => True end. +Definition IsSucc (n:nat) : Prop := + match n with + | O => False + | S p => True + end. -Theorem O_S : (n:nat)~(O=(S n)). +Theorem O_S : forall n:nat, 0 <> S n. Proof. - Red;Intros n H. - Change (IsSucc O). - Rewrite <- (sym_eq nat O (S n));[Exact I | Assumption]. + red in |- *; intros n H. + change (IsSucc 0) in |- *. + rewrite <- (sym_eq (x:=0) (y:=(S n))); [ exact I | assumption ]. Qed. -Hints Resolve O_S : core v62. +Hint Resolve O_S: core v62. -Theorem n_Sn : (n:nat) ~(n=(S n)). +Theorem n_Sn : forall n:nat, n <> S n. Proof. - NewInduction n ; Auto. + induction n; auto. Qed. -Hints Resolve n_Sn : core v62. +Hint Resolve n_Sn: core v62. (** Addition *) -Fixpoint plus [n:nat] : nat -> nat := - [m:nat]Cases n of - O => m - | (S p) => (S (plus p m)) end. -Hint eq_plus : v62 := Resolve (f_equal2 nat nat nat plus). -Hint eq_nat_binary : core := Resolve (f_equal2 nat nat). +Fixpoint plus (n m:nat) {struct n} : nat := + match n with + | O => m + | S p => S (plus p m) + end. +Hint Resolve (f_equal2 plus): v62. +Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core. -V8Infix "+" plus : nat_scope. +Infix "+" := plus : nat_scope. -Lemma plus_n_O : (n:nat) n=(plus n O). +Lemma plus_n_O : forall n:nat, n = n + 0. Proof. - NewInduction n ; Simpl ; Auto. + induction n; simpl in |- *; auto. Qed. -Hints Resolve plus_n_O : core v62. +Hint Resolve plus_n_O: core v62. -Lemma plus_O_n : (n:nat) (plus O n)=n. +Lemma plus_O_n : forall n:nat, 0 + n = n. Proof. - Auto. + auto. Qed. -Lemma plus_n_Sm : (n,m:nat) (S (plus n m))=(plus n (S m)). +Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m. Proof. - Intros n m; NewInduction n; Simpl; Auto. + intros n m; induction n; simpl in |- *; auto. Qed. -Hints Resolve plus_n_Sm : core v62. +Hint Resolve plus_n_Sm: core v62. -Lemma plus_Sn_m : (n,m:nat)(plus (S n) m)=(S (plus n m)). +Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m). Proof. - Auto. + auto. Qed. (** Multiplication *) -Fixpoint mult [n:nat] : nat -> nat := - [m:nat]Cases n of O => O - | (S p) => (plus m (mult p m)) end. -Hint eq_mult : core v62 := Resolve (f_equal2 nat nat nat mult). +Fixpoint mult (n m:nat) {struct n} : nat := + match n with + | O => 0 + | S p => m + mult p m + end. +Hint Resolve (f_equal2 mult): core v62. -V8Infix "*" mult : nat_scope. +Infix "*" := mult : nat_scope. -Lemma mult_n_O : (n:nat) O=(mult n O). +Lemma mult_n_O : forall n:nat, 0 = n * 0. Proof. - NewInduction n; Simpl; Auto. + induction n; simpl in |- *; auto. Qed. -Hints Resolve mult_n_O : core v62. +Hint Resolve mult_n_O: core v62. -Lemma mult_n_Sm : (n,m:nat) (plus (mult n m) n)=(mult n (S m)). +Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m. Proof. - Intros; NewInduction n as [|p H]; Simpl; Auto. - NewDestruct H; Rewrite <- plus_n_Sm; Apply (f_equal nat nat S). - Pattern 1 3 m; Elim m; Simpl; Auto. + 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. Qed. -Hints Resolve mult_n_Sm : core v62. +Hint Resolve mult_n_Sm: core v62. (** Definition of subtraction on [nat] : [m-n] is [0] if [n>=m] *) -Fixpoint minus [n:nat] : nat -> nat := - [m:nat]Cases n m of - O _ => O - | (S k) O => (S k) - | (S k) (S l) => (minus k l) - end. +Fixpoint minus (n m:nat) {struct n} : nat := + match n, m with + | O, _ => 0 + | S k, O => S k + | S k, S l => minus k l + end. -V8Infix "-" minus : nat_scope. +Infix "-" := minus : nat_scope. (** Definition of the usual orders, the basic properties of [le] and [lt] can be found in files Le and Lt *) (** An inductive definition to define the order *) -Inductive le [n:nat] : nat -> Prop - := le_n : (le n n) - | le_S : (m:nat)(le n m)->(le n (S m)). +Inductive le (n:nat) : nat -> Prop := + | le_n : le n n + | le_S : forall m:nat, le n m -> le n (S m). -V8Infix "<=" le : nat_scope. +Infix "<=" := le : nat_scope. -Hint constr_le : core v62 := Constructors le. +Hint Constructors le: core v62. (*i equivalent to : "Hints Resolve le_n le_S : core v62." i*) -Definition lt := [n,m:nat](le (S n) m). -Hints Unfold lt : core v62. +Definition lt (n m:nat) := S n <= m. +Hint Unfold lt: core v62. -V8Infix "<" lt : nat_scope. +Infix "<" := lt : nat_scope. -Definition ge := [n,m:nat](le m n). -Hints Unfold ge : core v62. +Definition ge (n m:nat) := m <= n. +Hint Unfold ge: core v62. -V8Infix ">=" ge : nat_scope. +Infix ">=" := ge : nat_scope. -Definition gt := [n,m:nat](lt m n). -Hints Unfold gt : core v62. +Definition gt (n m:nat) := m < n. +Hint Unfold gt: core v62. -V8Infix ">" gt : nat_scope. +Infix ">" := gt : nat_scope. -V8Notation "x <= y <= z" := (le x y)/\(le y z) : nat_scope. -V8Notation "x <= y < z" := (le x y)/\(lt y z) : nat_scope. -V8Notation "x < y < z" := (lt x y)/\(lt y z) : nat_scope. -V8Notation "x < y <= z" := (lt x y)/\(le y z) : nat_scope. +Notation "x <= y <= z" := (x <= y /\ y <= z) : nat_scope. +Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope. +Notation "x < y < z" := (x < y /\ y < z) : nat_scope. +Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope. (** Pattern-Matching on natural numbers *) -Theorem nat_case : (n:nat)(P:nat->Prop)(P O)->((m:nat)(P (S m)))->(P n). +Theorem nat_case : + forall (n:nat) (P:nat -> Prop), P 0 -> (forall m:nat, P (S m)) -> P n. Proof. - NewInduction n ; Auto. + induction n; auto. Qed. (** Principle of double induction *) -Theorem nat_double_ind : (R:nat->nat->Prop) - ((n:nat)(R O n)) -> ((n:nat)(R (S n) O)) - -> ((n,m:nat)(R n m)->(R (S n) (S m))) - -> (n,m:nat)(R n m). +Theorem nat_double_ind : + forall R:nat -> nat -> Prop, + (forall n:nat, R 0 n) -> + (forall n:nat, R (S n) 0) -> + (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m. Proof. - NewInduction n; Auto. - NewDestruct m; Auto. + induction n; auto. + destruct m as [| n0]; auto. Qed. (** Notations *) -V7only[ -Syntax constr - level 0: - S [ (S $p) ] -> [$p:"nat_printer":9] - | O [ O ] -> ["(0)"]. -]. - -V7only [ -(* For parsing/printing based on scopes *) -Module nat_scope. -Infix 4 "+" plus : nat_scope. -Infix 3 "*" mult : nat_scope. -Infix 4 "-" minus : nat_scope. -Infix NONA 5 "<=" le : nat_scope. -Infix NONA 5 "<" lt : nat_scope. -Infix NONA 5 ">=" ge : nat_scope. -Infix NONA 5 ">" gt : nat_scope. -End nat_scope. -]. diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v index 7325cc771..f5be0d594 100755 --- a/theories/Init/Prelude.v +++ b/theories/Init/Prelude.v @@ -13,4 +13,4 @@ Require Export Logic. Require Export Datatypes. Require Export Specif. Require Export Peano. -Require Export Wf. +Require Export Wf.
\ No newline at end of file diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index 2e49fab04..eb775505f 100755 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -9,13 +9,12 @@ (*i $Id$ i*) Set Implicit Arguments. -V7only [Unset Implicit Arguments.]. (** Basic specifications : Sets containing logical information *) -Require Notations. -Require Datatypes. -Require Logic. +Require Import Notations. +Require Import Datatypes. +Require Import Logic. (** Subsets *) @@ -24,31 +23,33 @@ Require Logic. Similarly [(sig2 A P Q)], or [{x:A | (P x) & (Q x)}], denotes the subset of elements of the Set [A] which satisfy both [P] and [Q]. *) -Inductive sig [A:Set;P:A->Prop] : Set - := exist : (x:A)(P x) -> (sig A P). +Inductive sig (A:Set) (P:A -> Prop) : Set := + exist : forall x:A, P x -> sig (A:=A) P. -Inductive sig2 [A:Set;P,Q:A->Prop] : Set - := exist2 : (x:A)(P x) -> (Q x) -> (sig2 A P Q). +Inductive sig2 (A:Set) (P Q:A -> Prop) : Set := + exist2 : forall x:A, P x -> Q x -> sig2 (A:=A) P Q. (** [(sigS A P)], or more suggestively [{x:A & (P x)}], is a subtle variant of subset where [P] is now of type [Set]. Similarly for [(sigS2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *) -Inductive sigS [A:Set;P:A->Set] : Set - := existS : (x:A)(P x) -> (sigS A P). +Inductive sigS (A:Set) (P:A -> Set) : Set := + existS : forall x:A, P x -> sigS (A:=A) P. -Inductive sigS2 [A:Set;P,Q:A->Set] : Set - := existS2 : (x:A)(P x) -> (Q x) -> (sigS2 A P Q). +Inductive sigS2 (A:Set) (P Q:A -> Set) : Set := + existS2 : forall x:A, P x -> Q x -> sigS2 (A:=A) P Q. Arguments Scope sig [type_scope type_scope]. Arguments Scope sig2 [type_scope type_scope type_scope]. Arguments Scope sigS [type_scope type_scope]. Arguments Scope sigS2 [type_scope type_scope type_scope]. -Notation "{ x : A | P }" := (sig A [x:A]P) : type_scope. -Notation "{ x : A | P & Q }" := (sig2 A [x:A]P [x:A]Q) : type_scope. -Notation "{ x : A & P }" := (sigS A [x:A]P) : type_scope. -Notation "{ x : A & P & Q }" := (sigS2 A [x:A]P [x:A]Q) : type_scope. +Notation "{ x : A | P }" := (sig (fun x:A => P)) : type_scope. +Notation "{ x : A | P & Q }" := (sig2 (fun x:A => P) (fun x:A => Q)) : + type_scope. +Notation "{ x : A & P }" := (sigS (fun x:A => P)) : type_scope. +Notation "{ x : A & P & Q }" := (sigS2 (fun x:A => P) (fun x:A => Q)) : + type_scope. Add Printing Let sig. Add Printing Let sig2. @@ -60,15 +61,17 @@ Add Printing Let sigS2. Section Subset_projections. - Variable A:Set. - Variable P:A->Prop. + Variable A : Set. + Variable P : A -> Prop. - Definition proj1_sig := - [e:(sig A P)]Cases e of (exist a b) => a end. + Definition proj1_sig (e:sig P) := match e with + | exist a b => a + end. - Definition proj2_sig := - [e:(sig A P)] - <[e:(sig A P)](P (proj1_sig e))>Cases e of (exist a b) => b end. + Definition proj2_sig (e:sig P) := + match e return P (proj1_sig e) with + | exist a b => b + end. End Subset_projections. @@ -77,46 +80,46 @@ End Subset_projections. Section Projections. - Variable A:Set. - Variable P:A->Set. + Variable A : Set. + Variable P : A -> Set. (** An element [y] of a subset [{x:A & (P x)}] is the pair of an [a] of type [A] and of a proof [h] that [a] satisfies [P]. Then [(projS1 y)] is the witness [a] and [(projS2 y)] is the proof of [(P a)] *) - Definition projS1 : (sigS A P) -> A - := [x:(sigS A P)]Cases x of (existS a _) => a end. - Definition projS2 : (x:(sigS A P))(P (projS1 x)) - := [x:(sigS A P)]<[x:(sigS A P)](P (projS1 x))> - Cases x of (existS _ h) => h end. + Definition projS1 (x:sigS P) : A := match x with + | existS a _ => a + end. + Definition projS2 (x:sigS P) : P (projS1 x) := + match x return P (projS1 x) with + | existS _ h => h + end. End Projections. (** Extended_booleans *) -Inductive sumbool [A,B:Prop] : Set - := left : A -> {A}+{B} - | right : B -> {A}+{B} +Inductive sumbool (A B:Prop) : Set := + | left : A -> {A} + {B} + | right : B -> {A} + {B} + where "{ A } + { B }" := (sumbool A B) : type_scope. -where "{ A } + { B }" := (sumbool A B) : type_scope. - -Inductive sumor [A:Set;B:Prop] : Set - := inleft : A -> A+{B} - | inright : B -> A+{B} - -where "A + { B }" := (sumor A B) : type_scope. +Inductive sumor (A:Set) (B:Prop) : Set := + | inleft : A -> A + {B} + | inright : B -> A + {B} + where "A + { B }" := (sumor A B) : type_scope. (* Factorizing "sumor" at level 4 to parse B+{x:A|P} without parentheses *) -Notation "B + { x : A | P }" := B + (sig A [x:A]P) +Notation "B + { x : A | P }" := (B + sig (fun x:A => P)) (only parsing) : type_scope. -Notation "B + { x : A | P & Q }" := B + (sig2 A [x:A]P [x:A]Q) +Notation "B + { x : A | P & Q }" := (B + sig2 (fun x:A => P) (fun x:A => Q)) (only parsing) : type_scope. -Notation "B + { x : A & P }" := B + (sigS A [x:A]P) +Notation "B + { x : A & P }" := (B + sigS (fun x:A => P)) (only parsing) : type_scope. -Notation "B + { x : A & P & Q }" := B + (sigS2 A [x:A]P [x:A]Q) +Notation "B + { x : A & P & Q }" := (B + sigS2 (fun x:A => P) (fun x:A => Q)) (only parsing) : type_scope. (** Choice *) @@ -125,35 +128,46 @@ Section Choice_lemmas. (** The following lemmas state various forms of the axiom of choice *) - Variables S,S':Set. - Variable R:S->S'->Prop. - Variable R':S->S'->Set. - Variables R1,R2 :S->Prop. + Variables S S' : Set. + Variable R : S -> S' -> Prop. + Variable R' : S -> S' -> Set. + Variables R1 R2 : S -> Prop. - Lemma Choice : ((x:S)(sig ? [y:S'](R x y))) -> - (sig ? [f:S->S'](z:S)(R z (f z))). + Lemma Choice : + (forall x:S, sig (fun y:S' => R x y)) -> + sig (fun f:S -> S' => forall z:S, R z (f z)). Proof. - Intro H. - Exists [z:S]Cases (H z) of (exist y _) => y end. - Intro z; NewDestruct (H z); Trivial. + intro H. + exists (fun z:S => match H z with + | exist y _ => y + end). + intro z; destruct (H z); trivial. Qed. - Lemma Choice2 : ((x:S)(sigS ? [y:S'](R' x y))) -> - (sigS ? [f:S->S'](z:S)(R' z (f z))). + Lemma Choice2 : + (forall x:S, sigS (fun y:S' => R' x y)) -> + sigS (fun f:S -> S' => forall z:S, R' z (f z)). Proof. - Intro H. - Exists [z:S]Cases (H z) of (existS y _) => y end. - Intro z; NewDestruct (H z); Trivial. + intro H. + exists (fun z:S => match H z with + | existS y _ => y + end). + intro z; destruct (H z); trivial. Qed. - Lemma bool_choice : - ((x:S)(sumbool (R1 x) (R2 x))) -> - (sig ? [f:S->bool] (x:S)( ((f x)=true /\ (R1 x)) - \/ ((f x)=false /\ (R2 x)))). + Lemma bool_choice : + (forall x:S, {R1 x} + {R2 x}) -> + sig + (fun f:S -> bool => + forall x:S, f x = true /\ R1 x \/ f x = false /\ R2 x). Proof. - Intro H. - Exists [z:S]Cases (H z) of (left _) => true | (right _) => false end. - Intro z; NewDestruct (H z); Auto. + intro H. + exists + (fun z:S => match H z with + | left _ => true + | right _ => false + end). + intro z; destruct (H z); auto. Qed. End Choice_lemmas. @@ -165,51 +179,41 @@ End Choice_lemmas. Definition Exc := option. Definition value := Some. -Definition error := !None. +Definition error := @None. -Implicits error [1]. +Implicit Arguments error [A]. Definition except := False_rec. (* for compatibility with previous versions *) -Implicits except [1]. +Implicit Arguments except [P]. -V7only [ -Notation Except := (!except ?) (only parsing). -Notation Error := (!error ?) (only parsing). -V7only [Implicits error [].]. -V7only [Implicits except [].]. -]. -Theorem absurd_set : (A:Prop)(C:Set)A->(~A)->C. +Theorem absurd_set : forall (A:Prop) (C:Set), A -> ~ A -> C. Proof. - Intros A C h1 h2. - Apply False_rec. - Apply (h2 h1). + intros A C h1 h2. + apply False_rec. + apply (h2 h1). Qed. -Hints Resolve left right inleft inright : core v62. +Hint Resolve left right inleft inright: core v62. (** Sigma Type at Type level [sigT] *) -Inductive sigT [A:Type;P:A->Type] : Type - := existT : (x:A)(P x) -> (sigT A P). +Inductive sigT (A:Type) (P:A -> Type) : Type := + existT : forall x:A, P x -> sigT (A:=A) P. Section projections_sigT. - Variable A:Type. - Variable P:A->Type. + Variable A : Type. + Variable P : A -> Type. - Definition projT1 : (sigT A P) -> A - := [H:(sigT A P)]Cases H of (existT x _) => x end. + Definition projT1 (H:sigT P) : A := match H with + | existT x _ => x + end. - Definition projT2 : (x:(sigT A P))(P (projT1 x)) - := [H:(sigT A P)]<[H:(sigT A P)](P (projT1 H))> - Cases H of (existT x h) => h end. + Definition projT2 : forall x:sigT P, P (projT1 x) := + fun H:sigT P => match H return P (projT1 H) with + | existT x h => h + end. End projections_sigT. -V7only [ -Notation ProjS1 := (projS1 ? ?). -Notation ProjS2 := (projS2 ? ?). -Notation Value := (value ?). -]. - diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v index ee7da4ba6..476ec4a54 100755 --- a/theories/Init/Wf.v +++ b/theories/Init/Wf.v @@ -7,7 +7,6 @@ (***********************************************************************) Set Implicit Arguments. -V7only [Unset Implicit Arguments.]. (*i $Id$ i*) @@ -17,24 +16,24 @@ V7only [Unset Implicit Arguments.]. from a well-founded ordering on a given set *) -Require Notations. -Require Logic. -Require Datatypes. +Require Import Notations. +Require Import Logic. +Require Import Datatypes. (** Well-founded induction principle on Prop *) -Chapter Well_founded. +Section Well_founded. Variable A : Set. Variable R : A -> A -> Prop. (** The accessibility predicate is defined to be non-informative *) - Inductive Acc : A -> Prop - := Acc_intro : (x:A)((y:A)(R y x)->(Acc y))->(Acc x). + Inductive Acc : A -> Prop := + Acc_intro : forall x:A, (forall y:A, R y x -> Acc y) -> Acc x. - Lemma Acc_inv : (x:A)(Acc x) -> (y:A)(R y x) -> (Acc y). - NewDestruct 1; Trivial. + Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y. + destruct 1; trivial. Defined. (** the informative elimination : @@ -42,50 +41,56 @@ Chapter Well_founded. Section AccRecType. Variable P : A -> Type. - Variable F : (x:A)((y:A)(R y x)->(Acc y))->((y:A)(R y x)->(P y))->(P x). + Variable + F : + forall x:A, + (forall y:A, R y x -> Acc y) -> (forall y:A, R y x -> P y) -> P x. - Fixpoint Acc_rect [x:A;a:(Acc x)] : (P x) - := (F x (Acc_inv x a) ([y:A][h:(R y x)](Acc_rect y (Acc_inv x a y h)))). + Fixpoint Acc_rect (x:A) (a:Acc x) {struct a} : P x := + F (Acc_inv a) (fun (y:A) (h:R y x) => Acc_rect (x:=y) (Acc_inv a h)). End AccRecType. - Definition Acc_rec [P:A->Set] := (Acc_rect P). + Definition Acc_rec (P:A -> Set) := Acc_rect P. (** A simplified version of Acc_rec(t) *) Section AccIter. Variable P : A -> Type. - Variable F : (x:A)((y:A)(R y x)-> (P y))->(P x). + Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x. - Fixpoint Acc_iter [x:A;a:(Acc x)] : (P x) - := (F x ([y:A][h:(R y x)](Acc_iter y (Acc_inv x a y h)))). + Fixpoint Acc_iter (x:A) (a:Acc x) {struct a} : P x := + F (fun (y:A) (h:R y x) => Acc_iter (x:=y) (Acc_inv a h)). End AccIter. (** A relation is well-founded if every element is accessible *) - Definition well_founded := (a:A)(Acc a). + Definition well_founded := forall a:A, Acc a. (** well-founded induction on Set and Prop *) Hypothesis Rwf : well_founded. - Theorem well_founded_induction_type : - (P:A->Type)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a). + Theorem well_founded_induction_type : + forall P:A -> Type, + (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Proof. - Intros; Apply (Acc_iter P); Auto. + intros; apply (Acc_iter P); auto. Defined. Theorem well_founded_induction : - (P:A->Set)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a). + forall P:A -> Set, + (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Proof. - Exact [P:A->Set](well_founded_induction_type P). + exact (fun P:A -> Set => well_founded_induction_type P). Defined. - Theorem well_founded_ind : - (P:A->Prop)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a). + Theorem well_founded_ind : + forall P:A -> Prop, + (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Proof. - Exact [P:A->Prop](well_founded_induction_type P). + exact (fun P:A -> Prop => well_founded_induction_type P). Defined. (** Building fixpoints *) @@ -93,40 +98,41 @@ Chapter Well_founded. Section FixPoint. Variable P : A -> Set. -Variable F : (x:A)((y:A)(R y x)->(P y))->(P x). +Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x. -Fixpoint Fix_F [x:A;r:(Acc x)] : (P x) := - (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p))). +Fixpoint Fix_F (x:A) (r:Acc x) {struct r} : P x := + F (fun (y:A) (p:R y x) => Fix_F (x:=y) (Acc_inv r p)). -Definition fix := [x:A](Fix_F x (Rwf x)). +Definition Fix (x:A) := Fix_F (Rwf x). (** Proof that [well_founded_induction] satisfies the fixpoint equation. It requires an extra property of the functional *) -Hypothesis F_ext : - (x:A)(f,g:(y:A)(R y x)->(P y)) - ((y:A)(p:(R y x))((f y p)=(g y p)))->(F x f)=(F x g). +Hypothesis + F_ext : + forall (x:A) (f g:forall y:A, R y x -> P y), + (forall (y:A) (p:R y x), f y p = g y p) -> F f = F g. Scheme Acc_inv_dep := Induction for Acc Sort Prop. -Lemma Fix_F_eq - : (x:A)(r:(Acc x)) - (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p)))=(Fix_F x r). -NewDestruct r using Acc_inv_dep; Auto. +Lemma Fix_F_eq : + forall (x:A) (r:Acc x), + F (fun (y:A) (p:R y x) => Fix_F (Acc_inv r p)) = Fix_F r. +destruct r using Acc_inv_dep; auto. Qed. -Lemma Fix_F_inv : (x:A)(r,s:(Acc x))(Fix_F x r)=(Fix_F x s). -Intro x; NewInduction (Rwf x); Intros. -Rewrite <- (Fix_F_eq x r); Rewrite <- (Fix_F_eq x s); Intros. -Apply F_ext; Auto. +Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F r = Fix_F s. +intro x; induction (Rwf x); intros. +rewrite <- (Fix_F_eq r); rewrite <- (Fix_F_eq s); intros. +apply F_ext; auto. Qed. -Lemma Fix_eq : (x:A)(fix x)=(F x [y:A][p:(R y x)](fix y)). -Intro x; Unfold fix. -Rewrite <- (Fix_F_eq x). -Apply F_ext; Intros. -Apply Fix_F_inv. +Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y). +intro x; unfold Fix in |- *. +rewrite <- (Fix_F_eq (x:=x)). +apply F_ext; intros. +apply Fix_F_inv. Qed. End FixPoint. @@ -135,24 +141,31 @@ End Well_founded. (** A recursor over pairs *) -Chapter Well_founded_2. +Section Well_founded_2. - Variable A,B : Set. + Variables A B : Set. Variable R : A * B -> A * B -> Prop. Variable P : A -> B -> Type. - Variable F : (x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))-> (P y y'))->(P x x'). - - Fixpoint Acc_iter_2 [x:A;x':B;a:(Acc ? R (x,x'))] : (P x x') - := (F x x' ([y:A][y':B][h:(R (y,y') (x,x'))](Acc_iter_2 y y' (Acc_inv ? ? (x,x') a (y,y') h)))). - - Hypothesis Rwf : (well_founded ? R). - - Theorem well_founded_induction_type_2 : - ((x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))->(P y y'))->(P x x'))->(a:A)(b:B)(P a b). + Variable + F : + forall (x:A) (x':B), + (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x'. + + Fixpoint Acc_iter_2 (x:A) (x':B) (a:Acc R (x, x')) {struct a} : + P x x' := + F + (fun (y:A) (y':B) (h:R (y, y') (x, x')) => + Acc_iter_2 (x:=y) (x':=y') (Acc_inv a (y, y') h)). + + Hypothesis Rwf : well_founded R. + + Theorem well_founded_induction_type_2 : + (forall (x:A) (x':B), + (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x') -> + forall (a:A) (b:B), P a b. Proof. - Intros; Apply Acc_iter_2; Auto. + intros; apply Acc_iter_2; auto. Defined. End Well_founded_2. - diff --git a/theories/IntMap/Adalloc.v b/theories/IntMap/Adalloc.v index 5dcd41c84..550633a21 100644 --- a/theories/IntMap/Adalloc.v +++ b/theories/IntMap/Adalloc.v @@ -7,333 +7,359 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Arith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Arith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. Section AdAlloc. Variable A : Set. - Definition nat_of_ad := [a:ad] Cases a of - ad_z => O - | (ad_x p) => (convert p) - end. - - Fixpoint nat_le [m:nat] : nat -> bool := - Cases m of - O => [_:nat] true - | (S m') => [n:nat] Cases n of - O => false - | (S n') => (nat_le m' n') - end + Definition nat_of_ad (a:ad) := + match a with + | ad_z => 0 + | ad_x p => nat_of_P p end. - Lemma nat_le_correct : (m,n:nat) (le m n) -> (nat_le m n)=true. + Fixpoint nat_le (m:nat) : nat -> bool := + match m with + | O => fun _:nat => true + | S m' => + fun n:nat => match n with + | O => false + | S n' => nat_le m' n' + end + end. + + Lemma nat_le_correct : forall m n:nat, m <= n -> nat_le m n = true. Proof. - NewInduction m as [|m IHm]. Trivial. - NewDestruct n. Intro H. Elim (le_Sn_O ? H). - Intros. Simpl. Apply IHm. Apply le_S_n. Assumption. + 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. Qed. - Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true -> (le m n). + Lemma nat_le_complete : forall m n:nat, nat_le m n = true -> m <= n. Proof. - NewInduction m. Trivial with arith. - NewDestruct n. Intro H. Discriminate H. - Auto with arith. + induction m. trivial with arith. + destruct n. intro H. discriminate H. + auto with arith. Qed. - Lemma nat_le_correct_conv : (m,n:nat) (lt m n) -> (nat_le n m)=false. + Lemma nat_le_correct_conv : forall m n:nat, m < n -> nat_le n m = false. Proof. - Intros. Elim (sumbool_of_bool (nat_le n m)). Intro H0. - Elim (lt_n_n ? (lt_le_trans ? ? ? H (nat_le_complete ? ? H0))). - Trivial. + intros. elim (sumbool_of_bool (nat_le n m)). intro H0. + elim (lt_irrefl _ (lt_le_trans _ _ _ H (nat_le_complete _ _ H0))). + trivial. Qed. - Lemma nat_le_complete_conv : (m,n:nat) (nat_le n m)=false -> (lt m n). + Lemma nat_le_complete_conv : forall m n:nat, nat_le n m = false -> m < n. Proof. - Intros. Elim (le_or_lt n m). Intro. Conditional Trivial Rewrite nat_le_correct in H. Discriminate H. - Trivial. + intros. elim (le_or_lt n m). intro. conditional trivial rewrite nat_le_correct in H. discriminate H. + trivial. Qed. - Definition ad_of_nat := [n:nat] Cases n of - O => ad_z - | (S n') => (ad_x (anti_convert n')) - end. + Definition ad_of_nat (n:nat) := + match n with + | O => ad_z + | S n' => ad_x (P_of_succ_nat n') + end. - Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a. + Lemma ad_of_nat_of_ad : forall a:ad, ad_of_nat (nat_of_ad a) = a. Proof. - NewDestruct a as [|p]. Reflexivity. - Simpl. Elim (ZL4 p). Intros n H. Rewrite H. Simpl. Rewrite <- bij1 in H. - Rewrite convert_intro with 1:=H. Reflexivity. + destruct a as [| p]. reflexivity. + simpl in |- *. elim (ZL4 p). intros n H. rewrite H. simpl in |- *. rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ in H. + rewrite nat_of_P_inj with (1 := H). reflexivity. Qed. - Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n. + Lemma nat_of_ad_of_nat : forall n:nat, nat_of_ad (ad_of_nat n) = n. Proof. - NewInduction n. Trivial. - Intros. Simpl. Apply bij1. + induction n. trivial. + intros. simpl in |- *. apply nat_of_P_o_P_of_succ_nat_eq_succ. Qed. - Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)). + Definition ad_le (a b:ad) := nat_le (nat_of_ad a) (nat_of_ad b). - Lemma ad_le_refl : (a:ad) (ad_le a a)=true. + Lemma ad_le_refl : forall a:ad, ad_le a a = true. Proof. - Intro. Unfold ad_le. Apply nat_le_correct. Apply le_n. + intro. unfold ad_le in |- *. apply nat_le_correct. apply le_n. Qed. - Lemma ad_le_antisym : (a,b:ad) (ad_le a b)=true -> (ad_le b a)=true -> a=b. + Lemma ad_le_antisym : + forall a b:ad, ad_le a b = true -> ad_le b a = true -> a = b. Proof. - Unfold ad_le. Intros. Rewrite <- (ad_of_nat_of_ad a). Rewrite <- (ad_of_nat_of_ad b). - Rewrite (le_antisym ? ? (nat_le_complete ? ? H) (nat_le_complete ? ? H0)). Reflexivity. + unfold ad_le in |- *. intros. rewrite <- (ad_of_nat_of_ad a). rewrite <- (ad_of_nat_of_ad b). + rewrite (le_antisym _ _ (nat_le_complete _ _ H) (nat_le_complete _ _ H0)). reflexivity. Qed. - Lemma ad_le_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le b c)=true -> - (ad_le a c)=true. + Lemma ad_le_trans : + forall a b c:ad, ad_le a b = true -> ad_le b c = true -> ad_le a c = true. Proof. - Unfold ad_le. Intros. Apply nat_le_correct. Apply le_trans with m:=(nat_of_ad b). - Apply nat_le_complete. Assumption. - Apply nat_le_complete. Assumption. + unfold ad_le in |- *. intros. apply nat_le_correct. apply le_trans with (m := nat_of_ad b). + apply nat_le_complete. assumption. + apply nat_le_complete. assumption. Qed. - Lemma ad_le_lt_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le c b)=false -> - (ad_le c a)=false. + Lemma ad_le_lt_trans : + forall a b c:ad, + ad_le a b = true -> ad_le c b = false -> ad_le c a = false. Proof. - Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply le_lt_trans with m:=(nat_of_ad b). - Apply nat_le_complete. Assumption. - Apply nat_le_complete_conv. Assumption. + unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply le_lt_trans with (m := nat_of_ad b). + apply nat_le_complete. assumption. + apply nat_le_complete_conv. assumption. Qed. - Lemma ad_lt_le_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le b c)=true -> - (ad_le c a)=false. + Lemma ad_lt_le_trans : + forall a b c:ad, + ad_le b a = false -> ad_le b c = true -> ad_le c a = false. Proof. - Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_le_trans with m:=(nat_of_ad b). - Apply nat_le_complete_conv. Assumption. - Apply nat_le_complete. Assumption. + unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply lt_le_trans with (m := nat_of_ad b). + apply nat_le_complete_conv. assumption. + apply nat_le_complete. assumption. Qed. - Lemma ad_lt_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le c b)=false -> - (ad_le c a)=false. + Lemma ad_lt_trans : + forall a b c:ad, + ad_le b a = false -> ad_le c b = false -> ad_le c a = false. Proof. - Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_trans with m:=(nat_of_ad b). - Apply nat_le_complete_conv. Assumption. - Apply nat_le_complete_conv. Assumption. + unfold ad_le in |- *. intros. apply nat_le_correct_conv. apply lt_trans with (m := nat_of_ad b). + apply nat_le_complete_conv. assumption. + apply nat_le_complete_conv. assumption. Qed. - Lemma ad_lt_le_weak : (a,b:ad) (ad_le b a)=false -> (ad_le a b)=true. + Lemma ad_lt_le_weak : forall a b:ad, ad_le b a = false -> ad_le a b = true. Proof. - Unfold ad_le. Intros. Apply nat_le_correct. Apply lt_le_weak. - Apply nat_le_complete_conv. Assumption. + unfold ad_le in |- *. intros. apply nat_le_correct. apply lt_le_weak. + apply nat_le_complete_conv. assumption. Qed. - Definition ad_min := [a,b:ad] if (ad_le a b) then a else b. + Definition ad_min (a b:ad) := if ad_le a b then a else b. - Lemma ad_min_choice : (a,b:ad) {(ad_min a b)=a}+{(ad_min a b)=b}. + Lemma ad_min_choice : forall a b:ad, {ad_min a b = a} + {ad_min a b = b}. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Left . Rewrite H. - Reflexivity. - Intro H. Right . Rewrite H. Reflexivity. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. left. rewrite H. + reflexivity. + intro H. right. rewrite H. reflexivity. Qed. - Lemma ad_min_le_1 : (a,b:ad) (ad_le (ad_min a b) a)=true. + Lemma ad_min_le_1 : forall a b:ad, ad_le (ad_min a b) a = true. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. - Apply ad_le_refl. - Intro H. Rewrite H. Apply ad_lt_le_weak. Assumption. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. rewrite H. + apply ad_le_refl. + intro H. rewrite H. apply ad_lt_le_weak. assumption. Qed. - Lemma ad_min_le_2 : (a,b:ad) (ad_le (ad_min a b) b)=true. + Lemma ad_min_le_2 : forall a b:ad, ad_le (ad_min a b) b = true. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. Assumption. - Intro H. Rewrite H. Apply ad_le_refl. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le a b)). intro H. rewrite H. assumption. + intro H. rewrite H. apply ad_le_refl. Qed. - Lemma ad_min_le_3 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a b)=true. + Lemma ad_min_le_3 : + forall a b c:ad, ad_le a (ad_min b c) = true -> ad_le a b = true. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Assumption. - Intro H0. Rewrite H0 in H. Apply ad_lt_le_weak. Apply ad_le_lt_trans with b:=c; Assumption. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. + assumption. + intro H0. rewrite H0 in H. apply ad_lt_le_weak. apply ad_le_lt_trans with (b := c); assumption. Qed. - Lemma ad_min_le_4 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a c)=true. + Lemma ad_min_le_4 : + forall a b c:ad, ad_le a (ad_min b c) = true -> ad_le a c = true. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Apply ad_le_trans with b:=b; Assumption. - Intro H0. Rewrite H0 in H. Assumption. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. + apply ad_le_trans with (b := b); assumption. + intro H0. rewrite H0 in H. assumption. Qed. - Lemma ad_min_le_5 : (a,b,c:ad) (ad_le a b)=true -> (ad_le a c)=true -> - (ad_le a (ad_min b c))=true. + Lemma ad_min_le_5 : + forall a b c:ad, + ad_le a b = true -> ad_le a c = true -> ad_le a (ad_min b c) = true. Proof. - Intros. Elim (ad_min_choice b c). Intro H1. Rewrite H1. Assumption. - Intro H1. Rewrite H1. Assumption. + intros. elim (ad_min_choice b c). intro H1. rewrite H1. assumption. + intro H1. rewrite H1. assumption. Qed. - Lemma ad_min_lt_3 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le b a)=false. + Lemma ad_min_lt_3 : + forall a b c:ad, ad_le (ad_min b c) a = false -> ad_le b a = false. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Assumption. - Intro H0. Rewrite H0 in H. Apply ad_lt_trans with b:=c; Assumption. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. + assumption. + intro H0. rewrite H0 in H. apply ad_lt_trans with (b := c); assumption. Qed. - Lemma ad_min_lt_4 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le c a)=false. + Lemma ad_min_lt_4 : + forall a b c:ad, ad_le (ad_min b c) a = false -> ad_le c a = false. Proof. - Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H. - Apply ad_lt_le_trans with b:=b; Assumption. - Intro H0. Rewrite H0 in H. Assumption. + unfold ad_min in |- *. intros. elim (sumbool_of_bool (ad_le b c)). intro H0. rewrite H0 in H. + apply ad_lt_le_trans with (b := b); assumption. + intro H0. rewrite H0 in H. assumption. Qed. (** Allocator: returns an address not in the domain of [m]. This allocator is optimal in that it returns the lowest possible address, in the usual ordering on integers. It is not the most efficient, however. *) - Fixpoint ad_alloc_opt [m:(Map A)] : ad := - Cases m of - M0 => ad_z - | (M1 a _) => if (ad_eq a ad_z) - then (ad_x xH) - else ad_z - | (M2 m1 m2) => (ad_min (ad_double (ad_alloc_opt m1)) - (ad_double_plus_un (ad_alloc_opt m2))) + Fixpoint ad_alloc_opt (m:Map A) : ad := + match m with + | M0 => ad_z + | M1 a _ => if ad_eq a ad_z then ad_x 1 else ad_z + | M2 m1 m2 => + ad_min (ad_double (ad_alloc_opt m1)) + (ad_double_plus_un (ad_alloc_opt m2)) end. - Lemma ad_alloc_opt_allocates_1 : (m:(Map A)) (MapGet A m (ad_alloc_opt m))=(NONE A). + Lemma ad_alloc_opt_allocates_1 : + forall m:Map A, MapGet A m (ad_alloc_opt m) = NONE A. Proof. - NewInduction m as [|a|m0 H m1 H0]. Reflexivity. - Simpl. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H. Rewrite H. - Rewrite (ad_eq_complete ? ? H). Reflexivity. - Intro H. Rewrite H. Rewrite H. Reflexivity. - Intros. Change (ad_alloc_opt (M2 A m0 m1)) with - (ad_min (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))). - Elim (ad_min_choice (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))). - Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption. - Apply ad_double_bit_0. - Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption. - Apply ad_double_plus_un_bit_0. + induction m as [| a| m0 H m1 H0]. reflexivity. + simpl in |- *. elim (sumbool_of_bool (ad_eq a ad_z)). intro H. rewrite H. + rewrite (ad_eq_complete _ _ H). reflexivity. + intro H. rewrite H. rewrite H. reflexivity. + intros. change + (ad_alloc_opt (M2 A m0 m1)) with (ad_min (ad_double (ad_alloc_opt m0)) + (ad_double_plus_un (ad_alloc_opt m1))) + in |- *. + elim + (ad_min_choice (ad_double (ad_alloc_opt m0)) + (ad_double_plus_un (ad_alloc_opt m1))). + intro H1. rewrite H1. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption. + apply ad_double_bit_0. + intro H1. rewrite H1. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. assumption. + apply ad_double_plus_un_bit_0. Qed. - Lemma ad_alloc_opt_allocates : (m:(Map A)) (in_dom A (ad_alloc_opt m) m)=false. + Lemma ad_alloc_opt_allocates : + forall m:Map A, in_dom A (ad_alloc_opt m) m = false. Proof. - Unfold in_dom. Intro. Rewrite (ad_alloc_opt_allocates_1 m). Reflexivity. + unfold in_dom in |- *. intro. rewrite (ad_alloc_opt_allocates_1 m). reflexivity. Qed. (** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)] are in [dom m]: *) - Lemma nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)). + Lemma nat_of_ad_double : + forall a:ad, nat_of_ad (ad_double a) = 2 * nat_of_ad a. Proof. - NewDestruct a as [|p]. Trivial. - Exact (convert_xO p). + destruct a as [| p]. trivial. + exact (nat_of_P_xO p). Qed. - Lemma nat_of_ad_double_plus_un : (a:ad) - (nat_of_ad (ad_double_plus_un a))=(S (mult (2) (nat_of_ad a))). + Lemma nat_of_ad_double_plus_un : + forall a:ad, nat_of_ad (ad_double_plus_un a) = S (2 * nat_of_ad a). Proof. - NewDestruct a as [|p]. Trivial. - Exact (convert_xI p). + destruct a as [| p]. trivial. + exact (nat_of_P_xI p). Qed. - Lemma ad_le_double_mono : (a,b:ad) (ad_le a b)=true -> - (ad_le (ad_double a) (ad_double b))=true. + Lemma ad_le_double_mono : + forall a b:ad, + ad_le a b = true -> ad_le (ad_double a) (ad_double b) = true. Proof. - Unfold ad_le. Intros. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Apply nat_le_correct. - Simpl. Apply le_plus_plus. Apply nat_le_complete. Assumption. - Apply le_plus_plus. Apply nat_le_complete. Assumption. - Apply le_n. + unfold ad_le in |- *. intros. rewrite nat_of_ad_double. rewrite nat_of_ad_double. apply nat_le_correct. + simpl in |- *. apply plus_le_compat. apply nat_le_complete. assumption. + apply plus_le_compat. apply nat_le_complete. assumption. + apply le_n. Qed. - Lemma ad_le_double_plus_un_mono : (a,b:ad) (ad_le a b)=true -> - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true. + Lemma ad_le_double_plus_un_mono : + forall a b:ad, + ad_le a b = true -> + ad_le (ad_double_plus_un a) (ad_double_plus_un b) = true. Proof. - Unfold ad_le. Intros. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un. - Apply nat_le_correct. Apply le_n_S. Simpl. Apply le_plus_plus. Apply nat_le_complete. - Assumption. - Apply le_plus_plus. Apply nat_le_complete. Assumption. - Apply le_n. + unfold ad_le in |- *. intros. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un. + apply nat_le_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply nat_le_complete. + assumption. + apply plus_le_compat. apply nat_le_complete. assumption. + apply le_n. Qed. - Lemma ad_le_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=true -> - (ad_le a b)=true. + Lemma ad_le_double_mono_conv : + forall a b:ad, + ad_le (ad_double a) (ad_double b) = true -> ad_le a b = true. Proof. - Unfold ad_le. Intros a b. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Intro. - Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply nat_le_complete. Assumption. + unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double. rewrite nat_of_ad_double. intro. + apply nat_le_correct. apply (mult_S_le_reg_l 1). apply nat_le_complete. assumption. Qed. - Lemma ad_le_double_plus_un_mono_conv : (a,b:ad) - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true -> (ad_le a b)=true. + Lemma ad_le_double_plus_un_mono_conv : + forall a b:ad, + ad_le (ad_double_plus_un a) (ad_double_plus_un b) = true -> + ad_le a b = true. Proof. - Unfold ad_le. Intros a b. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un. - Intro. Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply le_S_n. Apply nat_le_complete. - Assumption. + unfold ad_le in |- *. intros a b. rewrite nat_of_ad_double_plus_un. rewrite nat_of_ad_double_plus_un. + intro. apply nat_le_correct. apply (mult_S_le_reg_l 1). apply le_S_n. apply nat_le_complete. + assumption. Qed. - Lemma ad_lt_double_mono : (a,b:ad) (ad_le a b)=false -> - (ad_le (ad_double a) (ad_double b))=false. + Lemma ad_lt_double_mono : + forall a b:ad, + ad_le a b = false -> ad_le (ad_double a) (ad_double b) = false. Proof. - Intros. Elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). Intro H0. - Rewrite (ad_le_double_mono_conv ? ? H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). intro H0. + rewrite (ad_le_double_mono_conv _ _ H0) in H. discriminate H. + trivial. Qed. - Lemma ad_lt_double_plus_un_mono : (a,b:ad) (ad_le a b)=false -> - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false. + Lemma ad_lt_double_plus_un_mono : + forall a b:ad, + ad_le a b = false -> + ad_le (ad_double_plus_un a) (ad_double_plus_un b) = false. Proof. - Intros. Elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). Intro H0. - Rewrite (ad_le_double_plus_un_mono_conv ? ? H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). intro H0. + rewrite (ad_le_double_plus_un_mono_conv _ _ H0) in H. discriminate H. + trivial. Qed. - Lemma ad_lt_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=false -> - (ad_le a b)=false. + Lemma ad_lt_double_mono_conv : + forall a b:ad, + ad_le (ad_double a) (ad_double b) = false -> ad_le a b = false. Proof. - Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. Rewrite (ad_le_double_mono ? ? H0) in H. - Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_le a b)). intro H0. rewrite (ad_le_double_mono _ _ H0) in H. + discriminate H. + trivial. Qed. - Lemma ad_lt_double_plus_un_mono_conv : (a,b:ad) - (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false -> (ad_le a b)=false. + Lemma ad_lt_double_plus_un_mono_conv : + forall a b:ad, + ad_le (ad_double_plus_un a) (ad_double_plus_un b) = false -> + ad_le a b = false. Proof. - Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. - Rewrite (ad_le_double_plus_un_mono ? ? H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_le a b)). intro H0. + rewrite (ad_le_double_plus_un_mono _ _ H0) in H. discriminate H. + trivial. Qed. - Lemma ad_alloc_opt_optimal_1 : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false -> - {y:A | (MapGet A m a)=(SOME A y)}. + Lemma ad_alloc_opt_optimal_1 : + forall (m:Map A) (a:ad), + ad_le (ad_alloc_opt m) a = false -> {y : A | MapGet A m a = SOME A y}. Proof. - NewInduction m as [|a y|m0 H m1 H0]. Simpl. Unfold ad_le. Simpl. Intros. Discriminate H. - Simpl. Intros b H. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H0. Rewrite H0 in H. - Unfold ad_le in H. Cut ad_z=b. Intro. Split with y. Rewrite <- H1. Rewrite H0. Reflexivity. - Rewrite <- (ad_of_nat_of_ad b). - Rewrite <- (le_n_O_eq ? (le_S_n ? ? (nat_le_complete_conv ? ? H))). Reflexivity. - Intro H0. Rewrite H0 in H. Discriminate H. - Intros. Simpl in H1. Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. - Rewrite H3 in H1. Elim (H ? (ad_lt_double_mono_conv ? ? (ad_min_lt_3 ? ? ? H1))). Intros y H4. - Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption. - Apply ad_double_bit_0. - Intro H2. Elim H2. Intros a0 H3. Rewrite H3 in H1. - Elim (H0 ? (ad_lt_double_plus_un_mono_conv ? ? (ad_min_lt_4 ? ? ? H1))). Intros y H4. - Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. - Assumption. - Apply ad_double_plus_un_bit_0. + induction m as [| a y| m0 H m1 H0]. simpl in |- *. unfold ad_le in |- *. simpl in |- *. intros. discriminate H. + simpl in |- *. intros b H. elim (sumbool_of_bool (ad_eq a ad_z)). intro H0. rewrite H0 in H. + unfold ad_le in H. cut (ad_z = b). intro. split with y. rewrite <- H1. rewrite H0. reflexivity. + rewrite <- (ad_of_nat_of_ad b). + rewrite <- (le_n_O_eq _ (le_S_n _ _ (nat_le_complete_conv _ _ H))). reflexivity. + intro H0. rewrite H0 in H. discriminate H. + intros. simpl in H1. elim (ad_double_or_double_plus_un a). intro H2. elim H2. intros a0 H3. + rewrite H3 in H1. elim (H _ (ad_lt_double_mono_conv _ _ (ad_min_lt_3 _ _ _ H1))). intros y H4. + split with y. rewrite H3. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption. + apply ad_double_bit_0. + intro H2. elim H2. intros a0 H3. rewrite H3 in H1. + elim (H0 _ (ad_lt_double_plus_un_mono_conv _ _ (ad_min_lt_4 _ _ _ H1))). intros y H4. + split with y. rewrite H3. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. + assumption. + apply ad_double_plus_un_bit_0. Qed. - Lemma ad_alloc_opt_optimal : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false -> - (in_dom A a m)=true. + Lemma ad_alloc_opt_optimal : + forall (m:Map A) (a:ad), + ad_le (ad_alloc_opt m) a = false -> in_dom A a m = true. Proof. - Intros. Unfold in_dom. Elim (ad_alloc_opt_optimal_1 m a H). Intros y H0. Rewrite H0. - Reflexivity. + intros. unfold in_dom in |- *. elim (ad_alloc_opt_optimal_1 m a H). intros y H0. rewrite H0. + reflexivity. Qed. End AdAlloc. - -V7only [ -(* Moved to NArith *) -Notation positive_to_nat_2 := positive_to_nat_2. -Notation positive_to_nat_4 := positive_to_nat_4. -]. diff --git a/theories/IntMap/Addec.v b/theories/IntMap/Addec.v index f0ec7b37d..5ad2ea852 100644 --- a/theories/IntMap/Addec.v +++ b/theories/IntMap/Addec.v @@ -9,171 +9,185 @@ (** Equality on adresses *) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. - -Fixpoint ad_eq_1 [p1,p2:positive] : bool := - Cases p1 p2 of - xH xH => true - | (xO p'1) (xO p'2) => (ad_eq_1 p'1 p'2) - | (xI p'1) (xI p'2) => (ad_eq_1 p'1 p'2) - | _ _ => false +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. + +Fixpoint ad_eq_1 (p1 p2:positive) {struct p2} : bool := + match p1, p2 with + | xH, xH => true + | xO p'1, xO p'2 => ad_eq_1 p'1 p'2 + | xI p'1, xI p'2 => ad_eq_1 p'1 p'2 + | _, _ => false end. -Definition ad_eq := [a,a':ad] - Cases a a' of - ad_z ad_z => true - | (ad_x p) (ad_x p') => (ad_eq_1 p p') - | _ _ => false +Definition ad_eq (a a':ad) := + match a, a' with + | ad_z, ad_z => true + | ad_x p, ad_x p' => ad_eq_1 p p' + | _, _ => false end. -Lemma ad_eq_correct : (a:ad) (ad_eq a a)=true. +Lemma ad_eq_correct : forall a:ad, ad_eq a a = true. Proof. - NewDestruct a; Trivial. - NewInduction p; Trivial. + destruct a; trivial. + induction p; trivial. Qed. -Lemma ad_eq_complete : (a,a':ad) (ad_eq a a')=true -> a=a'. -Proof. - NewDestruct a. NewDestruct a'; Trivial. NewDestruct p. - Discriminate 1. - Discriminate 1. - Discriminate 1. - NewDestruct a'. Intros. Discriminate H. - Unfold ad_eq. Intros. Cut p=p0. Intros. Rewrite H0. Reflexivity. - Generalize Dependent p0. - NewInduction p as [p IHp|p IHp|]. NewDestruct p0; Intro H. - Rewrite (IHp p0). Reflexivity. - Exact H. - Discriminate H. - Discriminate H. - NewDestruct p0; Intro H. Discriminate H. - Rewrite (IHp p0 H). Reflexivity. - Discriminate H. - NewDestruct p0; Intro H. Discriminate H. - Discriminate H. - Trivial. +Lemma ad_eq_complete : forall a a':ad, ad_eq a a' = true -> a = a'. +Proof. + destruct a. destruct a'; trivial. destruct p. + discriminate 1. + discriminate 1. + discriminate 1. + destruct a'. intros. discriminate H. + unfold ad_eq in |- *. intros. cut (p = p0). intros. rewrite H0. reflexivity. + generalize dependent p0. + induction p as [p IHp| p IHp| ]. destruct p0; intro H. + rewrite (IHp p0). reflexivity. + exact H. + discriminate H. + discriminate H. + destruct p0; intro H. discriminate H. + rewrite (IHp p0 H). reflexivity. + discriminate H. + destruct p0 as [p| p| ]; intro H. discriminate H. + discriminate H. + trivial. Qed. -Lemma ad_eq_comm : (a,a':ad) (ad_eq a a')=(ad_eq a' a). -Proof. - Intros. Cut (b,b':bool)(ad_eq a a')=b->(ad_eq a' a)=b'->b=b'. - Intros. Apply H. Reflexivity. - Reflexivity. - NewDestruct b. Intros. Cut a=a'. - Intro. Rewrite H1 in H0. Rewrite (ad_eq_correct a') in H0. Exact H0. - Apply ad_eq_complete. Exact H. - NewDestruct b'. Intros. Cut a'=a. - Intro. Rewrite H1 in H. Rewrite H1 in H0. Rewrite <- H. Exact H0. - Apply ad_eq_complete. Exact H0. - Trivial. +Lemma ad_eq_comm : forall a a':ad, ad_eq a a' = ad_eq a' a. +Proof. + intros. cut (forall b b':bool, ad_eq a a' = b -> ad_eq a' a = b' -> b = b'). + intros. apply H. reflexivity. + reflexivity. + destruct b. intros. cut (a = a'). + intro. rewrite H1 in H0. rewrite (ad_eq_correct a') in H0. exact H0. + apply ad_eq_complete. exact H. + destruct b'. intros. cut (a' = a). + intro. rewrite H1 in H. rewrite H1 in H0. rewrite <- H. exact H0. + apply ad_eq_complete. exact H0. + trivial. Qed. -Lemma ad_xor_eq_true : (a,a':ad) (ad_xor a a')=ad_z -> (ad_eq a a')=true. +Lemma ad_xor_eq_true : + forall a a':ad, ad_xor a a' = ad_z -> ad_eq a a' = true. Proof. - Intros. Rewrite (ad_xor_eq a a' H). Apply ad_eq_correct. + intros. rewrite (ad_xor_eq a a' H). apply ad_eq_correct. Qed. Lemma ad_xor_eq_false : - (a,a':ad) (p:positive) (ad_xor a a')=(ad_x p) -> (ad_eq a a')=false. + forall (a a':ad) (p:positive), ad_xor a a' = ad_x p -> ad_eq a a' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0. - Rewrite (ad_eq_complete a a' H0) in H. Rewrite (ad_xor_nilpotent a') in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_eq a a')). intro H0. + rewrite (ad_eq_complete a a' H0) in H. rewrite (ad_xor_nilpotent a') in H. discriminate H. + trivial. Qed. -Lemma ad_bit_0_1_not_double : (a:ad) (ad_bit_0 a)=true -> - (a0:ad) (ad_eq (ad_double a0) a)=false. +Lemma ad_bit_0_1_not_double : + forall a:ad, + ad_bit_0 a = true -> forall a0:ad, ad_eq (ad_double a0) a = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_bit_0 a0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_eq (ad_double a0) a)). intro H0. + rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_bit_0 a0) in H. discriminate H. + trivial. Qed. -Lemma ad_not_div_2_not_double : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false -> - (ad_eq a (ad_double a0))=false. +Lemma ad_not_div_2_not_double : + forall a a0:ad, + ad_eq (ad_div_2 a) a0 = false -> ad_eq a (ad_double a0) = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_div_2 a0) in H. - Rewrite (ad_eq_correct a0) in H. Discriminate H. - Intro. Rewrite ad_eq_comm. Assumption. + intros. elim (sumbool_of_bool (ad_eq (ad_double a0) a)). intro H0. + rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_div_2 a0) in H. + rewrite (ad_eq_correct a0) in H. discriminate H. + intro. rewrite ad_eq_comm. assumption. Qed. -Lemma ad_bit_0_0_not_double_plus_un : (a:ad) (ad_bit_0 a)=false -> - (a0:ad) (ad_eq (ad_double_plus_un a0) a)=false. +Lemma ad_bit_0_0_not_double_plus_un : + forall a:ad, + ad_bit_0 a = false -> forall a0:ad, ad_eq (ad_double_plus_un a0) a = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). Intro H0. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_bit_0 a0) in H. - Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). intro H0. + rewrite <- (ad_eq_complete _ _ H0) in H. rewrite (ad_double_plus_un_bit_0 a0) in H. + discriminate H. + trivial. Qed. -Lemma ad_not_div_2_not_double_plus_un : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false -> - (ad_eq (ad_double_plus_un a0) a)=false. +Lemma ad_not_div_2_not_double_plus_un : + forall a a0:ad, + ad_eq (ad_div_2 a) a0 = false -> ad_eq (ad_double_plus_un a0) a = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). Intro H0. - Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_div_2 a0) in H. - Rewrite (ad_eq_correct a0) in H. Discriminate H. - Intro H0. Rewrite ad_eq_comm. Assumption. + intros. elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). intro H0. + rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_double_plus_un_div_2 a0) in H. + rewrite (ad_eq_correct a0) in H. discriminate H. + intro H0. rewrite ad_eq_comm. assumption. Qed. Lemma ad_bit_0_neq : - (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> (ad_eq a a')=false. + forall a a':ad, + ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_eq a a' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H1. Rewrite (ad_eq_complete ? ? H1) in H. - Rewrite H in H0. Discriminate H0. - Trivial. + intros. elim (sumbool_of_bool (ad_eq a a')). intro H1. rewrite (ad_eq_complete _ _ H1) in H. + rewrite H in H0. discriminate H0. + trivial. Qed. Lemma ad_div_eq : - (a,a':ad) (ad_eq a a')=true -> (ad_eq (ad_div_2 a) (ad_div_2 a'))=true. + forall a a':ad, ad_eq a a' = true -> ad_eq (ad_div_2 a) (ad_div_2 a') = true. Proof. - Intros. Cut a=a'. Intros. Rewrite H0. Apply ad_eq_correct. - Apply ad_eq_complete. Exact H. + intros. cut (a = a'). intros. rewrite H0. apply ad_eq_correct. + apply ad_eq_complete. exact H. Qed. -Lemma ad_div_neq : (a,a':ad) (ad_eq (ad_div_2 a) (ad_div_2 a'))=false -> - (ad_eq a a')=false. +Lemma ad_div_neq : + forall a a':ad, + ad_eq (ad_div_2 a) (ad_div_2 a') = false -> ad_eq a a' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0. - Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_eq_correct (ad_div_2 a')) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_eq a a')). intro H0. + rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_eq_correct (ad_div_2 a')) in H. discriminate H. + trivial. Qed. -Lemma ad_div_bit_eq : (a,a':ad) (ad_bit_0 a)=(ad_bit_0 a') -> - (ad_div_2 a)=(ad_div_2 a') -> a=a'. +Lemma ad_div_bit_eq : + forall a a':ad, + ad_bit_0 a = ad_bit_0 a' -> ad_div_2 a = ad_div_2 a' -> a = a'. Proof. - Intros. Apply ad_faithful. Unfold eqf. NewDestruct n. - Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Assumption. - Rewrite <- ad_div_2_correct. Rewrite <- ad_div_2_correct. - Rewrite H0. Reflexivity. + intros. apply ad_faithful. unfold eqf in |- *. destruct n. + rewrite ad_bit_0_correct. rewrite ad_bit_0_correct. assumption. + rewrite <- ad_div_2_correct. rewrite <- ad_div_2_correct. + rewrite H0. reflexivity. Qed. -Lemma ad_div_bit_neq : (a,a':ad) (ad_eq a a')=false -> (ad_bit_0 a)=(ad_bit_0 a') -> - (ad_eq (ad_div_2 a) (ad_div_2 a'))=false. +Lemma ad_div_bit_neq : + forall a a':ad, + ad_eq a a' = false -> + ad_bit_0 a = ad_bit_0 a' -> ad_eq (ad_div_2 a) (ad_div_2 a') = false. Proof. - Intros. Elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). Intro H1. - Rewrite (ad_div_bit_eq ? ? H0 (ad_eq_complete ? ? H1)) in H. - Rewrite (ad_eq_correct a') in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). intro H1. + rewrite (ad_div_bit_eq _ _ H0 (ad_eq_complete _ _ H1)) in H. + rewrite (ad_eq_correct a') in H. discriminate H. + trivial. Qed. -Lemma ad_neq : (a,a':ad) (ad_eq a a')=false -> - (ad_bit_0 a)=(negb (ad_bit_0 a')) \/ (ad_eq (ad_div_2 a) (ad_div_2 a'))=false. +Lemma ad_neq : + forall a a':ad, + ad_eq a a' = false -> + ad_bit_0 a = negb (ad_bit_0 a') \/ + ad_eq (ad_div_2 a) (ad_div_2 a') = false. Proof. - Intros. Cut (ad_bit_0 a)=(ad_bit_0 a')\/(ad_bit_0 a)=(negb (ad_bit_0 a')). - Intros. Elim H0. Intro. Right . Apply ad_div_bit_neq. Assumption. - Assumption. - Intro. Left . Assumption. - Case (ad_bit_0 a); Case (ad_bit_0 a'); Auto. + intros. cut (ad_bit_0 a = ad_bit_0 a' \/ ad_bit_0 a = negb (ad_bit_0 a')). + intros. elim H0. intro. right. apply ad_div_bit_neq. assumption. + assumption. + intro. left. assumption. + case (ad_bit_0 a); case (ad_bit_0 a'); auto. Qed. -Lemma ad_double_or_double_plus_un : (a:ad) - {a0:ad | a=(ad_double a0)}+{a1:ad | a=(ad_double_plus_un a1)}. +Lemma ad_double_or_double_plus_un : + forall a:ad, + {a0 : ad | a = ad_double a0} + {a1 : ad | a = ad_double_plus_un a1}. Proof. - Intro. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Right . Split with (ad_div_2 a). - Rewrite (ad_div_2_double_plus_un a H). Reflexivity. - Intro H. Left . Split with (ad_div_2 a). Rewrite (ad_div_2_double a H). Reflexivity. -Qed. + intro. elim (sumbool_of_bool (ad_bit_0 a)). intro H. right. split with (ad_div_2 a). + rewrite (ad_div_2_double_plus_un a H). reflexivity. + intro H. left. split with (ad_div_2 a). rewrite (ad_div_2_double a H). reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Addr.v b/theories/IntMap/Addr.v index cff8936b6..fcab8b565 100644 --- a/theories/IntMap/Addr.v +++ b/theories/IntMap/Addr.v @@ -9,448 +9,483 @@ (** Representation of adresses by the [positive] type of binary numbers *) -Require Bool. -Require ZArith. +Require Import Bool. +Require Import ZArith. Inductive ad : Set := - ad_z : ad + | ad_z : ad | ad_x : positive -> ad. -Lemma ad_sum : (a:ad) {p:positive | a=(ad_x p)}+{a=ad_z}. -Proof. - NewDestruct a; Auto. - Left; Exists p; Trivial. -Qed. - -Fixpoint p_xor [p:positive] : positive -> ad := - [p2] Cases p of - xH => Cases p2 of - xH => ad_z - | (xO p'2) => (ad_x (xI p'2)) - | (xI p'2) => (ad_x (xO p'2)) - end - | (xO p') => Cases p2 of - xH => (ad_x (xI p')) - | (xO p'2) => Cases (p_xor p' p'2) of - ad_z => ad_z - | (ad_x p'') => (ad_x (xO p'')) - end - | (xI p'2) => Cases (p_xor p' p'2) of - ad_z => (ad_x xH) - | (ad_x p'') => (ad_x (xI p'')) - end - end - | (xI p') => Cases p2 of - xH => (ad_x (xO p')) - | (xO p'2) => Cases (p_xor p' p'2) of - ad_z => (ad_x xH) - | (ad_x p'') => (ad_x (xI p'')) - end - | (xI p'2) => Cases (p_xor p' p'2) of - ad_z => ad_z - | (ad_x p'') => (ad_x (xO p'')) - end - end +Lemma ad_sum : forall a:ad, {p : positive | a = ad_x p} + {a = ad_z}. +Proof. + destruct a; auto. + left; exists p; trivial. +Qed. + +Fixpoint p_xor (p p2:positive) {struct p} : ad := + match p with + | xH => + match p2 with + | xH => ad_z + | xO p'2 => ad_x (xI p'2) + | xI p'2 => ad_x (xO p'2) + end + | xO p' => + match p2 with + | xH => ad_x (xI p') + | xO p'2 => + match p_xor p' p'2 with + | ad_z => ad_z + | ad_x p'' => ad_x (xO p'') + end + | xI p'2 => + match p_xor p' p'2 with + | ad_z => ad_x 1 + | ad_x p'' => ad_x (xI p'') + end + end + | xI p' => + match p2 with + | xH => ad_x (xO p') + | xO p'2 => + match p_xor p' p'2 with + | ad_z => ad_x 1 + | ad_x p'' => ad_x (xI p'') + end + | xI p'2 => + match p_xor p' p'2 with + | ad_z => ad_z + | ad_x p'' => ad_x (xO p'') + end + end end. -Definition ad_xor := [a,a':ad] - Cases a of - ad_z => a' - | (ad_x p) => Cases a' of - ad_z => a - | (ad_x p') => (p_xor p p') - end +Definition ad_xor (a a':ad) := + match a with + | ad_z => a' + | ad_x p => match a' with + | ad_z => a + | ad_x p' => p_xor p p' + end end. -Lemma ad_xor_neutral_left : (a:ad) (ad_xor ad_z a)=a. +Lemma ad_xor_neutral_left : forall a:ad, ad_xor ad_z a = a. Proof. - Trivial. + trivial. Qed. -Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a. +Lemma ad_xor_neutral_right : forall a:ad, ad_xor a ad_z = a. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a). +Lemma ad_xor_comm : forall a a':ad, ad_xor a a' = ad_xor a' a. Proof. - NewDestruct a; NewDestruct a'; Simpl; Auto. - Generalize p0; Clear p0; NewInduction p as [p Hrecp|p Hrecp|]; Simpl; Auto. - NewDestruct p0; Simpl; Trivial; Intros. - Rewrite Hrecp; Trivial. - Rewrite Hrecp; Trivial. - NewDestruct p0; Simpl; Trivial; Intros. - Rewrite Hrecp; Trivial. - Rewrite Hrecp; Trivial. - NewDestruct p0; Simpl; Auto. + destruct a; destruct a'; simpl in |- *; auto. + generalize p0; clear p0; induction p as [p Hrecp| p Hrecp| ]; simpl in |- *; + auto. + destruct p0; simpl in |- *; trivial; intros. + rewrite Hrecp; trivial. + rewrite Hrecp; trivial. + destruct p0; simpl in |- *; trivial; intros. + rewrite Hrecp; trivial. + rewrite Hrecp; trivial. + destruct p0 as [p| p| ]; simpl in |- *; auto. Qed. -Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z. +Lemma ad_xor_nilpotent : forall a:ad, ad_xor a a = ad_z. Proof. - NewDestruct a; Trivial. - Simpl. NewInduction p as [p IHp|p IHp|]; Trivial. - Simpl. Rewrite IHp; Reflexivity. - Simpl. Rewrite IHp; Reflexivity. + destruct a; trivial. + simpl in |- *. induction p as [p IHp| p IHp| ]; trivial. + simpl in |- *. rewrite IHp; reflexivity. + simpl in |- *. rewrite IHp; reflexivity. Qed. -Fixpoint ad_bit_1 [p:positive] : nat -> bool := - Cases p of - xH => [n:nat] Cases n of - O => true - | (S _) => false - end - | (xO p) => [n:nat] Cases n of - O => false - | (S n') => (ad_bit_1 p n') - end - | (xI p) => [n:nat] Cases n of - O => true - | (S n') => (ad_bit_1 p n') - end +Fixpoint ad_bit_1 (p:positive) : nat -> bool := + match p with + | xH => fun n:nat => match n with + | O => true + | S _ => false + end + | xO p => + fun n:nat => match n with + | O => false + | S n' => ad_bit_1 p n' + end + | xI p => fun n:nat => match n with + | O => true + | S n' => ad_bit_1 p n' + end end. -Definition ad_bit := [a:ad] - Cases a of - ad_z => [_:nat] false - | (ad_x p) => (ad_bit_1 p) +Definition ad_bit (a:ad) := + match a with + | ad_z => fun _:nat => false + | ad_x p => ad_bit_1 p end. -Definition eqf := [f,g:nat->bool] (n:nat) (f n)=(g n). +Definition eqf (f g:nat -> bool) := forall n:nat, f n = g n. -Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) -> ad_z=a. +Lemma ad_faithful_1 : forall a:ad, eqf (ad_bit ad_z) (ad_bit a) -> ad_z = a. Proof. - NewDestruct a. Trivial. - NewInduction p as [p IHp|p IHp|];Intro H. Absurd ad_z=(ad_x p). Discriminate. - Exact (IHp [n:nat](H (S n))). - Absurd ad_z=(ad_x p). Discriminate. - Exact (IHp [n:nat](H (S n))). - Absurd false=true. Discriminate. - Exact (H O). + destruct a. trivial. + induction p as [p IHp| p IHp| ]; intro H. absurd (ad_z = ad_x p). discriminate. + exact (IHp (fun n:nat => H (S n))). + absurd (ad_z = ad_x p). discriminate. + exact (IHp (fun n:nat => H (S n))). + absurd (false = true). discriminate. + exact (H 0). Qed. -Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) -> (ad_x xH)=a. +Lemma ad_faithful_2 : + forall a:ad, eqf (ad_bit (ad_x 1)) (ad_bit a) -> ad_x 1 = a. Proof. - NewDestruct a. Intros. Absurd true=false. Discriminate. - Exact (H O). - NewDestruct p. Intro H. Absurd ad_z=(ad_x p). Discriminate. - Exact (ad_faithful_1 (ad_x p) [n:nat](H (S n))). - Intros. Absurd true=false. Discriminate. - Exact (H O). - Trivial. + destruct a. intros. absurd (true = false). discriminate. + exact (H 0). + destruct p. intro H. absurd (ad_z = ad_x p). discriminate. + exact (ad_faithful_1 (ad_x p) (fun n:nat => H (S n))). + intros. absurd (true = false). discriminate. + exact (H 0). + trivial. Qed. Lemma ad_faithful_3 : - (a:ad) (p:positive) - ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') -> - (eqf (ad_bit (ad_x (xO p))) (ad_bit a)) -> - (ad_x (xO p))=a. + forall (a:ad) (p:positive), + (forall p':positive, eqf (ad_bit (ad_x p)) (ad_bit (ad_x p')) -> p = p') -> + eqf (ad_bit (ad_x (xO p))) (ad_bit a) -> ad_x (xO p) = a. Proof. - NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))). - Intro. Rewrite (ad_faithful_1 (ad_x (xO p)) H1). Reflexivity. - Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity. - Case p. Intros. Absurd false=true. Discriminate. - Exact (H0 O). - Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity. - Intros. Absurd false=true. Discriminate. - Exact (H0 O). + destruct a. intros. cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))). + intro. rewrite (ad_faithful_1 (ad_x (xO p)) H1). reflexivity. + unfold eqf in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity. + case p. intros. absurd (false = true). discriminate. + exact (H0 0). + intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. + intros. absurd (false = true). discriminate. + exact (H0 0). Qed. Lemma ad_faithful_4 : - (a:ad) (p:positive) - ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') -> - (eqf (ad_bit (ad_x (xI p))) (ad_bit a)) -> - (ad_x (xI p))=a. + forall (a:ad) (p:positive), + (forall p':positive, eqf (ad_bit (ad_x p)) (ad_bit (ad_x p')) -> p = p') -> + eqf (ad_bit (ad_x (xI p))) (ad_bit a) -> ad_x (xI p) = a. Proof. - NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))). - Intro. Rewrite (ad_faithful_1 (ad_x (xI p)) H1). Reflexivity. - Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity. - Case p. Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity. - Intros. Absurd true=false. Discriminate. - Exact (H0 O). - Intros. Absurd ad_z=(ad_x p0). Discriminate. - Cut (eqf (ad_bit (ad_x xH)) (ad_bit (ad_x (xI p0)))). - Intro. Exact (ad_faithful_1 (ad_x p0) [n:nat](H1 (S n))). - Unfold eqf. Unfold eqf in H0. Intro. Rewrite H0. Reflexivity. + destruct a. intros. cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))). + intro. rewrite (ad_faithful_1 (ad_x (xI p)) H1). reflexivity. + unfold eqf in |- *. intro. unfold eqf in H0. rewrite H0. reflexivity. + case p. intros. rewrite (H p0 (fun n:nat => H0 (S n))). reflexivity. + intros. absurd (true = false). discriminate. + exact (H0 0). + intros. absurd (ad_z = ad_x p0). discriminate. + cut (eqf (ad_bit (ad_x 1)) (ad_bit (ad_x (xI p0)))). + intro. exact (ad_faithful_1 (ad_x p0) (fun n:nat => H1 (S n))). + unfold eqf in |- *. unfold eqf in H0. intro. rewrite H0. reflexivity. Qed. -Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) -> a=a'. +Lemma ad_faithful : forall a a':ad, eqf (ad_bit a) (ad_bit a') -> a = a'. Proof. - NewDestruct a. Exact ad_faithful_1. - NewInduction p. Intros a' H. Apply ad_faithful_4. Intros. Cut (ad_x p)=(ad_x p'). - Intro. Inversion H1. Reflexivity. - Exact (IHp (ad_x p') H0). - Assumption. - Intros. Apply ad_faithful_3. Intros. Cut (ad_x p)=(ad_x p'). Intro. Inversion H1. Reflexivity. - Exact (IHp (ad_x p') H0). - Assumption. - Exact ad_faithful_2. + destruct a. exact ad_faithful_1. + induction p. intros a' H. apply ad_faithful_4. intros. cut (ad_x p = ad_x p'). + intro. inversion H1. reflexivity. + exact (IHp (ad_x p') H0). + assumption. + intros. apply ad_faithful_3. intros. cut (ad_x p = ad_x p'). intro. inversion H1. reflexivity. + exact (IHp (ad_x p') H0). + assumption. + exact ad_faithful_2. Qed. -Definition adf_xor := [f,g:nat->bool; n:nat] (xorb (f n) (g n)). +Definition adf_xor (f g:nat -> bool) (n:nat) := xorb (f n) (g n). -Lemma ad_xor_sem_1 : (a':ad) (ad_bit (ad_xor ad_z a') O)=(ad_bit a' O). +Lemma ad_xor_sem_1 : forall a':ad, ad_bit (ad_xor ad_z a') 0 = ad_bit a' 0. Proof. - Trivial. + trivial. Qed. -Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xH) a') O)=(negb (ad_bit a' O)). +Lemma ad_xor_sem_2 : + forall a':ad, ad_bit (ad_xor (ad_x 1) a') 0 = negb (ad_bit a' 0). Proof. - Intro. Case a'. Trivial. - Simpl. Intro. - Case p; Trivial. + intro. case a'. trivial. + simpl in |- *. intro. + case p; trivial. Qed. Lemma ad_xor_sem_3 : - (p:positive) (a':ad) (ad_bit (ad_xor (ad_x (xO p)) a') O)=(ad_bit a' O). + forall (p:positive) (a':ad), + ad_bit (ad_xor (ad_x (xO p)) a') 0 = ad_bit a' 0. Proof. - Intros. Case a'. Trivial. - Simpl. Intro. - Case p0; Trivial. Intro. - Case (p_xor p p1); Trivial. - Intro. Case (p_xor p p1); Trivial. + intros. case a'. trivial. + simpl in |- *. intro. + case p0; trivial. intro. + case (p_xor p p1); trivial. + intro. case (p_xor p p1); trivial. Qed. -Lemma ad_xor_sem_4 : (p:positive) (a':ad) - (ad_bit (ad_xor (ad_x (xI p)) a') O)=(negb (ad_bit a' O)). +Lemma ad_xor_sem_4 : + forall (p:positive) (a':ad), + ad_bit (ad_xor (ad_x (xI p)) a') 0 = negb (ad_bit a' 0). Proof. - Intros. Case a'. Trivial. - Simpl. Intro. Case p0; Trivial. Intro. - Case (p_xor p p1); Trivial. - Intro. - Case (p_xor p p1); Trivial. + intros. case a'. trivial. + simpl in |- *. intro. case p0; trivial. intro. + case (p_xor p p1); trivial. + intro. + case (p_xor p p1); trivial. Qed. Lemma ad_xor_sem_5 : - (a,a':ad) (ad_bit (ad_xor a a') O)=(adf_xor (ad_bit a) (ad_bit a') O). -Proof. - NewDestruct a. Intro. Change (ad_bit a' O)=(xorb false (ad_bit a' O)). Rewrite false_xorb. Trivial. - Case p. Exact ad_xor_sem_4. - Intros. Change (ad_bit (ad_xor (ad_x (xO p0)) a') O)=(xorb false (ad_bit a' O)). - Rewrite false_xorb. Apply ad_xor_sem_3. Exact ad_xor_sem_2. -Qed. - -Lemma ad_xor_sem_6 : (n:nat) - ((a,a':ad) (ad_bit (ad_xor a a') n)=(adf_xor (ad_bit a) (ad_bit a') n)) -> - (a,a':ad) (ad_bit (ad_xor a a') (S n))=(adf_xor (ad_bit a) (ad_bit a') (S n)). -Proof. - Intros. Case a. Unfold adf_xor. Unfold 2 ad_bit. Rewrite false_xorb. Reflexivity. - Case a'. Unfold adf_xor. Unfold 3 ad_bit. Intro. Rewrite xorb_false. Reflexivity. - Intros. Case p0. Case p. Intros. - Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intros. - Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity. - Case p. Intros. - Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intros. - Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n)) - =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n). - Rewrite <- H. Simpl. - Case (p_xor p2 p1); Trivial. - Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity. - Unfold adf_xor. Unfold 2 ad_bit. Unfold ad_bit_1. Rewrite false_xorb. Simpl. Case p; Trivial. + forall a a':ad, ad_bit (ad_xor a a') 0 = adf_xor (ad_bit a) (ad_bit a') 0. +Proof. + destruct a. intro. change (ad_bit a' 0 = xorb false (ad_bit a' 0)) in |- *. rewrite false_xorb. trivial. + case p. exact ad_xor_sem_4. + intros. change (ad_bit (ad_xor (ad_x (xO p0)) a') 0 = xorb false (ad_bit a' 0)) + in |- *. + rewrite false_xorb. apply ad_xor_sem_3. exact ad_xor_sem_2. +Qed. + +Lemma ad_xor_sem_6 : + forall n:nat, + (forall a a':ad, ad_bit (ad_xor a a') n = adf_xor (ad_bit a) (ad_bit a') n) -> + forall a a':ad, + ad_bit (ad_xor a a') (S n) = adf_xor (ad_bit a) (ad_bit a') (S n). +Proof. + intros. case a. unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. rewrite false_xorb. reflexivity. + case a'. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. intro. rewrite xorb_false. reflexivity. + intros. case p0. case p. intros. + change + (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n) = + adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) + in |- *. + rewrite <- H. simpl in |- *. + case (p_xor p2 p1); trivial. + intros. + change + (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n) = + adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) + in |- *. + rewrite <- H. simpl in |- *. + case (p_xor p2 p1); trivial. + intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity. + case p. intros. + change + (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n) = + adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) + in |- *. + rewrite <- H. simpl in |- *. + case (p_xor p2 p1); trivial. + intros. + change + (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n) = + adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n) + in |- *. + rewrite <- H. simpl in |- *. + case (p_xor p2 p1); trivial. + intro. unfold adf_xor in |- *. unfold ad_bit at 3 in |- *. unfold ad_bit_1 in |- *. rewrite xorb_false. reflexivity. + unfold adf_xor in |- *. unfold ad_bit at 2 in |- *. unfold ad_bit_1 in |- *. rewrite false_xorb. simpl in |- *. case p; trivial. Qed. Lemma ad_xor_semantics : - (a,a':ad) (eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a'))). + forall a a':ad, eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a')). Proof. - Unfold eqf. Intros. Generalize a a'. Elim n. Exact ad_xor_sem_5. - Exact ad_xor_sem_6. + unfold eqf in |- *. intros. generalize a a'. elim n. exact ad_xor_sem_5. + exact ad_xor_sem_6. Qed. -Lemma eqf_sym : (f,f':nat->bool) (eqf f f') -> (eqf f' f). +Lemma eqf_sym : forall f f':nat -> bool, eqf f f' -> eqf f' f. Proof. - Unfold eqf. Intros. Rewrite H. Reflexivity. + unfold eqf in |- *. intros. rewrite H. reflexivity. Qed. -Lemma eqf_refl : (f:nat->bool) (eqf f f). +Lemma eqf_refl : forall f:nat -> bool, eqf f f. Proof. - Unfold eqf. Trivial. + unfold eqf in |- *. trivial. Qed. -Lemma eqf_trans : (f,f',f'':nat->bool) (eqf f f') -> (eqf f' f'') -> (eqf f f''). +Lemma eqf_trans : + forall f f' f'':nat -> bool, eqf f f' -> eqf f' f'' -> eqf f f''. Proof. - Unfold eqf. Intros. Rewrite H. Exact (H0 n). + unfold eqf in |- *. intros. rewrite H. exact (H0 n). Qed. -Lemma adf_xor_eq : (f,f':nat->bool) (eqf (adf_xor f f') [n:nat] false) -> (eqf f f'). +Lemma adf_xor_eq : + forall f f':nat -> bool, eqf (adf_xor f f') (fun n:nat => false) -> eqf f f'. Proof. - Unfold eqf. Unfold adf_xor. Intros. Apply xorb_eq. Apply H. + unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_eq. apply H. Qed. -Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z -> a=a'. +Lemma ad_xor_eq : forall a a':ad, ad_xor a a' = ad_z -> a = a'. Proof. - Intros. Apply ad_faithful. Apply adf_xor_eq. Apply eqf_trans with f':=(ad_bit (ad_xor a a')). - Apply eqf_sym. Apply ad_xor_semantics. - Rewrite H. Unfold eqf. Trivial. + intros. apply ad_faithful. apply adf_xor_eq. apply eqf_trans with (f' := ad_bit (ad_xor a a')). + apply eqf_sym. apply ad_xor_semantics. + rewrite H. unfold eqf in |- *. trivial. Qed. -Lemma adf_xor_assoc : (f,f',f'':nat->bool) - (eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f''))). +Lemma adf_xor_assoc : + forall f f' f'':nat -> bool, + eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f'')). Proof. - Unfold eqf. Unfold adf_xor. Intros. Apply xorb_assoc. + unfold eqf in |- *. unfold adf_xor in |- *. intros. apply xorb_assoc. Qed. -Lemma eqf_xor_1 : (f,f',f'',f''':nat->bool) (eqf f f') -> (eqf f'' f''') -> - (eqf (adf_xor f f'') (adf_xor f' f''')). +Lemma eqf_xor_1 : + forall f f' f'' f''':nat -> bool, + eqf f f' -> eqf f'' f''' -> eqf (adf_xor f f'') (adf_xor f' f'''). Proof. - Unfold eqf. Intros. Unfold adf_xor. Rewrite H. Rewrite H0. Reflexivity. + unfold eqf in |- *. intros. unfold adf_xor in |- *. rewrite H. rewrite H0. reflexivity. Qed. Lemma ad_xor_assoc : - (a,a',a'':ad) (ad_xor (ad_xor a a') a'')=(ad_xor a (ad_xor a' a'')). -Proof. - Intros. Apply ad_faithful. - Apply eqf_trans with f':=(adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')). - Apply eqf_trans with f':=(adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')). - Apply ad_xor_semantics. - Apply eqf_xor_1. Apply ad_xor_semantics. - Apply eqf_refl. - Apply eqf_trans with f':=(adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))). - Apply adf_xor_assoc. - Apply eqf_trans with f':=(adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))). - Apply eqf_xor_1. Apply eqf_refl. - Apply eqf_sym. Apply ad_xor_semantics. - Apply eqf_sym. Apply ad_xor_semantics. -Qed. - -Definition ad_double := [a:ad] - Cases a of - ad_z => ad_z - | (ad_x p) => (ad_x (xO p)) + forall a a' a'':ad, ad_xor (ad_xor a a') a'' = ad_xor a (ad_xor a' a''). +Proof. + intros. apply ad_faithful. + apply eqf_trans with + (f' := adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')). + apply eqf_trans with (f' := adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')). + apply ad_xor_semantics. + apply eqf_xor_1. apply ad_xor_semantics. + apply eqf_refl. + apply eqf_trans with + (f' := adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))). + apply adf_xor_assoc. + apply eqf_trans with (f' := adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))). + apply eqf_xor_1. apply eqf_refl. + apply eqf_sym. apply ad_xor_semantics. + apply eqf_sym. apply ad_xor_semantics. +Qed. + +Definition ad_double (a:ad) := + match a with + | ad_z => ad_z + | ad_x p => ad_x (xO p) end. -Definition ad_double_plus_un := [a:ad] - Cases a of - ad_z => (ad_x xH) - | (ad_x p) => (ad_x (xI p)) +Definition ad_double_plus_un (a:ad) := + match a with + | ad_z => ad_x 1 + | ad_x p => ad_x (xI p) end. -Definition ad_div_2 := [a:ad] - Cases a of - ad_z => ad_z - | (ad_x xH) => ad_z - | (ad_x (xO p)) => (ad_x p) - | (ad_x (xI p)) => (ad_x p) +Definition ad_div_2 (a:ad) := + match a with + | ad_z => ad_z + | ad_x xH => ad_z + | ad_x (xO p) => ad_x p + | ad_x (xI p) => ad_x p end. -Lemma ad_double_div_2 : (a:ad) (ad_div_2 (ad_double a))=a. +Lemma ad_double_div_2 : forall a:ad, ad_div_2 (ad_double a) = a. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a. +Lemma ad_double_plus_un_div_2 : + forall a:ad, ad_div_2 (ad_double_plus_un a) = a. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1) -> a0=a1. +Lemma ad_double_inj : forall a0 a1:ad, ad_double a0 = ad_double a1 -> a0 = a1. Proof. - Intros. Rewrite <- (ad_double_div_2 a0). Rewrite H. Apply ad_double_div_2. + intros. rewrite <- (ad_double_div_2 a0). rewrite H. apply ad_double_div_2. Qed. Lemma ad_double_plus_un_inj : - (a0,a1:ad) (ad_double_plus_un a0)=(ad_double_plus_un a1) -> a0=a1. + forall a0 a1:ad, ad_double_plus_un a0 = ad_double_plus_un a1 -> a0 = a1. Proof. - Intros. Rewrite <- (ad_double_plus_un_div_2 a0). Rewrite H. Apply ad_double_plus_un_div_2. + intros. rewrite <- (ad_double_plus_un_div_2 a0). rewrite H. apply ad_double_plus_un_div_2. Qed. -Definition ad_bit_0 := [a:ad] - Cases a of - ad_z => false - | (ad_x (xO _)) => false - | _ => true +Definition ad_bit_0 (a:ad) := + match a with + | ad_z => false + | ad_x (xO _) => false + | _ => true end. -Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false. +Lemma ad_double_bit_0 : forall a:ad, ad_bit_0 (ad_double a) = false. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true. +Lemma ad_double_plus_un_bit_0 : + forall a:ad, ad_bit_0 (ad_double_plus_un a) = true. Proof. - NewDestruct a; Trivial. + destruct a; trivial. Qed. -Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false -> (ad_double (ad_div_2 a))=a. +Lemma ad_div_2_double : + forall a:ad, ad_bit_0 a = false -> ad_double (ad_div_2 a) = a. Proof. - NewDestruct a. Trivial. NewDestruct p. Intro H. Discriminate H. - Intros. Reflexivity. - Intro H. Discriminate H. + destruct a. trivial. destruct p. intro H. discriminate H. + intros. reflexivity. + intro H. discriminate H. Qed. Lemma ad_div_2_double_plus_un : - (a:ad) (ad_bit_0 a)=true -> (ad_double_plus_un (ad_div_2 a))=a. + forall a:ad, ad_bit_0 a = true -> ad_double_plus_un (ad_div_2 a) = a. Proof. - NewDestruct a. Intro. Discriminate H. - NewDestruct p. Intros. Reflexivity. - Intro H. Discriminate H. - Intro. Reflexivity. + destruct a. intro. discriminate H. + destruct p. intros. reflexivity. + intro H. discriminate H. + intro. reflexivity. Qed. -Lemma ad_bit_0_correct : (a:ad) (ad_bit a O)=(ad_bit_0 a). +Lemma ad_bit_0_correct : forall a:ad, ad_bit a 0 = ad_bit_0 a. Proof. - NewDestruct a; Trivial. - NewDestruct p; Trivial. + destruct a; trivial. + destruct p; trivial. Qed. -Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 a) n)=(ad_bit a (S n)). +Lemma ad_div_2_correct : + forall (a:ad) (n:nat), ad_bit (ad_div_2 a) n = ad_bit a (S n). Proof. - NewDestruct a; Trivial. - NewDestruct p; Trivial. + destruct a; trivial. + destruct p; trivial. Qed. Lemma ad_xor_bit_0 : - (a,a':ad) (ad_bit_0 (ad_xor a a'))=(xorb (ad_bit_0 a) (ad_bit_0 a')). + forall a a':ad, ad_bit_0 (ad_xor a a') = xorb (ad_bit_0 a) (ad_bit_0 a'). Proof. - Intros. Rewrite <- ad_bit_0_correct. Rewrite (ad_xor_semantics a a' O). - Unfold adf_xor. Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Reflexivity. + intros. rewrite <- ad_bit_0_correct. rewrite (ad_xor_semantics a a' 0). + unfold adf_xor in |- *. rewrite ad_bit_0_correct. rewrite ad_bit_0_correct. reflexivity. Qed. Lemma ad_xor_div_2 : - (a,a':ad) (ad_div_2 (ad_xor a a'))=(ad_xor (ad_div_2 a) (ad_div_2 a')). + forall a a':ad, ad_div_2 (ad_xor a a') = ad_xor (ad_div_2 a) (ad_div_2 a'). Proof. - Intros. Apply ad_faithful. Unfold eqf. Intro. - Rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n). - Rewrite ad_div_2_correct. - Rewrite (ad_xor_semantics a a' (S n)). - Unfold adf_xor. Rewrite ad_div_2_correct. Rewrite ad_div_2_correct. - Reflexivity. + intros. apply ad_faithful. unfold eqf in |- *. intro. + rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n). + rewrite ad_div_2_correct. + rewrite (ad_xor_semantics a a' (S n)). + unfold adf_xor in |- *. rewrite ad_div_2_correct. rewrite ad_div_2_correct. + reflexivity. Qed. -Lemma ad_neg_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=true -> - (ad_bit_0 a)=(negb (ad_bit_0 a')). +Lemma ad_neg_bit_0 : + forall a a':ad, + ad_bit_0 (ad_xor a a') = true -> ad_bit_0 a = negb (ad_bit_0 a'). Proof. - Intros. Rewrite <- true_xorb. Rewrite <- H. Rewrite ad_xor_bit_0. - Rewrite xorb_assoc. Rewrite xorb_nilpotent. Rewrite xorb_false. Reflexivity. + intros. rewrite <- true_xorb. rewrite <- H. rewrite ad_xor_bit_0. + rewrite xorb_assoc. rewrite xorb_nilpotent. rewrite xorb_false. reflexivity. Qed. Lemma ad_neg_bit_0_1 : - (a,a':ad) (ad_xor a a')=(ad_x xH) -> (ad_bit_0 a)=(negb (ad_bit_0 a')). + forall a a':ad, ad_xor a a' = ad_x 1 -> ad_bit_0 a = negb (ad_bit_0 a'). Proof. - Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity. + intros. apply ad_neg_bit_0. rewrite H. reflexivity. Qed. -Lemma ad_neg_bit_0_2 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xI p)) -> - (ad_bit_0 a)=(negb (ad_bit_0 a')). +Lemma ad_neg_bit_0_2 : + forall (a a':ad) (p:positive), + ad_xor a a' = ad_x (xI p) -> ad_bit_0 a = negb (ad_bit_0 a'). Proof. - Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity. + intros. apply ad_neg_bit_0. rewrite H. reflexivity. Qed. -Lemma ad_same_bit_0 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xO p)) -> - (ad_bit_0 a)=(ad_bit_0 a'). +Lemma ad_same_bit_0 : + forall (a a':ad) (p:positive), + ad_xor a a' = ad_x (xO p) -> ad_bit_0 a = ad_bit_0 a'. Proof. - Intros. Rewrite <- (xorb_false (ad_bit_0 a)). Cut (ad_bit_0 (ad_x (xO p)))=false. - Intro. Rewrite <- H0. Rewrite <- H. Rewrite ad_xor_bit_0. Rewrite <- xorb_assoc. - Rewrite xorb_nilpotent. Rewrite false_xorb. Reflexivity. - Reflexivity. -Qed. + intros. rewrite <- (xorb_false (ad_bit_0 a)). cut (ad_bit_0 (ad_x (xO p)) = false). + intro. rewrite <- H0. rewrite <- H. rewrite ad_xor_bit_0. rewrite <- xorb_assoc. + rewrite xorb_nilpotent. rewrite false_xorb. reflexivity. + reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Adist.v b/theories/IntMap/Adist.v index fbc2870f1..30b54ac14 100644 --- a/theories/IntMap/Adist.v +++ b/theories/IntMap/Adist.v @@ -7,233 +7,244 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require ZArith. -Require Arith. -Require Min. -Require Addr. - -Fixpoint ad_plength_1 [p:positive] : nat := - Cases p of - xH => O - | (xI _) => O - | (xO p') => (S (ad_plength_1 p')) +Require Import Bool. +Require Import ZArith. +Require Import Arith. +Require Import Min. +Require Import Addr. + +Fixpoint ad_plength_1 (p:positive) : nat := + match p with + | xH => 0 + | xI _ => 0 + | xO p' => S (ad_plength_1 p') end. Inductive natinf : Set := - infty : natinf + | infty : natinf | ni : nat -> natinf. -Definition ad_plength := [a:ad] - Cases a of - ad_z => infty - | (ad_x p) => (ni (ad_plength_1 p)) +Definition ad_plength (a:ad) := + match a with + | ad_z => infty + | ad_x p => ni (ad_plength_1 p) end. -Lemma ad_plength_infty : (a:ad) (ad_plength a)=infty -> a=ad_z. +Lemma ad_plength_infty : forall a:ad, ad_plength a = infty -> a = ad_z. Proof. - Induction a; Trivial. - Unfold ad_plength; Intros; Discriminate H. + simple induction a; trivial. + unfold ad_plength in |- *; intros; discriminate H. Qed. -Lemma ad_plength_zeros : (a:ad) (n:nat) (ad_plength a)=(ni n) -> - (k:nat) (lt k n) -> (ad_bit a k)=false. +Lemma ad_plength_zeros : + forall (a:ad) (n:nat), + ad_plength a = ni n -> forall k:nat, k < n -> ad_bit a k = false. Proof. - Induction a; Trivial. - Induction p. Induction n. Intros. Inversion H1. - Induction k. Simpl in H1. Discriminate H1. - Intros. Simpl in H1. Discriminate H1. - Induction k. Trivial. - Generalize H0. Case n. Intros. Inversion H3. - Intros. Simpl. Unfold ad_bit in H. Apply (H n0). Simpl in H1. Inversion H1. Reflexivity. - Exact (lt_S_n n1 n0 H3). - Simpl. Intros n H. Inversion H. Intros. Inversion H0. + simple induction a; trivial. + simple induction p. simple induction n. intros. inversion H1. + simple induction k. simpl in H1. discriminate H1. + intros. simpl in H1. discriminate H1. + simple induction k. trivial. + generalize H0. case n. intros. inversion H3. + intros. simpl in |- *. unfold ad_bit 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. Qed. -Lemma ad_plength_one : (a:ad) (n:nat) (ad_plength a)=(ni n) -> (ad_bit a n)=true. +Lemma ad_plength_one : + forall (a:ad) (n:nat), ad_plength a = ni n -> ad_bit a n = true. Proof. - Induction a. Intros. Inversion H. - Induction p. Intros. Simpl in H0. Inversion H0. Reflexivity. - Intros. Simpl in H0. Inversion H0. Simpl. Unfold ad_bit in H. Apply H. Reflexivity. - Intros. Simpl in H. Inversion H. Reflexivity. + 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 ad_bit in H. apply H. reflexivity. + intros. simpl in H. inversion H. reflexivity. Qed. -Lemma ad_plength_first_one : (a:ad) (n:nat) - ((k:nat) (lt k n) -> (ad_bit a k)=false) -> (ad_bit a n)=true -> - (ad_plength a)=(ni n). +Lemma ad_plength_first_one : + forall (a:ad) (n:nat), + (forall k:nat, k < n -> ad_bit a k = false) -> + ad_bit a n = true -> ad_plength a = ni n. Proof. - Induction a. Intros. Simpl in H0. Discriminate H0. - Induction p. Intros. Generalize H0. Case n. Intros. Reflexivity. - Intros. Absurd (ad_bit (ad_x (xI p0)) O)=false. Trivial with bool. - Auto with bool arith. - Intros. Generalize H0 H1. Case n. Intros. Simpl in H3. Discriminate H3. - Intros. Simpl. Unfold ad_plength in H. - Cut (ni (ad_plength_1 p0))=(ni n0). Intro. Inversion H4. Reflexivity. - Apply H. Intros. Change (ad_bit (ad_x (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. + simple induction a. intros. simpl in H0. discriminate H0. + simple induction p. intros. generalize H0. case n. intros. reflexivity. + intros. absurd (ad_bit (ad_x (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 ad_plength in H. + cut (ni (ad_plength_1 p0) = ni n0). intro. inversion H4. reflexivity. + apply H. intros. change (ad_bit (ad_x (xO p0)) (S k) = false) in |- *. apply H2. apply lt_n_S. exact H4. + exact H3. + intro. case n. trivial. + intros. simpl in H0. discriminate H0. Qed. -Definition ni_min := [d,d':natinf] - Cases d of - infty => d' - | (ni n) => Cases d' of - infty => d - | (ni n') => (ni (min n n')) - end +Definition ni_min (d d':natinf) := + match d with + | infty => d' + | ni n => match d' with + | infty => d + | ni n' => ni (min n n') + end end. -Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d. +Lemma ni_min_idemp : forall d:natinf, ni_min d d = d. Proof. - Induction d; Trivial. - Unfold ni_min. - Induction n; Trivial. - Intros. - Simpl. - Inversion H. - Rewrite H1. - Rewrite H1. - Reflexivity. + simple induction d; trivial. + unfold ni_min in |- *. + simple induction n; trivial. + intros. + simpl in |- *. + inversion H. + rewrite H1. + rewrite H1. + reflexivity. Qed. -Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d). +Lemma ni_min_comm : forall d d':natinf, ni_min d d' = ni_min d' d. Proof. - Induction d. Induction d'; Trivial. - Induction d'; Trivial. Elim n. Induction n0; Trivial. - Intros. Elim n1; Trivial. Intros. Unfold ni_min in H. Cut (min n0 n2)=(min n2 n0). - Intro. Unfold ni_min. Simpl. Rewrite H1. Reflexivity. - Cut (ni (min n0 n2))=(ni (min n2 n0)). Intros. - Inversion H1; Trivial. - Exact (H n2). + 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. + cut (ni (min n0 n2) = ni (min n2 n0)). intros. + inversion H1; trivial. + exact (H n2). Qed. -Lemma ni_min_assoc : (d,d',d'':natinf) (ni_min (ni_min d d') d'')=(ni_min d (ni_min d' d'')). +Lemma ni_min_assoc : + forall d d' d'':natinf, ni_min (ni_min d d') d'' = ni_min d (ni_min d' d''). Proof. - Induction d; Trivial. Induction d'; Trivial. - Induction d''; Trivial. - 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. - Induction n3; Trivial. Induction n5; Trivial. - Intros. Simpl. Auto. + 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)). + intro. rewrite H. reflexivity. + generalize n0 n1. elim n; trivial. + simple induction n3; trivial. simple induction n5; trivial. + intros. simpl in |- *. auto. Qed. -Lemma ni_min_O_l : (d:natinf) (ni_min (ni O) d)=(ni O). +Lemma ni_min_O_l : forall d:natinf, ni_min (ni 0) d = ni 0. Proof. - Induction d; Trivial. + simple induction d; trivial. Qed. -Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O). +Lemma ni_min_O_r : forall d:natinf, ni_min d (ni 0) = ni 0. Proof. - Intros. Rewrite ni_min_comm. Apply ni_min_O_l. + intros. rewrite ni_min_comm. apply ni_min_O_l. Qed. -Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d. +Lemma ni_min_inf_l : forall d:natinf, ni_min infty d = d. Proof. - Trivial. + trivial. Qed. -Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d. +Lemma ni_min_inf_r : forall d:natinf, ni_min d infty = d. Proof. - Induction d; Trivial. + simple induction d; trivial. Qed. -Definition ni_le := [d,d':natinf] (ni_min d d')=d. +Definition ni_le (d d':natinf) := ni_min d d' = d. -Lemma ni_le_refl : (d:natinf) (ni_le d d). +Lemma ni_le_refl : forall d:natinf, ni_le d d. Proof. - Exact ni_min_idemp. + exact ni_min_idemp. Qed. -Lemma ni_le_antisym : (d,d':natinf) (ni_le d d') -> (ni_le d' d) -> d=d'. +Lemma ni_le_antisym : forall d d':natinf, ni_le d d' -> ni_le d' d -> d = d'. Proof. - Unfold ni_le. Intros d d'. Rewrite ni_min_comm. Intro H. Rewrite H. Trivial. + unfold ni_le in |- *. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial. Qed. -Lemma ni_le_trans : (d,d',d'':natinf) (ni_le d d') -> (ni_le d' d'') -> (ni_le d d''). +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. Intros. Rewrite <- H. Rewrite ni_min_assoc. Rewrite H0. Reflexivity. + unfold ni_le in |- *. intros. rewrite <- H. rewrite ni_min_assoc. rewrite H0. reflexivity. Qed. -Lemma ni_le_min_1 : (d,d':natinf) (ni_le (ni_min d d') d). +Lemma ni_le_min_1 : forall d d':natinf, ni_le (ni_min d d') d. Proof. - Unfold ni_le. Intros. Rewrite (ni_min_comm d d'). Rewrite ni_min_assoc. - Rewrite ni_min_idemp. Reflexivity. + unfold ni_le in |- *. intros. rewrite (ni_min_comm d d'). rewrite ni_min_assoc. + rewrite ni_min_idemp. reflexivity. Qed. -Lemma ni_le_min_2 : (d,d':natinf) (ni_le (ni_min d d') d'). +Lemma ni_le_min_2 : forall d d':natinf, ni_le (ni_min d d') d'. Proof. - Unfold ni_le. Intros. Rewrite ni_min_assoc. Rewrite ni_min_idemp. Reflexivity. + unfold ni_le in |- *. intros. rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity. Qed. -Lemma ni_min_case : (d,d':natinf) (ni_min d d')=d \/ (ni_min d d')=d'. +Lemma ni_min_case : forall d d':natinf, ni_min d d' = d \/ ni_min d d' = d'. Proof. - Induction d. Intro. Right . Exact (ni_min_inf_l d'). - Induction d'. Left . Exact (ni_min_inf_r (ni n)). - Unfold ni_min. Cut (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. - Induction n1. Right . Reflexivity. - Intros. Case (H n2). Intro. Left . Simpl. Rewrite H1. Reflexivity. - Intro. Right . Simpl. Rewrite H1. Reflexivity. + 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). + 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. Qed. -Lemma ni_le_total : (d,d':natinf) (ni_le d d') \/ (ni_le d' d). +Lemma ni_le_total : forall d d':natinf, ni_le d d' \/ ni_le d' d. Proof. - Unfold ni_le. Intros. Rewrite (ni_min_comm d' d). Apply ni_min_case. + unfold ni_le in |- *. intros. rewrite (ni_min_comm d' d). apply ni_min_case. Qed. -Lemma ni_le_min_induc : (d,d',dm:natinf) (ni_le dm d) -> (ni_le dm d') -> - ((d'':natinf) (ni_le d'' d) -> (ni_le d'' d') -> (ni_le d'' dm)) -> - (ni_min d d')=dm. +Lemma ni_le_min_induc : + forall d d' dm:natinf, + ni_le dm d -> + ni_le dm d' -> + (forall d'':natinf, ni_le d'' d -> ni_le d'' d' -> ni_le d'' dm) -> + ni_min d d' = dm. Proof. - Intros. Case (ni_min_case d d'). Intro. Rewrite H2. - 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. Rewrite ni_min_comm. Exact H2. - Apply ni_le_refl. - Exact H0. + intros. case (ni_min_case d d'). intro. rewrite H2. + 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. + apply ni_le_refl. + exact H0. Qed. -Lemma le_ni_le : (m,n:nat) (le m n) -> (ni_le (ni m) (ni n)). +Lemma le_ni_le : forall m n:nat, m <= n -> ni_le (ni m) (ni n). Proof. - Cut (m,n:nat)(le m n)->(min m n)=m. - Intros. Unfold ni_le ni_min. Rewrite (H m n H0). Reflexivity. - Induction m. Trivial. - Induction n0. Intro. Inversion H0. - Intros. Simpl. Rewrite (H n1 (le_S_n n n1 H1)). Reflexivity. + cut (forall m n:nat, m <= n -> min m n = m). + intros. unfold ni_le, ni_min in |- *. 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. Qed. -Lemma ni_le_le : (m,n:nat) (ni_le (ni m) (ni n)) -> (le m n). +Lemma ni_le_le : forall m n:nat, ni_le (ni m) (ni n) -> m <= n. Proof. - Unfold ni_le. Unfold ni_min. Intros. Inversion H. Apply le_min_r. + unfold ni_le in |- *. unfold ni_min in |- *. intros. inversion H. apply le_min_r. Qed. -Lemma ad_plength_lb : (a:ad) (n:nat) ((k:nat) (lt k n) -> (ad_bit a k)=false) -> - (ni_le (ni n) (ad_plength a)). +Lemma ad_plength_lb : + forall (a:ad) (n:nat), + (forall k:nat, k < n -> ad_bit a k = false) -> ni_le (ni n) (ad_plength a). Proof. - Induction a. Intros. Exact (ni_min_inf_r (ni n)). - Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt n (ad_plength_1 p)). Trivial. - Intro. Absurd (ad_bit (ad_x p) (ad_plength_1 p))=false. - Rewrite (ad_plength_one (ad_x p) (ad_plength_1 p) - (refl_equal natinf (ad_plength (ad_x p)))). - Discriminate. - Apply H. Exact H0. + simple induction a. intros. exact (ni_min_inf_r (ni n)). + intros. unfold ad_plength in |- *. apply le_ni_le. case (le_or_lt n (ad_plength_1 p)). trivial. + intro. absurd (ad_bit (ad_x p) (ad_plength_1 p) = false). + rewrite + (ad_plength_one (ad_x p) (ad_plength_1 p) + (refl_equal (ad_plength (ad_x p)))). + discriminate. + apply H. exact H0. Qed. -Lemma ad_plength_ub : (a:ad) (n:nat) (ad_bit a n)=true -> - (ni_le (ad_plength a) (ni n)). +Lemma ad_plength_ub : + forall (a:ad) (n:nat), ad_bit a n = true -> ni_le (ad_plength a) (ni n). Proof. - Induction a. Intros. Discriminate H. - Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt (ad_plength_1 p) n). Trivial. - Intro. Absurd (ad_bit (ad_x p) n)=true. - Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p) - (refl_equal natinf (ad_plength (ad_x p))) n H0). - Discriminate. - Exact H. + simple induction a. intros. discriminate H. + intros. unfold ad_plength in |- *. apply le_ni_le. case (le_or_lt (ad_plength_1 p) n). trivial. + intro. absurd (ad_bit (ad_x p) n = true). + rewrite + (ad_plength_zeros (ad_x p) (ad_plength_1 p) + (refl_equal (ad_plength (ad_x p))) n H0). + discriminate. + exact H. Qed. @@ -244,26 +255,26 @@ Qed. Instead of working with $d$, we work with $pd$, namely [ad_pdist]: *) -Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor a a')). +Definition ad_pdist (a a':ad) := ad_plength (ad_xor 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 ad_pdist_eq_1 : (a:ad) (ad_pdist a a)=infty. +Lemma ad_pdist_eq_1 : forall a:ad, ad_pdist a a = infty. Proof. - Intros. Unfold ad_pdist. Rewrite ad_xor_nilpotent. Reflexivity. + intros. unfold ad_pdist in |- *. rewrite ad_xor_nilpotent. reflexivity. Qed. -Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty -> a=a'. +Lemma ad_pdist_eq_2 : forall a a':ad, ad_pdist a a' = infty -> a = a'. Proof. - Intros. Apply ad_xor_eq. Apply ad_plength_infty. Exact H. + intros. apply ad_xor_eq. apply ad_plength_infty. exact H. Qed. (** $d$ is a distance, so $d(a,a')=d(a',a)$: *) -Lemma ad_pdist_comm : (a,a':ad) (ad_pdist a a')=(ad_pdist a' a). +Lemma ad_pdist_comm : forall a a':ad, ad_pdist a a' = ad_pdist a' a. Proof. - Unfold ad_pdist. Intros. Rewrite ad_xor_comm. Reflexivity. + unfold ad_pdist in |- *. intros. rewrite ad_xor_comm. reflexivity. Qed. (** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq @@ -278,44 +289,48 @@ Qed. (lemma [ad_plength_ultra]). *) -Lemma ad_plength_ultra_1 : (a,a':ad) - (ni_le (ad_plength a) (ad_plength a')) -> - (ni_le (ad_plength a) (ad_plength (ad_xor a a'))). +Lemma ad_plength_ultra_1 : + forall a a':ad, + ni_le (ad_plength a) (ad_plength a') -> + ni_le (ad_plength a) (ad_plength (ad_xor a a')). Proof. - Induction a. Intros. Unfold ni_le in H. Unfold 1 3 ad_plength in H. - Rewrite (ni_min_inf_l (ad_plength a')) in H. - Rewrite (ad_plength_infty a' H). Simpl. Apply ni_le_refl. - Intros. Unfold 1 ad_plength. Apply ad_plength_lb. Intros. - Cut (a'':ad)(ad_xor (ad_x p) a')=a''->(ad_bit a'' k)=false. - Intros. Apply H1. Reflexivity. - Intro a''. Case a''. Intro. Reflexivity. - Intros. Rewrite <- H1. Rewrite (ad_xor_semantics (ad_x p) a' k). Unfold adf_xor. - Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p) - (refl_equal natinf (ad_plength (ad_x p))) k H0). - Generalize H. Case a'. Trivial. - Intros. Cut (ad_bit (ad_x p1) k)=false. Intros. Rewrite H3. Reflexivity. - Apply ad_plength_zeros with n:=(ad_plength_1 p1). Reflexivity. - Apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). Exact H0. - Apply ni_le_le. Exact H2. + simple induction a. intros. unfold ni_le in H. unfold ad_plength at 1 3 in H. + rewrite (ni_min_inf_l (ad_plength a')) in H. + rewrite (ad_plength_infty a' H). simpl in |- *. apply ni_le_refl. + intros. unfold ad_plength at 1 in |- *. apply ad_plength_lb. intros. + cut (forall a'':ad, ad_xor (ad_x p) a' = a'' -> ad_bit a'' k = false). + intros. apply H1. reflexivity. + intro a''. case a''. intro. reflexivity. + intros. rewrite <- H1. rewrite (ad_xor_semantics (ad_x p) a' k). unfold adf_xor in |- *. + rewrite + (ad_plength_zeros (ad_x p) (ad_plength_1 p) + (refl_equal (ad_plength (ad_x p))) k H0). + generalize H. case a'. trivial. + intros. cut (ad_bit (ad_x p1) k = false). intros. rewrite H3. reflexivity. + apply ad_plength_zeros with (n := ad_plength_1 p1). reflexivity. + apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). exact H0. + apply ni_le_le. exact H2. Qed. -Lemma ad_plength_ultra : (a,a':ad) - (ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a'))). +Lemma ad_plength_ultra : + forall a a':ad, + ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a')). Proof. - Intros. Case (ni_le_total (ad_plength a) (ad_plength a')). Intro. - Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a). - Intro. Rewrite H0. Apply ad_plength_ultra_1. Exact H. - Exact H. - Intro. Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a'). - Intro. Rewrite H0. Rewrite ad_xor_comm. Apply ad_plength_ultra_1. Exact H. - Rewrite ni_min_comm. Exact H. + intros. case (ni_le_total (ad_plength a) (ad_plength a')). intro. + cut (ni_min (ad_plength a) (ad_plength a') = ad_plength a). + intro. rewrite H0. apply ad_plength_ultra_1. exact H. + exact H. + intro. cut (ni_min (ad_plength a) (ad_plength a') = ad_plength a'). + intro. rewrite H0. rewrite ad_xor_comm. apply ad_plength_ultra_1. exact H. + rewrite ni_min_comm. exact H. Qed. -Lemma ad_pdist_ultra : (a,a',a'':ad) - (ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a')). +Lemma ad_pdist_ultra : + forall a a' a'':ad, + ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a'). Proof. - Intros. Unfold ad_pdist. Cut (ad_xor (ad_xor a a'') (ad_xor a'' a'))=(ad_xor a a'). - Intro. Rewrite <- H. Apply ad_plength_ultra. - Rewrite ad_xor_assoc. Rewrite <- (ad_xor_assoc a'' a'' a'). Rewrite ad_xor_nilpotent. - Rewrite ad_xor_neutral_left. Reflexivity. -Qed. + intros. unfold ad_pdist in |- *. cut (ad_xor (ad_xor a a'') (ad_xor a'' a') = ad_xor a a'). + intro. rewrite <- H. apply ad_plength_ultra. + rewrite ad_xor_assoc. rewrite <- (ad_xor_assoc a'' a'' a'). rewrite ad_xor_nilpotent. + rewrite ad_xor_neutral_left. reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Allmaps.v b/theories/IntMap/Allmaps.v index fcd111694..0020219d0 100644 --- a/theories/IntMap/Allmaps.v +++ b/theories/IntMap/Allmaps.v @@ -23,4 +23,4 @@ Require Export Mapcard. Require Export Mapcanon. Require Export Mapc. Require Export Maplists. -Require Export Adalloc. +Require Export Adalloc.
\ No newline at end of file diff --git a/theories/IntMap/Fset.v b/theories/IntMap/Fset.v index 3c00c21e0..8a2ab00c3 100644 --- a/theories/IntMap/Fset.v +++ b/theories/IntMap/Fset.v @@ -9,330 +9,363 @@ (*s Sets operations on maps *) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. Section Dom. - Variable A, B : Set. - - Fixpoint MapDomRestrTo [m:(Map A)] : (Map B) -> (Map A) := - Cases m of - M0 => [_:(Map B)] (M0 A) - | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of - NONE => (M0 A) - | _ => m - end - | (M2 m1 m2) => [m':(Map B)] Cases m' of - M0 => (M0 A) - | (M1 a' y') => Cases (MapGet A m a') of - NONE => (M0 A) - | (SOME y) => (M1 A a' y) - end - | (M2 m'1 m'2) => (makeM2 A (MapDomRestrTo m1 m'1) - (MapDomRestrTo m2 m'2)) - end + Variables A B : Set. + + Fixpoint MapDomRestrTo (m:Map A) : Map B -> Map A := + match m with + | M0 => fun _:Map B => M0 A + | M1 a y => + fun m':Map B => match MapGet B m' a with + | NONE => M0 A + | _ => m + end + | M2 m1 m2 => + fun m':Map B => + match m' with + | M0 => M0 A + | M1 a' y' => + match MapGet A m a' with + | NONE => M0 A + | SOME y => M1 A a' y + end + | M2 m'1 m'2 => + makeM2 A (MapDomRestrTo m1 m'1) (MapDomRestrTo m2 m'2) + end end. - Lemma MapDomRestrTo_semantics : (m:(Map A)) (m':(Map B)) - (eqm A (MapGet A (MapDomRestrTo m m')) - [a0:ad] Cases (MapGet B m' a0) of - NONE => (NONE A) - | _ => (MapGet A m a0) - end). - Proof. - Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial. - Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H. - Rewrite <- (ad_eq_complete ? ? H). Case (MapGet B m' a). Reflexivity. - Intro. Apply M1_semantics_1. - Intro H. Rewrite H. Case (MapGet B m' a). - Case (MapGet B m' a1); Reflexivity. - Case (MapGet B m' a1); Intros; Exact (M1_semantics_2 A a a1 a0 H). - Induction m'. Trivial. - Unfold MapDomRestrTo. Intros. Elim (sumbool_of_bool (ad_eq a a1)). - Intro H1. - Rewrite (ad_eq_complete ? ? H1). Rewrite (M1_semantics_1 B a1 a0). - Case (MapGet A (M2 A m0 m1) a1). Reflexivity. - Intro. Apply M1_semantics_1. - Intro H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Case (MapGet A (M2 A m0 m1) a). Reflexivity. - Intro. Exact (M1_semantics_2 A a a1 a2 H1). - Intros. Change (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a) - =(Cases (MapGet B (M2 B m2 m3) a) of - NONE => (NONE A) - | (SOME _) => (MapGet A (M2 A m0 m1) a) + Lemma MapDomRestrTo_semantics : + forall (m:Map A) (m':Map B), + eqm A (MapGet A (MapDomRestrTo m m')) + (fun a0:ad => + match MapGet B m' a0 with + | NONE => NONE A + | _ => MapGet A m a0 end). - Rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). - Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Case (ad_bit_0 a); Reflexivity. + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. + intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a a1)). intro H. rewrite H. + rewrite <- (ad_eq_complete _ _ H). case (MapGet B m' a). reflexivity. + intro. apply M1_semantics_1. + intro H. rewrite H. case (MapGet B m' a). + case (MapGet B m' a1); reflexivity. + case (MapGet B m' a1); intros; exact (M1_semantics_2 A a a1 a0 H). + simple induction m'. trivial. + unfold MapDomRestrTo in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). + intro H1. + rewrite (ad_eq_complete _ _ H1). rewrite (M1_semantics_1 B a1 a0). + case (MapGet A (M2 A m0 m1) a1). reflexivity. + intro. apply M1_semantics_1. + intro H1. rewrite (M1_semantics_2 B a a1 a0 H1). case (MapGet A (M2 A m0 m1) a). reflexivity. + intro. exact (M1_semantics_2 A a a1 a2 H1). + intros. change + (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a = + match MapGet B (M2 B m2 m3) a with + | NONE => NONE A + | SOME _ => MapGet A (M2 A m0 m1) a + end) in |- *. + rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a). + rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). + rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a). + case (ad_bit_0 a); reflexivity. Qed. - Fixpoint MapDomRestrBy [m:(Map A)] : (Map B) -> (Map A) := - Cases m of - M0 => [_:(Map B)] (M0 A) - | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of - NONE => m - | _ => (M0 A) - end - | (M2 m1 m2) => [m':(Map B)] Cases m' of - M0 => m - | (M1 a' y') => (MapRemove A m a') - | (M2 m'1 m'2) => (makeM2 A (MapDomRestrBy m1 m'1) - (MapDomRestrBy m2 m'2)) - end + Fixpoint MapDomRestrBy (m:Map A) : Map B -> Map A := + match m with + | M0 => fun _:Map B => M0 A + | M1 a y => + fun m':Map B => match MapGet B m' a with + | NONE => m + | _ => M0 A + end + | M2 m1 m2 => + fun m':Map B => + match m' with + | M0 => m + | M1 a' y' => MapRemove A m a' + | M2 m'1 m'2 => + makeM2 A (MapDomRestrBy m1 m'1) (MapDomRestrBy m2 m'2) + end end. - Lemma MapDomRestrBy_semantics : (m:(Map A)) (m':(Map B)) - (eqm A (MapGet A (MapDomRestrBy m m')) - [a0:ad] Cases (MapGet B m' a0) of - NONE => (MapGet A m a0) - | _ => (NONE A) - end). - Proof. - Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial. - Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H. - Rewrite (ad_eq_complete ? ? H). Case (MapGet B m' a1). Apply M1_semantics_1. - Trivial. - Intro H. Rewrite H. Case (MapGet B m' a). Rewrite (M1_semantics_2 A a a1 a0 H). - Case (MapGet B m' a1); Trivial. - Case (MapGet B m' a1); Trivial. - Induction m'. Trivial. - Unfold MapDomRestrBy. Intros. Rewrite (MapRemove_semantics A (M2 A m0 m1) a a1). - Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1). - Rewrite (M1_semantics_1 B a1 a0). Reflexivity. - Intro H1. Rewrite H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Reflexivity. - Intros. Change (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a) - =(Cases (MapGet B (M2 B m2 m3) a) of - NONE => (MapGet A (M2 A m0 m1) a) - | (SOME _) => (NONE A) + Lemma MapDomRestrBy_semantics : + forall (m:Map A) (m':Map B), + eqm A (MapGet A (MapDomRestrBy m m')) + (fun a0:ad => + match MapGet B m' a0 with + | NONE => MapGet A m a0 + | _ => NONE A end). - Rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). - Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Case (ad_bit_0 a); Reflexivity. + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (MapGet B m' a); trivial. + intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a a1)). intro H. rewrite H. + rewrite (ad_eq_complete _ _ H). case (MapGet B m' a1). apply M1_semantics_1. + trivial. + intro H. rewrite H. case (MapGet B m' a). rewrite (M1_semantics_2 A a a1 a0 H). + case (MapGet B m' a1); trivial. + case (MapGet B m' a1); trivial. + simple induction m'. trivial. + unfold MapDomRestrBy in |- *. intros. rewrite (MapRemove_semantics A (M2 A m0 m1) a a1). + elim (sumbool_of_bool (ad_eq a a1)). intro H1. rewrite H1. rewrite (ad_eq_complete _ _ H1). + rewrite (M1_semantics_1 B a1 a0). reflexivity. + intro H1. rewrite H1. rewrite (M1_semantics_2 B a a1 a0 H1). reflexivity. + intros. change + (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a = + match MapGet B (M2 B m2 m3) a with + | NONE => MapGet A (M2 A m0 m1) a + | SOME _ => NONE A + end) in |- *. + rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a). + rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). + rewrite (MapGet_M2_bit_0_if B m2 m3 a). rewrite (MapGet_M2_bit_0_if A m0 m1 a). + case (ad_bit_0 a); reflexivity. Qed. - Definition in_dom := [a:ad; m:(Map A)] - Cases (MapGet A m a) of - NONE => false - | _ => true + Definition in_dom (a:ad) (m:Map A) := + match MapGet A m a with + | NONE => false + | _ => true end. - Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false. + Lemma in_dom_M0 : forall a:ad, in_dom a (M0 A) = false. Proof. - Trivial. + trivial. Qed. - Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0). + Lemma in_dom_M1 : forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = ad_eq a a0. Proof. - Unfold in_dom. Intros. Simpl. Case (ad_eq a a0); Reflexivity. + unfold in_dom in |- *. intros. simpl in |- *. case (ad_eq a a0); reflexivity. Qed. - Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true. + Lemma in_dom_M1_1 : forall (a:ad) (y:A), in_dom a (M1 A a y) = true. Proof. - Intros. Rewrite in_dom_M1. Apply ad_eq_correct. + intros. rewrite in_dom_M1. apply ad_eq_correct. Qed. - Lemma in_dom_M1_2 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=true -> a=a0. + Lemma in_dom_M1_2 : + forall (a a0:ad) (y:A), in_dom a0 (M1 A a y) = true -> a = a0. Proof. - Intros. Apply (ad_eq_complete a a0). Rewrite (in_dom_M1 a a0 y) in H. Assumption. + intros. apply (ad_eq_complete a a0). rewrite (in_dom_M1 a a0 y) in H. assumption. Qed. - Lemma in_dom_some : (m:(Map A)) (a:ad) (in_dom a m)=true -> - {y:A | (MapGet A m a)=(SOME A y)}. + Lemma in_dom_some : + forall (m:Map A) (a:ad), + in_dom a m = true -> {y : A | MapGet A m a = SOME A y}. Proof. - Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Trivial. - Intro H0. Rewrite H0 in H. Discriminate H. + unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). trivial. + intro H0. rewrite H0 in H. discriminate H. Qed. - Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false -> - (MapGet A m a)=(NONE A). + Lemma in_dom_none : + forall (m:Map A) (a:ad), in_dom a m = false -> MapGet A m a = NONE A. Proof. - Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0. - Intros y H1. Rewrite H1 in H. Discriminate H. - Trivial. + unfold in_dom in |- *. intros. elim (option_sum _ (MapGet A m a)). intro H0. elim H0. + intros y H1. rewrite H1 in H. discriminate H. + trivial. Qed. - Lemma in_dom_put : (m:(Map A)) (a0:ad) (y0:A) (a:ad) - (in_dom a (MapPut A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)). + Lemma in_dom_put : + forall (m:Map A) (a0:ad) (y0:A) (a:ad), + in_dom a (MapPut A m a0 y0) = orb (ad_eq a a0) (in_dom a m). Proof. - Unfold in_dom. Intros. Rewrite (MapPut_semantics A m a0 y0 a). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. - Rewrite H. Rewrite orb_true_b. Reflexivity. - Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Rewrite orb_false_b. - Reflexivity. + unfold in_dom in |- *. intros. rewrite (MapPut_semantics A m a0 y0 a). + elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. + rewrite H. rewrite orb_true_b. reflexivity. + intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. rewrite orb_false_b. + reflexivity. Qed. - Lemma in_dom_put_behind : (m:(Map A)) (a0:ad) (y0:A) (a:ad) - (in_dom a (MapPut_behind A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)). + Lemma in_dom_put_behind : + forall (m:Map A) (a0:ad) (y0:A) (a:ad), + in_dom a (MapPut_behind A m a0 y0) = orb (ad_eq a a0) (in_dom a m). Proof. - Unfold in_dom. Intros. Rewrite (MapPut_behind_semantics A m a0 y0 a). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. - Rewrite H. Case (MapGet A m a); Reflexivity. - Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Case (MapGet A m a); Trivial. + unfold in_dom in |- *. intros. rewrite (MapPut_behind_semantics A m a0 y0 a). + elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. + rewrite H. case (MapGet A m a); reflexivity. + intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. case (MapGet A m a); trivial. Qed. - Lemma in_dom_remove : (m:(Map A)) (a0:ad) (a:ad) - (in_dom a (MapRemove A m a0))=(andb (negb (ad_eq a a0)) (in_dom a m)). + Lemma in_dom_remove : + forall (m:Map A) (a0 a:ad), + in_dom a (MapRemove A m a0) = andb (negb (ad_eq a a0)) (in_dom a m). Proof. - Unfold in_dom. Intros. Rewrite (MapRemove_semantics A m a0 a). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. - Rewrite H. Reflexivity. - Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. - Case (MapGet A m a); Reflexivity. + unfold in_dom in |- *. intros. rewrite (MapRemove_semantics A m a0 a). + elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. + rewrite H. reflexivity. + intro H. rewrite H. rewrite (ad_eq_comm a a0) in H. rewrite H. + case (MapGet A m a); reflexivity. Qed. - Lemma in_dom_merge : (m,m':(Map A)) (a:ad) - (in_dom a (MapMerge A m m'))=(orb (in_dom a m) (in_dom a m')). + Lemma in_dom_merge : + forall (m m':Map A) (a:ad), + in_dom a (MapMerge A m m') = orb (in_dom a m) (in_dom a m'). Proof. - Unfold in_dom. Intros. Rewrite (MapMerge_semantics A m m' a). - Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0. - Case (MapGet A m a); Reflexivity. - Intro H. Rewrite H. Rewrite orb_b_false. Reflexivity. + unfold in_dom in |- *. intros. rewrite (MapMerge_semantics A m m' a). + elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0. + case (MapGet A m a); reflexivity. + intro H. rewrite H. rewrite orb_b_false. reflexivity. Qed. - Lemma in_dom_delta : (m,m':(Map A)) (a:ad) - (in_dom a (MapDelta A m m'))=(xorb (in_dom a m) (in_dom a m')). + Lemma in_dom_delta : + forall (m m':Map A) (a:ad), + in_dom a (MapDelta A m m') = xorb (in_dom a m) (in_dom a m'). Proof. - Unfold in_dom. Intros. Rewrite (MapDelta_semantics A m m' a). - Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0. - Case (MapGet A m a); Reflexivity. - Intro H. Rewrite H. Case (MapGet A m a); Reflexivity. + unfold in_dom in |- *. intros. rewrite (MapDelta_semantics A m m' a). + elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y H0. rewrite H0. + case (MapGet A m a); reflexivity. + intro H. rewrite H. case (MapGet A m a); reflexivity. Qed. End Dom. Section InDom. - Variable A, B : Set. + Variables A B : Set. - Lemma in_dom_restrto : (m:(Map A)) (m':(Map B)) (a:ad) - (in_dom A a (MapDomRestrTo A B m m'))=(andb (in_dom A a m) (in_dom B a m')). + Lemma in_dom_restrto : + forall (m:Map A) (m':Map B) (a:ad), + in_dom A a (MapDomRestrTo A B m m') = + andb (in_dom A a m) (in_dom B a m'). Proof. - Unfold in_dom. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a). - Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0. - Rewrite andb_b_true. Reflexivity. - Intro H. Rewrite H. Rewrite andb_b_false. Reflexivity. + unfold in_dom in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a). + elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0. + rewrite andb_b_true. reflexivity. + intro H. rewrite H. rewrite andb_b_false. reflexivity. Qed. - Lemma in_dom_restrby : (m:(Map A)) (m':(Map B)) (a:ad) - (in_dom A a (MapDomRestrBy A B m m'))=(andb (in_dom A a m) (negb (in_dom B a m'))). + Lemma in_dom_restrby : + forall (m:Map A) (m':Map B) (a:ad), + in_dom A a (MapDomRestrBy A B m m') = + andb (in_dom A a m) (negb (in_dom B a m')). Proof. - Unfold in_dom. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a). - Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0. - Unfold negb. Rewrite andb_b_false. Reflexivity. - Intro H. Rewrite H. Unfold negb. Rewrite andb_b_true. Reflexivity. + unfold in_dom in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a). + elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y H0. rewrite H0. + unfold negb in |- *. rewrite andb_b_false. reflexivity. + intro H. rewrite H. unfold negb in |- *. rewrite andb_b_true. reflexivity. Qed. End InDom. -Definition FSet := (Map unit). +Definition FSet := Map unit. Section FSetDefs. Variable A : Set. - Definition in_FSet : ad -> FSet -> bool := (in_dom unit). + Definition in_FSet : ad -> FSet -> bool := in_dom unit. - Fixpoint MapDom [m:(Map A)] : FSet := - Cases m of - M0 => (M0 unit) - | (M1 a _) => (M1 unit a tt) - | (M2 m m') => (M2 unit (MapDom m) (MapDom m')) + Fixpoint MapDom (m:Map A) : FSet := + match m with + | M0 => M0 unit + | M1 a _ => M1 unit a tt + | M2 m m' => M2 unit (MapDom m) (MapDom m') end. - Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad) - (y:A) (MapGet A m a)=(SOME A y) -> (in_FSet a (MapDom m))=true. + Lemma MapDom_semantics_1 : + forall (m:Map A) (a:ad) (y:A), + MapGet A m a = SOME A y -> in_FSet a (MapDom m) = true. Proof. - Induction m. Intros. Discriminate H. - Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0 y0. - Case (ad_eq a a0). Trivial. - Intro. Discriminate H. - Intros m0 H m1 H0 a y. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet. - Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0 with y:=y. Assumption. - Unfold in_FSet in_dom in H. Intro. Apply H with y:=y. Assumption. + simple induction m. intros. discriminate H. + unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0 y0. + case (ad_eq a a0). trivial. + intro. discriminate H. + intros m0 H m1 H0 a y. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *. + unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). + case (ad_bit_0 a). unfold in_FSet, in_dom in H0. intro. apply H0 with (y := y). assumption. + unfold in_FSet, in_dom in H. intro. apply H with (y := y). assumption. Qed. - Lemma MapDom_semantics_2 : (m:(Map A)) (a:ad) - (in_FSet a (MapDom m))=true -> {y:A | (MapGet A m a)=(SOME A y)}. + Lemma MapDom_semantics_2 : + forall (m:Map A) (a:ad), + in_FSet a (MapDom m) = true -> {y : A | MapGet A m a = SOME A y}. Proof. - Induction m. Intros. Discriminate H. - Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0. Case (ad_eq a a0). - Intro. Split with y. Reflexivity. - Intro. Discriminate H. - Intros m0 H m1 H0 a. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet. - Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). - Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0. Assumption. - Unfold in_FSet in_dom in H. Intro. Apply H. Assumption. + simple induction m. intros. discriminate H. + unfold MapDom in |- *. unfold in_FSet in |- *. unfold in_dom in |- *. unfold MapGet in |- *. intros a y a0. case (ad_eq a a0). + intro. split with y. reflexivity. + intro. discriminate H. + intros m0 H m1 H0 a. rewrite (MapGet_M2_bit_0_if A m0 m1 a). simpl in |- *. unfold in_FSet in |- *. + unfold in_dom in |- *. rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a). + case (ad_bit_0 a). unfold in_FSet, in_dom in H0. intro. apply H0. assumption. + unfold in_FSet, in_dom in H. intro. apply H. assumption. Qed. - Lemma MapDom_semantics_3 : (m:(Map A)) (a:ad) - (MapGet A m a)=(NONE A) -> (in_FSet a (MapDom m))=false. + Lemma MapDom_semantics_3 : + forall (m:Map A) (a:ad), + MapGet A m a = NONE A -> in_FSet a (MapDom m) = false. Proof. - Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H0. - Elim (MapDom_semantics_2 m a H0). Intros y H1. Rewrite H in H1. Discriminate H1. - Trivial. + intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H0. + elim (MapDom_semantics_2 m a H0). intros y H1. rewrite H in H1. discriminate H1. + trivial. Qed. - Lemma MapDom_semantics_4 : (m:(Map A)) (a:ad) - (in_FSet a (MapDom m))=false -> (MapGet A m a)=(NONE A). + Lemma MapDom_semantics_4 : + forall (m:Map A) (a:ad), + in_FSet a (MapDom m) = false -> MapGet A m a = NONE A. Proof. - Intros. Elim (option_sum A (MapGet A m a)). Intro H0. Elim H0. Intros y H1. - Rewrite (MapDom_semantics_1 m a y H1) in H. Discriminate H. - Trivial. + intros. elim (option_sum A (MapGet A m a)). intro H0. elim H0. intros y H1. + rewrite (MapDom_semantics_1 m a y H1) in H. discriminate H. + trivial. Qed. - Lemma MapDom_Dom : (m:(Map A)) (a:ad) (in_dom A a m)=(in_FSet a (MapDom m)). + Lemma MapDom_Dom : + forall (m:Map A) (a:ad), in_dom A a m = in_FSet a (MapDom m). Proof. - Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H. - Elim (MapDom_semantics_2 m a H). Intros y H0. Rewrite H. Unfold in_dom. Rewrite H0. - Reflexivity. - Intro H. Rewrite H. Unfold in_dom. Rewrite (MapDom_semantics_4 m a H). Reflexivity. + intros. elim (sumbool_of_bool (in_FSet a (MapDom m))). intro H. + elim (MapDom_semantics_2 m a H). intros y H0. rewrite H. unfold in_dom in |- *. rewrite H0. + reflexivity. + intro H. rewrite H. unfold in_dom in |- *. rewrite (MapDom_semantics_4 m a H). reflexivity. Qed. - Definition FSetUnion : FSet -> FSet -> FSet := [s,s':FSet] (MapMerge unit s s'). + Definition FSetUnion (s s':FSet) : FSet := MapMerge unit s s'. - Lemma in_FSet_union : (s,s':FSet) (a:ad) - (in_FSet a (FSetUnion s s'))=(orb (in_FSet a s) (in_FSet a s')). + Lemma in_FSet_union : + forall (s s':FSet) (a:ad), + in_FSet a (FSetUnion s s') = orb (in_FSet a s) (in_FSet a s'). Proof. - Exact (in_dom_merge unit). + exact (in_dom_merge unit). Qed. - Definition FSetInter : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrTo unit unit s s'). + Definition FSetInter (s s':FSet) : FSet := MapDomRestrTo unit unit s s'. - Lemma in_FSet_inter : (s,s':FSet) (a:ad) - (in_FSet a (FSetInter s s'))=(andb (in_FSet a s) (in_FSet a s')). + Lemma in_FSet_inter : + forall (s s':FSet) (a:ad), + in_FSet a (FSetInter s s') = andb (in_FSet a s) (in_FSet a s'). Proof. - Exact (in_dom_restrto unit unit). + exact (in_dom_restrto unit unit). Qed. - Definition FSetDiff : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrBy unit unit s s'). + Definition FSetDiff (s s':FSet) : FSet := MapDomRestrBy unit unit s s'. - Lemma in_FSet_diff : (s,s':FSet) (a:ad) - (in_FSet a (FSetDiff s s'))=(andb (in_FSet a s) (negb (in_FSet a s'))). + Lemma in_FSet_diff : + forall (s s':FSet) (a:ad), + in_FSet a (FSetDiff s s') = andb (in_FSet a s) (negb (in_FSet a s')). Proof. - Exact (in_dom_restrby unit unit). + exact (in_dom_restrby unit unit). Qed. - Definition FSetDelta : FSet -> FSet -> FSet := [s,s':FSet] (MapDelta unit s s'). + Definition FSetDelta (s s':FSet) : FSet := MapDelta unit s s'. - Lemma in_FSet_delta : (s,s':FSet) (a:ad) - (in_FSet a (FSetDelta s s'))=(xorb (in_FSet a s) (in_FSet a s')). + Lemma in_FSet_delta : + forall (s s':FSet) (a:ad), + in_FSet a (FSetDelta s s') = xorb (in_FSet a s) (in_FSet a s'). Proof. - Exact (in_dom_delta unit). + exact (in_dom_delta unit). Qed. End FSetDefs. -Lemma FSet_Dom : (s:FSet) (MapDom unit s)=s. +Lemma FSet_Dom : forall s:FSet, MapDom unit s = s. Proof. - Induction s. Trivial. - Simpl. Intros a t. Elim t. Reflexivity. - Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. -Qed. + simple induction s. trivial. + simpl in |- *. intros a t. elim t. reflexivity. + intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Lsort.v b/theories/IntMap/Lsort.v index 80ab704de..3399eaad2 100644 --- a/theories/IntMap/Lsort.v +++ b/theories/IntMap/Lsort.v @@ -7,531 +7,622 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require PolyList. -Require Mapiter. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import List. +Require Import Mapiter. Section LSort. Variable A : Set. - Fixpoint ad_less_1 [a,a':ad; p:positive] : bool := - Cases p of - (xO p') => (ad_less_1 (ad_div_2 a) (ad_div_2 a') p') - | _ => (andb (negb (ad_bit_0 a)) (ad_bit_0 a')) + Fixpoint ad_less_1 (a a':ad) (p:positive) {struct p} : bool := + match p with + | xO p' => ad_less_1 (ad_div_2 a) (ad_div_2 a') p' + | _ => andb (negb (ad_bit_0 a)) (ad_bit_0 a') end. - Definition ad_less := [a,a':ad] Cases (ad_xor a a') of - ad_z => false - | (ad_x p) => (ad_less_1 a a' p) - end. - - Lemma ad_bit_0_less : (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> - (ad_less a a')=true. - Proof. - Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less. - Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5. - Rewrite H in H5. Rewrite H0 in H5. Discriminate H5. - Rewrite H4. Reflexivity. - Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intro H1. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H2. - Rewrite H in H2. Rewrite H0 in H2. Discriminate H2. - Rewrite H1. Reflexivity. - Qed. - - Lemma ad_bit_0_gt : (a,a':ad) (ad_bit_0 a)=true -> (ad_bit_0 a')=false -> - (ad_less a a')=false. - Proof. - Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less. - Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5. - Rewrite H in H5. Rewrite H0 in H5. Discriminate H5. - Rewrite H4. Reflexivity. - Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Intro H1. Unfold ad_less. Rewrite H1. Reflexivity. - Qed. - - Lemma ad_less_not_refl : (a:ad) (ad_less a a)=false. - Proof. - Intro. Unfold ad_less. Rewrite (ad_xor_nilpotent a). Reflexivity. - Qed. - - Lemma ad_ind_double : - (a:ad)(P:ad->Prop) (P ad_z) -> - ((a:ad) (P a) -> (P (ad_double a))) -> - ((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a). - Proof. - Intros; Elim a. Trivial. - Induction p. Intros. - Apply (H1 (ad_x p0)); Trivial. - Intros; Apply (H0 (ad_x p0)); Trivial. - Intros; Apply (H1 ad_z); Assumption. - Qed. - - Lemma ad_rec_double : - (a:ad)(P:ad->Set) (P ad_z) -> - ((a:ad) (P a) -> (P (ad_double a))) -> - ((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a). - Proof. - Intros; Elim a. Trivial. - Induction p. Intros. - Apply (H1 (ad_x p0)); Trivial. - Intros; Apply (H0 (ad_x p0)); Trivial. - Intros; Apply (H1 ad_z); Assumption. - Qed. - - Lemma ad_less_def_1 : (a,a':ad) (ad_less (ad_double a) (ad_double a'))=(ad_less a a'). - Proof. - Induction a. Induction a'. Reflexivity. - Trivial. - Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial). - Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity. - Trivial. - Qed. - - Lemma ad_less_def_2 : (a,a':ad) - (ad_less (ad_double_plus_un a) (ad_double_plus_un a'))=(ad_less a a'). - Proof. - Induction a. Induction a'. Reflexivity. - Trivial. - Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial). - Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity. - Trivial. - Qed. + Definition ad_less (a a':ad) := + match ad_xor a a' with + | ad_z => false + | ad_x p => ad_less_1 a a' p + end. - Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true. + Lemma ad_bit_0_less : + forall a a':ad, + ad_bit_0 a = false -> ad_bit_0 a' = true -> ad_less a a' = true. Proof. - Intros. Apply ad_bit_0_less. Apply ad_double_bit_0. - Apply ad_double_plus_un_bit_0. + intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *. + rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intros. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H5. + rewrite H in H5. rewrite H0 in H5. discriminate H5. + rewrite H4. reflexivity. + intro. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intro H1. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H2. + rewrite H in H2. rewrite H0 in H2. discriminate H2. + rewrite H1. reflexivity. Qed. - Lemma ad_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false. + Lemma ad_bit_0_gt : + forall a a':ad, + ad_bit_0 a = true -> ad_bit_0 a' = false -> ad_less a a' = false. Proof. - Intros. Apply ad_bit_0_gt. Apply ad_double_plus_un_bit_0. - Apply ad_double_bit_0. + intros. elim (ad_sum (ad_xor a a')). intro H1. elim H1. intros p H2. unfold ad_less in |- *. + rewrite H2. generalize H2. elim p. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intros. cut (ad_bit_0 (ad_xor a a') = false). intro. rewrite (ad_xor_bit_0 a a') in H5. + rewrite H in H5. rewrite H0 in H5. discriminate H5. + rewrite H4. reflexivity. + intro. simpl in |- *. rewrite H. rewrite H0. reflexivity. + intro H1. unfold ad_less in |- *. rewrite H1. reflexivity. Qed. - Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false. + Lemma ad_less_not_refl : forall a:ad, ad_less a a = false. Proof. - Induction a. Reflexivity. - Unfold ad_less. Intro. Rewrite (ad_xor_neutral_right (ad_x p)). (Elim p; Trivial). + intro. unfold ad_less in |- *. rewrite (ad_xor_nilpotent a). reflexivity. Qed. - Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true -> {p:positive | a=(ad_x p)}. + Lemma ad_ind_double : + forall (a:ad) (P:ad -> Prop), + P ad_z -> + (forall a:ad, P a -> P (ad_double a)) -> + (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a. Proof. - Induction a. Intro. Discriminate H. - Intros. Split with p. Reflexivity. - Qed. - - Lemma ad_z_less_2 : (a:ad) (ad_less ad_z a)=false -> a=ad_z. - Proof. - Induction a. Trivial. - Unfold ad_less. Simpl. Cut (p:positive)(ad_less_1 ad_z (ad_x p) p)=false->False. - Intros. Elim (H p H0). - Induction p. Intros. Discriminate H0. - Intros. Exact (H H0). - Intro. Discriminate H. + intros; elim a. trivial. + simple induction p. intros. + apply (H1 (ad_x p0)); trivial. + intros; apply (H0 (ad_x p0)); trivial. + intros; apply (H1 ad_z); assumption. Qed. - Lemma ad_less_trans : (a,a',a'':ad) - (ad_less a a')=true -> (ad_less a' a'')=true -> (ad_less a a'')=true. + Lemma ad_rec_double : + forall (a:ad) (P:ad -> Set), + P ad_z -> + (forall a:ad, P a -> P (ad_double a)) -> + (forall a:ad, P a -> P (ad_double_plus_un a)) -> P a. Proof. - Intro a. Apply ad_ind_double with P:=[a:ad] - (a',a'':ad) - (ad_less a a')=true - ->(ad_less a' a'')=true->(ad_less a a'')=true. - Intros. Elim (sumbool_of_bool (ad_less ad_z a'')). Trivial. - Intro H1. Rewrite (ad_z_less_2 a'' H1) in H0. Rewrite (ad_less_z a') in H0. Discriminate H0. - Intros a0 H a'. Apply ad_ind_double with P:=[a':ad] - (a'':ad) - (ad_less (ad_double a0) a')=true - ->(ad_less a' a'')=true->(ad_less (ad_double a0) a'')=true. - Intros. Rewrite (ad_less_z (ad_double a0)) in H0. Discriminate H0. - Intros a1 H0 a'' H1. Rewrite (ad_less_def_1 a0 a1) in H1. - Apply ad_ind_double with P:=[a'':ad] - (ad_less (ad_double a1) a'')=true - ->(ad_less (ad_double a0) a'')=true. - Intro. Rewrite (ad_less_z (ad_double a1)) in H2. Discriminate H2. - Intros. Rewrite (ad_less_def_1 a1 a2) in H3. Rewrite (ad_less_def_1 a0 a2). - Exact (H a1 a2 H1 H3). - Intros. Apply ad_less_def_3. - Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad] - (ad_less (ad_double_plus_un a1) a'')=true - ->(ad_less (ad_double a0) a'')=true. - Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2. - Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3. - Intros. Apply ad_less_def_3. - Intros a0 H a'. Apply ad_ind_double with P:=[a':ad] - (a'':ad) - (ad_less (ad_double_plus_un a0) a')=true - ->(ad_less a' a'')=true - ->(ad_less (ad_double_plus_un a0) a'')=true. - Intros. Rewrite (ad_less_z (ad_double_plus_un a0)) in H0. Discriminate H0. - Intros. Rewrite (ad_less_def_4 a0 a1) in H1. Discriminate H1. - Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad] - (ad_less (ad_double_plus_un a1) a'')=true - ->(ad_less (ad_double_plus_un a0) a'')=true. - Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2. - Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3. - Rewrite (ad_less_def_2 a0 a1) in H1. Intros. Rewrite (ad_less_def_2 a1 a2) in H3. - Rewrite (ad_less_def_2 a0 a2). Exact (H a1 a2 H1 H3). - Qed. - - Fixpoint alist_sorted [l:(alist A)] : bool := - Cases l of - nil => true - | (cons (a, _) l') => Cases l' of - nil => true - | (cons (a', y') l'') => (andb (ad_less a a') - (alist_sorted l')) - end + intros; elim a. trivial. + simple induction p. intros. + apply (H1 (ad_x p0)); trivial. + intros; apply (H0 (ad_x p0)); trivial. + intros; apply (H1 ad_z); assumption. + Qed. + + Lemma ad_less_def_1 : + forall a a':ad, ad_less (ad_double a) (ad_double a') = ad_less a a'. + Proof. + simple induction a. simple induction a'. reflexivity. + trivial. + simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial. + unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity. + trivial. + Qed. + + Lemma ad_less_def_2 : + forall a a':ad, + ad_less (ad_double_plus_un a) (ad_double_plus_un a') = ad_less a a'. + Proof. + simple induction a. simple induction a'. reflexivity. + trivial. + simple induction a'. unfold ad_less in |- *. simpl in |- *. elim p; trivial. + unfold ad_less in |- *. simpl in |- *. intro. case (p_xor p p0). reflexivity. + trivial. + Qed. + + Lemma ad_less_def_3 : + forall a a':ad, ad_less (ad_double a) (ad_double_plus_un a') = true. + Proof. + intros. apply ad_bit_0_less. apply ad_double_bit_0. + apply ad_double_plus_un_bit_0. + Qed. + + Lemma ad_less_def_4 : + forall a a':ad, ad_less (ad_double_plus_un a) (ad_double a') = false. + Proof. + intros. apply ad_bit_0_gt. apply ad_double_plus_un_bit_0. + apply ad_double_bit_0. + Qed. + + Lemma ad_less_z : forall a:ad, ad_less a ad_z = false. + Proof. + simple induction a. reflexivity. + unfold ad_less in |- *. intro. rewrite (ad_xor_neutral_right (ad_x p)). elim p; trivial. + Qed. + + Lemma ad_z_less_1 : + forall a:ad, ad_less ad_z a = true -> {p : positive | a = ad_x p}. + Proof. + simple induction a. intro. discriminate H. + intros. split with p. reflexivity. + Qed. + + Lemma ad_z_less_2 : forall a:ad, ad_less ad_z a = false -> a = ad_z. + Proof. + simple induction a. trivial. + unfold ad_less in |- *. simpl in |- *. cut (forall p:positive, ad_less_1 ad_z (ad_x p) p = false -> False). + intros. elim (H p H0). + simple induction p. intros. discriminate H0. + intros. exact (H H0). + intro. discriminate H. + Qed. + + Lemma ad_less_trans : + forall a a' a'':ad, + ad_less a a' = true -> ad_less a' a'' = true -> ad_less a a'' = true. + Proof. + intro a. apply ad_ind_double with + (P := fun a:ad => + forall a' a'':ad, + ad_less a a' = true -> + ad_less a' a'' = true -> ad_less a a'' = true). + intros. elim (sumbool_of_bool (ad_less ad_z a'')). trivial. + intro H1. rewrite (ad_z_less_2 a'' H1) in H0. rewrite (ad_less_z a') in H0. discriminate H0. + intros a0 H a'. apply ad_ind_double with + (P := fun a':ad => + forall a'':ad, + ad_less (ad_double a0) a' = true -> + ad_less a' a'' = true -> ad_less (ad_double a0) a'' = true). + intros. rewrite (ad_less_z (ad_double a0)) in H0. discriminate H0. + intros a1 H0 a'' H1. rewrite (ad_less_def_1 a0 a1) in H1. + apply ad_ind_double with + (P := fun a'':ad => + ad_less (ad_double a1) a'' = true -> + ad_less (ad_double a0) a'' = true). + intro. rewrite (ad_less_z (ad_double a1)) in H2. discriminate H2. + intros. rewrite (ad_less_def_1 a1 a2) in H3. rewrite (ad_less_def_1 a0 a2). + exact (H a1 a2 H1 H3). + intros. apply ad_less_def_3. + intros a1 H0 a'' H1. apply ad_ind_double with + (P := fun a'':ad => + ad_less (ad_double_plus_un a1) a'' = true -> + ad_less (ad_double a0) a'' = true). + intro. rewrite (ad_less_z (ad_double_plus_un a1)) in H2. discriminate H2. + intros. rewrite (ad_less_def_4 a1 a2) in H3. discriminate H3. + intros. apply ad_less_def_3. + intros a0 H a'. apply ad_ind_double with + (P := fun a':ad => + forall a'':ad, + ad_less (ad_double_plus_un a0) a' = true -> + ad_less a' a'' = true -> + ad_less (ad_double_plus_un a0) a'' = true). + intros. rewrite (ad_less_z (ad_double_plus_un a0)) in H0. discriminate H0. + intros. rewrite (ad_less_def_4 a0 a1) in H1. discriminate H1. + intros a1 H0 a'' H1. apply ad_ind_double with + (P := fun a'':ad => + ad_less (ad_double_plus_un a1) a'' = true -> + ad_less (ad_double_plus_un a0) a'' = true). + intro. rewrite (ad_less_z (ad_double_plus_un a1)) in H2. discriminate H2. + intros. rewrite (ad_less_def_4 a1 a2) in H3. discriminate H3. + rewrite (ad_less_def_2 a0 a1) in H1. intros. rewrite (ad_less_def_2 a1 a2) in H3. + rewrite (ad_less_def_2 a0 a2). exact (H a1 a2 H1 H3). + Qed. + + Fixpoint alist_sorted (l:alist A) : bool := + match l with + | nil => true + | (a, _) :: l' => + match l' with + | nil => true + | (a', y') :: l'' => andb (ad_less a a') (alist_sorted l') + end end. - Fixpoint alist_nth_ad [n:nat; l:(alist A)] : ad := - Cases l of - nil => ad_z (* dummy *) - | (cons (a, y) l') => Cases n of - O => a - | (S n') => (alist_nth_ad n' l') - end + Fixpoint alist_nth_ad (n:nat) (l:alist A) {struct l} : ad := + match l with + | nil => ad_z (* dummy *) + | (a, y) :: l' => match n with + | O => a + | S n' => alist_nth_ad n' l' + end end. - Definition alist_sorted_1 := [l:(alist A)] - (n:nat) (le (S (S n)) (length l)) -> - (ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l))=true. - - Lemma alist_sorted_imp_1 : (l:(alist A)) (alist_sorted l)=true -> (alist_sorted_1 l). - Proof. - Unfold alist_sorted_1. Induction l. Intros. Elim (le_Sn_O (S n) H0). - Intro r. Elim r. Intros a y. Induction l0. Intros. Simpl in H1. - Elim (le_Sn_O n (le_S_n (S n) O H1)). - Intro r0. Elim r0. Intros a0 y0. Induction n. Intros. Simpl. Simpl in H1. - Exact (proj1 ? ? (andb_prop ? ? H1)). - Intros. Change (ad_less (alist_nth_ad n0 (cons (a0,y0) l1)) - (alist_nth_ad (S n0) (cons (a0,y0) l1)))=true. - Apply H0. Exact (proj2 ? ? (andb_prop ? ? H1)). - Apply le_S_n. Exact H3. - Qed. - - Definition alist_sorted_2 := [l:(alist A)] - (m,n:nat) (lt m n) -> (le (S n) (length l)) -> - (ad_less (alist_nth_ad m l) (alist_nth_ad n l))=true. - - Lemma alist_sorted_1_imp_2 : (l:(alist A)) (alist_sorted_1 l) -> (alist_sorted_2 l). - Proof. - Unfold alist_sorted_1 alist_sorted_2 lt. Intros l H m n H0. Elim H0. Exact (H m). - Intros. Apply ad_less_trans with a':=(alist_nth_ad m0 l). Apply H2. Apply le_trans_S. - Assumption. - Apply H. Assumption. - Qed. - - Lemma alist_sorted_2_imp : (l:(alist A)) (alist_sorted_2 l) -> (alist_sorted l)=true. - Proof. - Unfold alist_sorted_2 lt. Induction l. Trivial. - Intro r. Elim r. Intros a y. Induction l0. Trivial. - Intro r0. Elim r0. Intros a0 y0. Intros. - Change (andb (ad_less a a0) (alist_sorted (cons (a0,y0) l1)))=true. - Apply andb_true_intro. Split. Apply (H1 (0) (1)). Apply le_n. - Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n. - Apply H0. Intros. Apply (H1 (S m) (S n)). Apply le_n_S. Assumption. - Exact (le_n_S ? ? H3). - Qed. + Definition alist_sorted_1 (l:alist A) := + forall n:nat, + S (S n) <= length l -> + ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l) = true. - Lemma app_length : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')). + Lemma alist_sorted_imp_1 : + forall l:alist A, alist_sorted l = true -> alist_sorted_1 l. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l'). Reflexivity. - Qed. - - Lemma aapp_length : (l,l':(alist A)) (length (aapp A l l'))=(plus (length l) (length l')). + unfold alist_sorted_1 in |- *. simple induction l. intros. elim (le_Sn_O (S n) H0). + intro r. elim r. intros a y. simple induction l0. intros. simpl in H1. + elim (le_Sn_O n (le_S_n (S n) 0 H1)). + intro r0. elim r0. intros a0 y0. simple induction n. intros. simpl in |- *. simpl in H1. + exact (proj1 (andb_prop _ _ H1)). + intros. change + (ad_less (alist_nth_ad n0 ((a0, y0) :: l1)) + (alist_nth_ad (S n0) ((a0, y0) :: l1)) = true) + in |- *. + apply H0. exact (proj2 (andb_prop _ _ H1)). + apply le_S_n. exact H3. + Qed. + + Definition alist_sorted_2 (l:alist A) := + forall m n:nat, + m < n -> + S n <= length l -> ad_less (alist_nth_ad m l) (alist_nth_ad n l) = true. + + Lemma alist_sorted_1_imp_2 : + forall l:alist A, alist_sorted_1 l -> alist_sorted_2 l. + Proof. + unfold alist_sorted_1, alist_sorted_2, lt in |- *. intros l H m n H0. elim H0. exact (H m). + intros. apply ad_less_trans with (a' := alist_nth_ad m0 l). apply H2. apply le_Sn_le. + assumption. + apply H. assumption. + Qed. + + Lemma alist_sorted_2_imp : + forall l:alist A, alist_sorted_2 l -> alist_sorted l = true. + Proof. + unfold alist_sorted_2, lt in |- *. simple induction l. trivial. + intro r. elim r. intros a y. simple induction l0. trivial. + intro r0. elim r0. intros a0 y0. intros. + change (andb (ad_less a a0) (alist_sorted ((a0, y0) :: l1)) = true) + in |- *. + apply andb_true_intro. split. apply (H1 0 1). apply le_n. + simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. + apply H0. intros. apply (H1 (S m) (S n)). apply le_n_S. assumption. + exact (le_n_S _ _ H3). + Qed. + + Lemma app_length : + forall (C:Set) (l l':list C), length (l ++ l') = length l + length l'. + Proof. + simple induction l. trivial. + intros. simpl in |- *. rewrite (H l'). reflexivity. + Qed. + + Lemma aapp_length : + forall l l':alist A, length (aapp A l l') = length l + length l'. Proof. - Exact (app_length ad*A). + exact (app_length (ad * A)). Qed. - Lemma alist_nth_ad_aapp_1 : (l,l':(alist A)) (n:nat) - (le (S n) (length l)) -> (alist_nth_ad n (aapp A l l'))=(alist_nth_ad n l). + Lemma alist_nth_ad_aapp_1 : + forall (l l':alist A) (n:nat), + S n <= length l -> alist_nth_ad n (aapp A l l') = alist_nth_ad n l. Proof. - Induction l. Intros. Elim (le_Sn_O n H). - Intro r. Elim r. Intros a y l' H l''. Induction n. Trivial. - Intros. Simpl. Apply H. Apply le_S_n. Exact H1. + simple induction l. intros. elim (le_Sn_O n H). + intro r. elim r. intros a y l' H l''. simple induction n. trivial. + intros. simpl in |- *. apply H. apply le_S_n. exact H1. Qed. - Lemma alist_nth_ad_aapp_2 : (l,l':(alist A)) (n:nat) - (le (S n) (length l')) -> - (alist_nth_ad (plus (length l) n) (aapp A l l'))=(alist_nth_ad n l'). + Lemma alist_nth_ad_aapp_2 : + forall (l l':alist A) (n:nat), + S n <= length l' -> + alist_nth_ad (length l + n) (aapp A l l') = alist_nth_ad n l'. Proof. - Induction l. Trivial. - Intro r. Elim r. Intros a y l' H l'' n H0. Simpl. Apply H. Exact H0. + simple induction l. trivial. + intro r. elim r. intros a y l' H l'' n H0. simpl in |- *. apply H. exact H0. Qed. - Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) -> - {n' : nat | (le (S n') q) /\ n=(plus p n')}+{(le (S n) p)}. + Lemma interval_split : + forall p q n:nat, + S n <= p + q -> {n' : nat | S n' <= q /\ n = p + n'} + {S n <= p}. Proof. - Induction p. Simpl. Intros. Left . Split with n. (Split; [ Assumption | Reflexivity ]). - Intros p' H q. Induction n. Intros. Right . Apply le_n_S. Apply le_O_n. - Intros. Elim (H ? ? (le_S_n ? ? H1)). Intro H2. Left . Elim H2. Intros n' H3. - Elim H3. Intros H4 H5. Split with n'. (Split; [ Assumption | Rewrite H5; Reflexivity ]). - Intro H2. Right . Apply le_n_S. Assumption. + simple induction p. simpl in |- *. intros. left. split with n. split; [ assumption | reflexivity ]. + intros p' H q. simple induction n. intros. right. apply le_n_S. apply le_O_n. + intros. elim (H _ _ (le_S_n _ _ H1)). intro H2. left. elim H2. intros n' H3. + elim H3. intros H4 H5. split with n'. split; [ assumption | rewrite H5; reflexivity ]. + intro H2. right. apply le_n_S. assumption. Qed. - Lemma alist_conc_sorted : (l,l':(alist A)) (alist_sorted_2 l) -> (alist_sorted_2 l') -> - ((n,n':nat) (le (S n) (length l)) -> (le (S n') (length l')) -> - (ad_less (alist_nth_ad n l) (alist_nth_ad n' l'))=true) -> - (alist_sorted_2 (aapp A l l')). + Lemma alist_conc_sorted : + forall l l':alist A, + alist_sorted_2 l -> + alist_sorted_2 l' -> + (forall n n':nat, + S n <= length l -> + S n' <= length l' -> + ad_less (alist_nth_ad n l) (alist_nth_ad n' l') = true) -> + alist_sorted_2 (aapp A l l'). Proof. - Unfold alist_sorted_2 lt. Intros. Rewrite (aapp_length l l') in H3. - Elim (interval_split (length l) (length l') m - (le_trans ? ? ? (le_n_S ? ? (lt_le_weak m n H2)) H3)). - Intro H4. Elim H4. Intros m' H5. Elim H5. Intros. Rewrite H7. - Rewrite (alist_nth_ad_aapp_2 l l' m' H6). Elim (interval_split (length l) (length l') n H3). - Intro H8. Elim H8. Intros n' H9. Elim H9. Intros. Rewrite H11. - Rewrite (alist_nth_ad_aapp_2 l l' n' H10). Apply H0. Rewrite H7 in H2. Rewrite H11 in H2. - Change (le (plus (S (length l)) m') (plus (length l) n')) in H2. - Rewrite (plus_Snm_nSm (length l) m') in H2. Exact (simpl_le_plus_l (length l) (S m') n' H2). - Exact H10. - Intro H8. Rewrite H7 in H2. Cut (le (S (length l)) (length l)). Intros. Elim (le_Sn_n ? H9). - Apply le_trans with m:=(S n). Apply le_n_S. Apply le_trans with m:=(S (plus (length l) m')). - Apply le_trans with m:=(plus (length l) m'). Apply le_plus_l. - Apply le_n_Sn. - Exact H2. - Exact H8. - Intro H4. Rewrite (alist_nth_ad_aapp_1 l l' m H4). - Elim (interval_split (length l) (length l') n H3). Intro H5. Elim H5. Intros n' H6. Elim H6. - Intros. Rewrite H8. Rewrite (alist_nth_ad_aapp_2 l l' n' H7). Exact (H1 m n' H4 H7). - Intro H5. Rewrite (alist_nth_ad_aapp_1 l l' n H5). Exact (H m n H2 H5). + unfold alist_sorted_2, lt in |- *. intros. rewrite (aapp_length l l') in H3. + elim + (interval_split (length l) (length l') m + (le_trans _ _ _ (le_n_S _ _ (lt_le_weak m n H2)) H3)). + intro H4. elim H4. intros m' H5. elim H5. intros. rewrite H7. + rewrite (alist_nth_ad_aapp_2 l l' m' H6). elim (interval_split (length l) (length l') n H3). + intro H8. elim H8. intros n' H9. elim H9. intros. rewrite H11. + rewrite (alist_nth_ad_aapp_2 l l' n' H10). apply H0. rewrite H7 in H2. rewrite H11 in H2. + change (S (length l) + m' <= length l + n') in H2. + rewrite (plus_Snm_nSm (length l) m') in H2. exact ((fun p n m:nat => plus_le_reg_l n m p) (length l) (S m') n' H2). + exact H10. + intro H8. rewrite H7 in H2. cut (S (length l) <= length l). intros. elim (le_Sn_n _ H9). + apply le_trans with (m := S n). apply le_n_S. apply le_trans with (m := S (length l + m')). + apply le_trans with (m := length l + m'). apply le_plus_l. + apply le_n_Sn. + exact H2. + exact H8. + intro H4. rewrite (alist_nth_ad_aapp_1 l l' m H4). + elim (interval_split (length l) (length l') n H3). intro H5. elim H5. intros n' H6. elim H6. + intros. rewrite H8. rewrite (alist_nth_ad_aapp_2 l l' n' H7). exact (H1 m n' H4 H7). + intro H5. rewrite (alist_nth_ad_aapp_1 l l' n H5). exact (H m n H2 H5). Qed. - Lemma alist_nth_ad_semantics : (l:(alist A)) (n:nat) (le (S n) (length l)) -> - {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}. + Lemma alist_nth_ad_semantics : + forall (l:alist A) (n:nat), + S n <= length l -> + {y : A | alist_semantics A l (alist_nth_ad n l) = SOME A y}. Proof. - Induction l. Intros. Elim (le_Sn_O ? H). - Intro r. Elim r. Intros a y l0 H. Induction n. Simpl. Intro. Split with y. - Rewrite (ad_eq_correct a). Reflexivity. - Intros. Elim (H ? (le_S_n ? ? H1)). Intros y0 H2. - Elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). Intro H3. Split with y. - Rewrite (ad_eq_complete ? ? H3). Simpl. Rewrite (ad_eq_correct (alist_nth_ad n0 l0)). - Reflexivity. - Intro H3. Split with y0. Simpl. Rewrite H3. Assumption. + simple induction l. intros. elim (le_Sn_O _ H). + intro r. elim r. intros a y l0 H. simple induction n. simpl in |- *. intro. split with y. + rewrite (ad_eq_correct a). reflexivity. + intros. elim (H _ (le_S_n _ _ H1)). intros y0 H2. + elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). intro H3. split with y. + rewrite (ad_eq_complete _ _ H3). simpl in |- *. rewrite (ad_eq_correct (alist_nth_ad n0 l0)). + reflexivity. + intro H3. split with y0. simpl in |- *. rewrite H3. assumption. Qed. - Lemma alist_of_Map_nth_ad : (m:(Map A)) (pf:ad->ad) - (l:(alist A)) l=(MapFold1 A (alist A) (anil A) (aapp A) - [a0:ad][y:A](acons A (a0,y) (anil A)) pf m) -> - (n:nat) (le (S n) (length l)) -> {a':ad | (alist_nth_ad n l)=(pf a')}. + Lemma alist_of_Map_nth_ad : + forall (m:Map A) (pf:ad -> ad) (l:alist A), + l = + MapFold1 A (alist A) (anil A) (aapp A) + (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) pf m -> + forall n:nat, S n <= length l -> {a' : ad | alist_nth_ad n l = pf a'}. Proof. - Intros. Elim (alist_nth_ad_semantics l n H0). Intros y H1. - Apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y). - Rewrite <- H. Assumption. + intros. elim (alist_nth_ad_semantics l n H0). intros y H1. + apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y). + rewrite <- H. assumption. Qed. - Definition ad_monotonic := [pf:ad->ad] (a,a':ad) - (ad_less a a')=true -> (ad_less (pf a) (pf a'))=true. + Definition ad_monotonic (pf:ad -> ad) := + forall a a':ad, ad_less a a' = true -> ad_less (pf a) (pf a') = true. - Lemma ad_double_monotonic : (ad_monotonic ad_double). + Lemma ad_double_monotonic : ad_monotonic ad_double. Proof. - Unfold ad_monotonic. Intros. Rewrite ad_less_def_1. Assumption. + unfold ad_monotonic in |- *. intros. rewrite ad_less_def_1. assumption. Qed. - Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un). + Lemma ad_double_plus_un_monotonic : ad_monotonic ad_double_plus_un. Proof. - Unfold ad_monotonic. Intros. Rewrite ad_less_def_2. Assumption. + unfold ad_monotonic in |- *. intros. rewrite ad_less_def_2. assumption. Qed. - Lemma ad_comp_monotonic : (pf,pf':ad->ad) (ad_monotonic pf) -> (ad_monotonic pf') -> - (ad_monotonic [a0:ad] (pf (pf' a0))). + Lemma ad_comp_monotonic : + forall pf pf':ad -> ad, + ad_monotonic pf -> + ad_monotonic pf' -> ad_monotonic (fun a0:ad => pf (pf' a0)). Proof. - Unfold ad_monotonic. Intros. Apply H. Apply H0. Exact H1. + unfold ad_monotonic in |- *. intros. apply H. apply H0. exact H1. Qed. - Lemma ad_comp_double_monotonic : (pf:ad->ad) (ad_monotonic pf) -> - (ad_monotonic [a0:ad] (pf (ad_double a0))). + Lemma ad_comp_double_monotonic : + forall pf:ad -> ad, + ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double a0)). Proof. - Intros. Apply ad_comp_monotonic. Assumption. - Exact ad_double_monotonic. + intros. apply ad_comp_monotonic. assumption. + exact ad_double_monotonic. Qed. - Lemma ad_comp_double_plus_un_monotonic : (pf:ad->ad) (ad_monotonic pf) -> - (ad_monotonic [a0:ad] (pf (ad_double_plus_un a0))). + Lemma ad_comp_double_plus_un_monotonic : + forall pf:ad -> ad, + ad_monotonic pf -> ad_monotonic (fun a0:ad => pf (ad_double_plus_un a0)). Proof. - Intros. Apply ad_comp_monotonic. Assumption. - Exact ad_double_plus_un_monotonic. + intros. apply ad_comp_monotonic. assumption. + exact ad_double_plus_un_monotonic. Qed. - Lemma alist_of_Map_sorts_1 : (m:(Map A)) (pf:ad->ad) (ad_monotonic pf) -> - (alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A) - [a:ad][y:A](acons A (a,y) (anil A)) pf m)). - Proof. - Induction m. Simpl. Intros. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity. - Intros. Simpl. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity. - Intros. Simpl. Apply alist_conc_sorted. - Exact (H [a0:ad](pf (ad_double a0)) (ad_comp_double_monotonic pf H1)). - Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_comp_double_plus_un_monotonic pf H1)). - Intros. Elim (alist_of_Map_nth_ad m0 [a0:ad](pf (ad_double a0)) - (MapFold1 A (alist A) (anil A) (aapp A) - [a0:ad][y:A](acons A (a0,y) (anil A)) - [a0:ad](pf (ad_double a0)) m0) (refl_equal ? ?) n H2). - Intros a H4. Rewrite H4. Elim (alist_of_Map_nth_ad m1 [a0:ad](pf (ad_double_plus_un a0)) + Lemma alist_of_Map_sorts_1 : + forall (m:Map A) (pf:ad -> ad), + ad_monotonic pf -> + alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A) - [a0:ad][y:A](acons A (a0,y) (anil A)) - [a0:ad](pf (ad_double_plus_un a0)) m1) (refl_equal ? ?) n' H3). - Intros a' H5. Rewrite H5. Unfold ad_monotonic in H1. Apply H1. Apply ad_less_def_3. - Qed. - - Lemma alist_of_Map_sorts : (m:(Map A)) (alist_sorted (alist_of_Map A m))=true. - Proof. - Intro. Apply alist_sorted_2_imp. - Exact (alist_of_Map_sorts_1 m [a0:ad]a0 [a,a':ad][p:(ad_less a a')=true]p). - Qed. - - Lemma alist_of_Map_sorts1 : (m:(Map A)) (alist_sorted_1 (alist_of_Map A m)). - Proof. - Intro. Apply alist_sorted_imp_1. Apply alist_of_Map_sorts. + (fun (a:ad) (y:A) => acons A (a, y) (anil A)) pf m). + Proof. + simple induction m. simpl in |- *. intros. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. + intros. simpl in |- *. apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. reflexivity. + intros. simpl in |- *. apply alist_conc_sorted. + exact + (H (fun a0:ad => pf (ad_double a0)) (ad_comp_double_monotonic pf H1)). + exact + (H0 (fun a0:ad => pf (ad_double_plus_un a0)) + (ad_comp_double_plus_un_monotonic pf H1)). + intros. elim + (alist_of_Map_nth_ad m0 (fun a0:ad => pf (ad_double a0)) + (MapFold1 A (alist A) (anil A) (aapp A) + (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) + (fun a0:ad => pf (ad_double a0)) m0) (refl_equal _) n H2). + intros a H4. rewrite H4. elim + (alist_of_Map_nth_ad m1 (fun a0:ad => pf (ad_double_plus_un a0)) + (MapFold1 A (alist A) (anil A) (aapp A) + (fun (a0:ad) (y:A) => acons A (a0, y) (anil A)) + (fun a0:ad => pf (ad_double_plus_un a0)) m1) ( + refl_equal _) n' H3). + intros a' H5. rewrite H5. unfold ad_monotonic in H1. apply H1. apply ad_less_def_3. + Qed. + + Lemma alist_of_Map_sorts : + forall m:Map A, alist_sorted (alist_of_Map A m) = true. + Proof. + intro. apply alist_sorted_2_imp. + exact + (alist_of_Map_sorts_1 m (fun a0:ad => a0) + (fun (a a':ad) (p:ad_less a a' = true) => p)). + Qed. + + Lemma alist_of_Map_sorts1 : + forall m:Map A, alist_sorted_1 (alist_of_Map A m). + Proof. + intro. apply alist_sorted_imp_1. apply alist_of_Map_sorts. Qed. - Lemma alist_of_Map_sorts2 : (m:(Map A)) (alist_sorted_2 (alist_of_Map A m)). + Lemma alist_of_Map_sorts2 : + forall m:Map A, alist_sorted_2 (alist_of_Map A m). Proof. - Intro. Apply alist_sorted_1_imp_2. Apply alist_of_Map_sorts1. + intro. apply alist_sorted_1_imp_2. apply alist_of_Map_sorts1. Qed. - Lemma ad_less_total : (a,a':ad) {(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}. - Proof. - Intro a. Refine (ad_rec_double a [a:ad] (a':ad){(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'} - ? ? ?). - Intro. Elim (sumbool_of_bool (ad_less ad_z a')). Intro H. Left . Left . Assumption. - Intro H. Right . Rewrite (ad_z_less_2 a' H). Reflexivity. - Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double a0) a')=true} - +{(ad_less a' (ad_double a0))=true}+{(ad_double a0)=a'} ? ? ?). - Elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). Intro H0. Left . Right . Assumption. - Intro H0. Right . Exact (ad_z_less_2 ? H0). - Intros a1 H0. Rewrite ad_less_def_1. Rewrite ad_less_def_1. Elim (H a1). Intro H1. - Left . Assumption. - Intro H1. Right . Rewrite H1. Reflexivity. - Intros a1 H0. Left . Left . Apply ad_less_def_3. - Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double_plus_un a0) a')=true} - +{(ad_less a' (ad_double_plus_un a0))=true} - +{(ad_double_plus_un a0)=a'} ? ? ?). - Left . Right . (Case a0; Reflexivity). - Intros a1 H0. Left . Right . Apply ad_less_def_3. - Intros a1 H0. Rewrite ad_less_def_2. Rewrite ad_less_def_2. Elim (H a1). Intro H1. - Left . Assumption. - Intro H1. Right . Rewrite H1. Reflexivity. - Qed. - - Lemma alist_too_low : (l:(alist A)) (a,a':ad) (y:A) - (ad_less a a')=true -> (alist_sorted_2 (cons (a',y) l)) -> - (alist_semantics A (cons (a',y) l) a)=(NONE A). - Proof. - Induction l. Intros. Simpl. Elim (sumbool_of_bool (ad_eq a' a)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_less_not_refl a) in H. Discriminate H. - Intro H1. Rewrite H1. Reflexivity. - Intro r. Elim r. Intros a y l0 H a0 a1 y0 H0 H1. - Change (Case (ad_eq a1 a0) of - (SOME A y0) - (alist_semantics A (cons (a,y) l0) a0) - end)=(NONE A). - Elim (sumbool_of_bool (ad_eq a1 a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0. - Rewrite (ad_less_not_refl a0) in H0. Discriminate H0. - Intro H2. Rewrite H2. Apply H. Apply ad_less_trans with a':=a1. Assumption. - Unfold alist_sorted_2 in H1. Apply (H1 (0) (1)). Apply lt_n_Sn. - Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n. - Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. - Cut (alist_sorted (cons (a1,y0) (cons (a,y) l0)))=true. Intro H3. - Exact (proj2 ? ? (andb_prop ? ? H3)). - Apply alist_sorted_2_imp. Assumption. - Qed. - - Lemma alist_semantics_nth_ad : (l:(alist A)) (a:ad) (y:A) - (alist_semantics A l a)=(SOME A y) -> - {n:nat | (le (S n) (length l)) /\ (alist_nth_ad n l)=a}. - Proof. - Induction l. Intros. Discriminate H. - Intro r. Elim r. Intros a y l0 H a0 y0 H0. Simpl in H0. Elim (sumbool_of_bool (ad_eq a a0)). - Intro H1. Rewrite H1 in H0. Split with O. Split. Simpl. Apply le_n_S. Apply le_O_n. - Simpl. Exact (ad_eq_complete ? ? H1). - Intro H1. Rewrite H1 in H0. Elim (H a0 y0 H0). Intros n' H2. Split with (S n'). Split. - Simpl. Apply le_n_S. Exact (proj1 ? ? H2). - Exact (proj2 ? ? H2). - Qed. - - Lemma alist_semantics_tail : (l:(alist A)) (a:ad) (y:A) - (alist_sorted_2 (cons (a,y) l)) -> - (eqm A (alist_semantics A l) [a0:ad] if (ad_eq a a0) - then (NONE A) - else (alist_semantics A (cons (a,y) l) a0)). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. - Rewrite <- (ad_eq_complete ? ? H0). Unfold alist_sorted_2 in H. - Elim (option_sum A (alist_semantics A l a)). Intro H1. Elim H1. Intros y0 H2. - Elim (alist_semantics_nth_ad l a y0 H2). Intros n H3. Elim H3. Intros. - Cut (ad_less (alist_nth_ad (0) (cons (a,y) l)) (alist_nth_ad (S n) (cons (a,y) l)))=true. - Intro. Simpl in H6. Rewrite H5 in H6. Rewrite (ad_less_not_refl a) in H6. Discriminate H6. - Apply H. Apply lt_O_Sn. - Simpl. Apply le_n_S. Assumption. - Trivial. - Intro H0. Simpl. Rewrite H0. Reflexivity. - Qed. - - Lemma alist_semantics_same_tail : (l,l':(alist A)) (a:ad) (y:A) - (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 (cons (a,y) l')) -> - (eqm A (alist_semantics A (cons (a,y) l)) (alist_semantics A (cons (a,y) l'))) -> - (eqm A (alist_semantics A l) (alist_semantics A l')). - Proof. - Unfold eqm. Intros. Rewrite (alist_semantics_tail ? ? ? H a0). - Rewrite (alist_semantics_tail ? ? ? H0 a0). Case (ad_eq a a0). Reflexivity. - Exact (H1 a0). - Qed. - - Lemma alist_sorted_tail : (l:(alist A)) (a:ad) (y:A) - (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 l). - Proof. - Unfold alist_sorted_2. Intros. Apply (H (S m) (S n)). Apply lt_n_S. Assumption. - Simpl. Apply le_n_S. Assumption. - Qed. - - Lemma alist_canonical : (l,l':(alist A)) - (eqm A (alist_semantics A l) (alist_semantics A l')) -> - (alist_sorted_2 l) -> (alist_sorted_2 l') -> l=l'. - Proof. - Unfold eqm. Induction l. Induction l'. Trivial. - Intro r. Elim r. Intros a y l0 H H0 H1 H2. Simpl in H0. - Cut (NONE A)=(Case (ad_eq a a) of (SOME A y) - (alist_semantics A l0 a) - end). - Rewrite (ad_eq_correct a). Intro. Discriminate H3. - Exact (H0 a). - Intro r. Elim r. Intros a y l0 H. Induction l'. Intros. Simpl in H0. - Cut (Case (ad_eq a a) of (SOME A y) - (alist_semantics A l0 a) - end)=(NONE A). - Rewrite (ad_eq_correct a). Intro. Discriminate H3. - Exact (H0 a). - Intro r'. Elim r'. Intros a' y' l'0 H0 H1 H2 H3. Elim (ad_less_total a a'). Intro H4. - Elim H4. Intro H5. - Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a). - Intro. Rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. Simpl in H6. - Rewrite (ad_eq_correct a) in H6. Discriminate H6. - Exact (H1 a). - Intro H5. Cut (alist_semantics A (cons (a,y) l0) a')=(alist_semantics A (cons (a',y') l'0) a'). - Intro. Rewrite (alist_too_low l0 a' a y H5 H2) in H6. Simpl in H6. - Rewrite (ad_eq_correct a') in H6. Discriminate H6. - Exact (H1 a'). - Intro H4. Rewrite H4. - Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a). - Intro. Simpl in H5. Rewrite H4 in H5. Rewrite (ad_eq_correct a') in H5. Inversion H5. - Rewrite H4 in H1. Rewrite H7 in H1. Cut l0=l'0. Intro. Rewrite H6. Reflexivity. - Apply H. Rewrite H4 in H2. Rewrite H7 in H2. - Exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1). - Exact (alist_sorted_tail ? ? ? H2). - Exact (alist_sorted_tail ? ? ? H3). - Exact (H1 a). - Qed. - -End LSort. + Lemma ad_less_total : + forall a a':ad, {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}. + Proof. + intro a. refine + (ad_rec_double a + (fun a:ad => + forall a':ad, + {ad_less a a' = true} + {ad_less a' a = true} + {a = a'}) _ _ _). + intro. elim (sumbool_of_bool (ad_less ad_z a')). intro H. left. left. assumption. + intro H. right. rewrite (ad_z_less_2 a' H). reflexivity. + intros a0 H a'. refine + (ad_rec_double a' + (fun a':ad => + {ad_less (ad_double a0) a' = true} + + {ad_less a' (ad_double a0) = true} + {ad_double a0 = a'}) _ _ _). + elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). intro H0. left. right. assumption. + intro H0. right. exact (ad_z_less_2 _ H0). + intros a1 H0. rewrite ad_less_def_1. rewrite ad_less_def_1. elim (H a1). intro H1. + left. assumption. + intro H1. right. rewrite H1. reflexivity. + intros a1 H0. left. left. apply ad_less_def_3. + intros a0 H a'. refine + (ad_rec_double a' + (fun a':ad => + {ad_less (ad_double_plus_un a0) a' = true} + + {ad_less a' (ad_double_plus_un a0) = true} + + {ad_double_plus_un a0 = a'}) _ _ _). + left. right. case a0; reflexivity. + intros a1 H0. left. right. apply ad_less_def_3. + intros a1 H0. rewrite ad_less_def_2. rewrite ad_less_def_2. elim (H a1). intro H1. + left. assumption. + intro H1. right. rewrite H1. reflexivity. + Qed. + + Lemma alist_too_low : + forall (l:alist A) (a a':ad) (y:A), + ad_less a a' = true -> + alist_sorted_2 ((a', y) :: l) -> + alist_semantics A ((a', y) :: l) a = NONE A. + Proof. + simple induction l. intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a' a)). intro H1. + rewrite (ad_eq_complete _ _ H1) in H. rewrite (ad_less_not_refl a) in H. discriminate H. + intro H1. rewrite H1. reflexivity. + intro r. elim r. intros a y l0 H a0 a1 y0 H0 H1. + change + (match ad_eq a1 a0 with + | true => SOME A y0 + | false => alist_semantics A ((a, y) :: l0) a0 + end = NONE A) in |- *. + elim (sumbool_of_bool (ad_eq a1 a0)). intro H2. rewrite (ad_eq_complete _ _ H2) in H0. + rewrite (ad_less_not_refl a0) in H0. discriminate H0. + intro H2. rewrite H2. apply H. apply ad_less_trans with (a' := a1). assumption. + unfold alist_sorted_2 in H1. apply (H1 0 1). apply lt_n_Sn. + simpl in |- *. apply le_n_S. apply le_n_S. apply le_O_n. + apply alist_sorted_1_imp_2. apply alist_sorted_imp_1. + cut (alist_sorted ((a1, y0) :: (a, y) :: l0) = true). intro H3. + exact (proj2 (andb_prop _ _ H3)). + apply alist_sorted_2_imp. assumption. + Qed. + + Lemma alist_semantics_nth_ad : + forall (l:alist A) (a:ad) (y:A), + alist_semantics A l a = SOME A y -> + {n : nat | S n <= length l /\ alist_nth_ad n l = a}. + Proof. + simple induction l. intros. discriminate H. + intro r. elim r. intros a y l0 H a0 y0 H0. simpl in H0. elim (sumbool_of_bool (ad_eq a a0)). + intro H1. rewrite H1 in H0. split with 0. split. simpl in |- *. apply le_n_S. apply le_O_n. + simpl in |- *. exact (ad_eq_complete _ _ H1). + intro H1. rewrite H1 in H0. elim (H a0 y0 H0). intros n' H2. split with (S n'). split. + simpl in |- *. apply le_n_S. exact (proj1 H2). + exact (proj2 H2). + Qed. + + Lemma alist_semantics_tail : + forall (l:alist A) (a:ad) (y:A), + alist_sorted_2 ((a, y) :: l) -> + eqm A (alist_semantics A l) + (fun a0:ad => + if ad_eq a a0 then NONE A else alist_semantics A ((a, y) :: l) a0). + Proof. + unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. + rewrite <- (ad_eq_complete _ _ H0). unfold alist_sorted_2 in H. + elim (option_sum A (alist_semantics A l a)). intro H1. elim H1. intros y0 H2. + elim (alist_semantics_nth_ad l a y0 H2). intros n H3. elim H3. intros. + cut + (ad_less (alist_nth_ad 0 ((a, y) :: l)) + (alist_nth_ad (S n) ((a, y) :: l)) = true). + intro. simpl in H6. rewrite H5 in H6. rewrite (ad_less_not_refl a) in H6. discriminate H6. + apply H. apply lt_O_Sn. + simpl in |- *. apply le_n_S. assumption. + trivial. + intro H0. simpl in |- *. rewrite H0. reflexivity. + Qed. + + Lemma alist_semantics_same_tail : + forall (l l':alist A) (a:ad) (y:A), + alist_sorted_2 ((a, y) :: l) -> + alist_sorted_2 ((a, y) :: l') -> + eqm A (alist_semantics A ((a, y) :: l)) + (alist_semantics A ((a, y) :: l')) -> + eqm A (alist_semantics A l) (alist_semantics A l'). + Proof. + unfold eqm in |- *. intros. rewrite (alist_semantics_tail _ _ _ H a0). + rewrite (alist_semantics_tail _ _ _ H0 a0). case (ad_eq a a0). reflexivity. + exact (H1 a0). + Qed. + + Lemma alist_sorted_tail : + forall (l:alist A) (a:ad) (y:A), + alist_sorted_2 ((a, y) :: l) -> alist_sorted_2 l. + Proof. + unfold alist_sorted_2 in |- *. intros. apply (H (S m) (S n)). apply lt_n_S. assumption. + simpl in |- *. apply le_n_S. assumption. + Qed. + + Lemma alist_canonical : + forall l l':alist A, + eqm A (alist_semantics A l) (alist_semantics A l') -> + alist_sorted_2 l -> alist_sorted_2 l' -> l = l'. + Proof. + unfold eqm in |- *. simple induction l. simple induction l'. trivial. + intro r. elim r. intros a y l0 H H0 H1 H2. simpl in H0. + cut + (NONE A = + match ad_eq a a with + | true => SOME A y + | false => alist_semantics A l0 a + end). + rewrite (ad_eq_correct a). intro. discriminate H3. + exact (H0 a). + intro r. elim r. intros a y l0 H. simple induction l'. intros. simpl in H0. + cut + (match ad_eq a a with + | true => SOME A y + | false => alist_semantics A l0 a + end = NONE A). + rewrite (ad_eq_correct a). intro. discriminate H3. + exact (H0 a). + intro r'. elim r'. intros a' y' l'0 H0 H1 H2 H3. elim (ad_less_total a a'). intro H4. + elim H4. intro H5. + cut + (alist_semantics A ((a, y) :: l0) a = + alist_semantics A ((a', y') :: l'0) a). + intro. rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. simpl in H6. + rewrite (ad_eq_correct a) in H6. discriminate H6. + exact (H1 a). + intro H5. cut + (alist_semantics A ((a, y) :: l0) a' = + alist_semantics A ((a', y') :: l'0) a'). + intro. rewrite (alist_too_low l0 a' a y H5 H2) in H6. simpl in H6. + rewrite (ad_eq_correct a') in H6. discriminate H6. + exact (H1 a'). + intro H4. rewrite H4. + cut + (alist_semantics A ((a, y) :: l0) a = + alist_semantics A ((a', y') :: l'0) a). + intro. simpl in H5. rewrite H4 in H5. rewrite (ad_eq_correct a') in H5. inversion H5. + rewrite H4 in H1. rewrite H7 in H1. cut (l0 = l'0). intro. rewrite H6. reflexivity. + apply H. rewrite H4 in H2. rewrite H7 in H2. + exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1). + exact (alist_sorted_tail _ _ _ H2). + exact (alist_sorted_tail _ _ _ H3). + exact (H1 a). + Qed. + +End LSort.
\ No newline at end of file diff --git a/theories/IntMap/Map.v b/theories/IntMap/Map.v index b89f61042..68091d6f0 100644 --- a/theories/IntMap/Map.v +++ b/theories/IntMap/Map.v @@ -9,12 +9,12 @@ (** Definition of finite sets as trees indexed by adresses *) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. Section MapDefs. @@ -23,174 +23,197 @@ Section MapDefs. Variable A : Set. Inductive Map : Set := - M0 : Map + | M0 : Map | M1 : ad -> A -> Map | M2 : Map -> Map -> Map. Inductive option : Set := - NONE : option + | NONE : option | SOME : A -> option. - Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}. + Lemma option_sum : forall o:option, {y : A | o = SOME y} + {o = NONE}. Proof. - Induction o. Right . Reflexivity. - Left . Split with a. Reflexivity. + simple induction o. right. reflexivity. + left. split with a. reflexivity. Qed. (** The semantics of maps is given by the function [MapGet]. The semantics of a map [m] is a partial, finite function from [ad] to [A]: *) - Fixpoint MapGet [m:Map] : ad -> option := - Cases m of - M0 => [a:ad] NONE - | (M1 x y) => [a:ad] - if (ad_eq x a) - then (SOME y) - else NONE - | (M2 m1 m2) => [a:ad] - Cases a of - ad_z => (MapGet m1 ad_z) - | (ad_x xH) => (MapGet m2 ad_z) - | (ad_x (xO p)) => (MapGet m1 (ad_x p)) - | (ad_x (xI p)) => (MapGet m2 (ad_x p)) - end + Fixpoint MapGet (m:Map) : ad -> option := + match m with + | M0 => fun a:ad => NONE + | M1 x y => fun a:ad => if ad_eq x a then SOME y else NONE + | M2 m1 m2 => + fun a:ad => + match a with + | ad_z => MapGet m1 ad_z + | ad_x xH => MapGet m2 ad_z + | ad_x (xO p) => MapGet m1 (ad_x p) + | ad_x (xI p) => MapGet m2 (ad_x p) + end end. Definition newMap := M0. Definition MapSingleton := M1. - Definition eqm := [g,g':ad->option] (a:ad) (g a)=(g' a). + Definition eqm (g g':ad -> option) := forall a:ad, g a = g' a. - Lemma newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE). + Lemma newMap_semantics : eqm (MapGet newMap) (fun a:ad => NONE). Proof. - Simpl. Unfold eqm. Trivial. + simpl in |- *. unfold eqm in |- *. trivial. Qed. - Lemma MapSingleton_semantics : (a:ad) (y:A) - (eqm (MapGet (MapSingleton a y)) [a':ad] if (ad_eq a a') then (SOME y) else NONE). + Lemma MapSingleton_semantics : + forall (a:ad) (y:A), + eqm (MapGet (MapSingleton a y)) + (fun a':ad => if ad_eq a a' then SOME y else NONE). Proof. - Simpl. Unfold eqm. Trivial. + simpl in |- *. unfold eqm in |- *. trivial. Qed. - Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y). + Lemma M1_semantics_1 : forall (a:ad) (y:A), MapGet (M1 a y) a = SOME y. Proof. - Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity. + unfold MapGet in |- *. intros. rewrite (ad_eq_correct a). reflexivity. Qed. Lemma M1_semantics_2 : - (a,a':ad) (y:A) (ad_eq a a')=false -> (MapGet (M1 a y) a')=NONE. + forall (a a':ad) (y:A), ad_eq a a' = false -> MapGet (M1 a y) a' = NONE. Proof. - Intros. Simpl. Rewrite H. Reflexivity. + intros. simpl in |- *. rewrite H. reflexivity. Qed. Lemma Map2_semantics_1 : - (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))). + forall m m':Map, + eqm (MapGet m) (fun a:ad => MapGet (M2 m m') (ad_double a)). Proof. - Unfold eqm. Induction a; Trivial. + unfold eqm in |- *. simple induction a; trivial. Qed. - Lemma Map2_semantics_1_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f) - -> (eqm (MapGet m) [a:ad] (f (ad_double a))). + Lemma Map2_semantics_1_eq : + forall (m m':Map) (f:ad -> option), + eqm (MapGet (M2 m m')) f -> eqm (MapGet m) (fun a:ad => f (ad_double a)). Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_double a)). - Exact (Map2_semantics_1 m m' a). + unfold eqm in |- *. + intros. + rewrite <- (H (ad_double a)). + exact (Map2_semantics_1 m m' a). Qed. Lemma Map2_semantics_2 : - (m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))). - Proof. - Unfold eqm. Induction a; Trivial. - Qed. - - Lemma Map2_semantics_2_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f) - -> (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))). - Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_double_plus_un a)). - Exact (Map2_semantics_2 m m' a). - Qed. - - Lemma MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false - -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m (ad_div_2 a)). - Proof. - Induction a; Trivial. Induction p. Intros. Discriminate H0. - Trivial. - Intros. Discriminate H. - Qed. - - Lemma MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true - -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m' (ad_div_2 a)). - Proof. - Induction a. Intros. Discriminate H. - Induction p. Trivial. - Intros. Discriminate H0. - Trivial. - Qed. - - Lemma MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m') a)= - (if (ad_bit_0 a) then (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))). - Proof. - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H. - Apply MapGet_M2_bit_0_1; Assumption. - Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption. - Qed. - - Lemma MapGet_M2_bit_0 : (m,m',m'':Map) - (a:ad) (if (ad_bit_0 a) then (MapGet (M2 m' m) a) else (MapGet (M2 m m'') a))= - (MapGet m (ad_div_2 a)). - Proof. - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H. - Apply MapGet_M2_bit_0_1; Assumption. - Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption. - Qed. - - Lemma Map2_semantics_3 : (m,m':Map) (eqm (MapGet (M2 m m')) - [a:ad] Cases (ad_bit_0 a) of - false => (MapGet m (ad_div_2 a)) - | true => (MapGet m' (ad_div_2 a)) - end). - Proof. - Unfold eqm. - Induction a; Trivial. - Induction p; Trivial. - Qed. - - Lemma Map2_semantics_3_eq : (m,m':Map) (f,f':ad->option) - (eqm (MapGet m) f) -> (eqm (MapGet m') f') -> (eqm (MapGet (M2 m m')) - [a:ad] Cases (ad_bit_0 a) of - false => (f (ad_div_2 a)) - | true => (f' (ad_div_2 a)) - end). - Proof. - Unfold eqm. - Intros. - Rewrite <- (H (ad_div_2 a)). - Rewrite <- (H0 (ad_div_2 a)). - Exact (Map2_semantics_3 m m' a). - Qed. - - Fixpoint MapPut1 [a:ad; y:A; a':ad; y':A; p:positive] : Map := - Cases p of - (xO p') => let m = (MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p') in - Cases (ad_bit_0 a) of - false => (M2 m M0) - | true => (M2 M0 m) - end - | _ => Cases (ad_bit_0 a) of - false => (M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y')) - | true => (M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y)) - end + forall m m':Map, + eqm (MapGet m') (fun a:ad => MapGet (M2 m m') (ad_double_plus_un a)). + Proof. + unfold eqm in |- *. simple induction a; trivial. + Qed. + + Lemma Map2_semantics_2_eq : + forall (m m':Map) (f:ad -> option), + eqm (MapGet (M2 m m')) f -> + eqm (MapGet m') (fun a:ad => f (ad_double_plus_un a)). + Proof. + unfold eqm in |- *. + intros. + rewrite <- (H (ad_double_plus_un a)). + exact (Map2_semantics_2 m m' a). + Qed. + + Lemma MapGet_M2_bit_0_0 : + forall a:ad, + ad_bit_0 a = false -> + forall m m':Map, MapGet (M2 m m') a = MapGet m (ad_div_2 a). + Proof. + simple induction a; trivial. simple induction p. intros. discriminate H0. + trivial. + intros. discriminate H. + Qed. + + Lemma MapGet_M2_bit_0_1 : + forall a:ad, + ad_bit_0 a = true -> + forall m m':Map, MapGet (M2 m m') a = MapGet m' (ad_div_2 a). + Proof. + simple induction a. intros. discriminate H. + simple induction p. trivial. + intros. discriminate H0. + trivial. + Qed. + + Lemma MapGet_M2_bit_0_if : + forall (m m':Map) (a:ad), + MapGet (M2 m m') a = + (if ad_bit_0 a then MapGet m' (ad_div_2 a) else MapGet m (ad_div_2 a)). + Proof. + intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. rewrite H. + apply MapGet_M2_bit_0_1; assumption. + intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption. + Qed. + + Lemma MapGet_M2_bit_0 : + forall (m m' m'':Map) (a:ad), + (if ad_bit_0 a then MapGet (M2 m' m) a else MapGet (M2 m m'') a) = + MapGet m (ad_div_2 a). + Proof. + intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. rewrite H. + apply MapGet_M2_bit_0_1; assumption. + intro H. rewrite H. apply MapGet_M2_bit_0_0; assumption. + Qed. + + Lemma Map2_semantics_3 : + forall m m':Map, + eqm (MapGet (M2 m m')) + (fun a:ad => + match ad_bit_0 a with + | false => MapGet m (ad_div_2 a) + | true => MapGet m' (ad_div_2 a) + end). + Proof. + unfold eqm in |- *. + simple induction a; trivial. + simple induction p; trivial. + Qed. + + Lemma Map2_semantics_3_eq : + forall (m m':Map) (f f':ad -> option), + eqm (MapGet m) f -> + eqm (MapGet m') f' -> + eqm (MapGet (M2 m m')) + (fun a:ad => + match ad_bit_0 a with + | false => f (ad_div_2 a) + | true => f' (ad_div_2 a) + end). + Proof. + unfold eqm in |- *. + intros. + rewrite <- (H (ad_div_2 a)). + rewrite <- (H0 (ad_div_2 a)). + exact (Map2_semantics_3 m m' a). + Qed. + + Fixpoint MapPut1 (a:ad) (y:A) (a':ad) (y':A) (p:positive) {struct p} : + Map := + match p with + | xO p' => + let m := MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p' in + match ad_bit_0 a with + | false => M2 m M0 + | true => M2 M0 m + end + | _ => + match ad_bit_0 a with + | false => M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y') + | true => M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y) + end end. - Lemma MapGet_if_commute : (b:bool) (m,m':Map) (a:ad) - (MapGet (if b then m else m') a)=(if b then (MapGet m a) else (MapGet m' a)). + Lemma MapGet_if_commute : + forall (b:bool) (m m':Map) (a:ad), + MapGet (if b then m else m') a = (if b then MapGet m a else MapGet m' a). Proof. - Intros. Case b; Trivial. + intros. case b; trivial. Qed. (*i @@ -206,581 +229,637 @@ Section MapDefs. Qed. i*) - Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad) - (MapGet (if b then m else m) a)=(MapGet m a). + Lemma MapGet_if_same : + forall (m:Map) (b:bool) (a:ad), MapGet (if b then m else m) a = MapGet m a. Proof. - Induction b;Trivial. + simple induction b; trivial. Qed. - Lemma MapGet_M2_bit_0_2 : (m,m',m'':Map) - (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m' m'')) a)= - (MapGet m' (ad_div_2 a)). + Lemma MapGet_M2_bit_0_2 : + forall (m m' m'':Map) (a:ad), + MapGet (if ad_bit_0 a then M2 m m' else M2 m' m'') a = + MapGet m' (ad_div_2 a). Proof. - Intros. Rewrite MapGet_if_commute. Apply MapGet_M2_bit_0. + intros. rewrite MapGet_if_commute. apply MapGet_M2_bit_0. Qed. - Lemma MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (MapGet (MapPut1 a y a' y' p) a)=(SOME y). + Lemma MapPut1_semantics_1 : + forall (p:positive) (a a':ad) (y y':A), + ad_xor a a' = ad_x p -> MapGet (MapPut1 a y a' y' p) a = SOME y. Proof. - Induction p. Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. - Intros. Simpl. Rewrite MapGet_M2_bit_0_2. Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. - Reflexivity. - Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. + simple induction p. intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. + intros. simpl in |- *. rewrite MapGet_M2_bit_0_2. apply H. rewrite <- ad_xor_div_2. rewrite H0. + reflexivity. + intros. unfold MapPut1 in |- *. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. Qed. - Lemma MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (MapGet (MapPut1 a y a' y' p) a')=(SOME y'). + Lemma MapPut1_semantics_2 : + forall (p:positive) (a a':ad) (y y':A), + ad_xor a a' = ad_x p -> MapGet (MapPut1 a y a' y' p) a' = SOME y'. Proof. - Induction p. Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_2 a a' p0 H0). - Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. - Intros. Simpl. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite MapGet_M2_bit_0_2. - Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1. + simple induction p. intros. unfold MapPut1 in |- *. rewrite (ad_neg_bit_0_2 a a' p0 H0). + rewrite if_negb. rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. + intros. simpl in |- *. rewrite (ad_same_bit_0 a a' p0 H0). rewrite MapGet_M2_bit_0_2. + apply H. rewrite <- ad_xor_div_2. rewrite H0. reflexivity. + intros. unfold MapPut1 in |- *. rewrite (ad_neg_bit_0_1 a a' H). rewrite if_negb. + rewrite MapGet_M2_bit_0_2. apply M1_semantics_1. Qed. - Lemma MapGet_M2_both_NONE : (m,m':Map) (a:ad) - (MapGet m (ad_div_2 a))=NONE -> (MapGet m' (ad_div_2 a))=NONE -> - (MapGet (M2 m m') a)=NONE. + Lemma MapGet_M2_both_NONE : + forall (m m':Map) (a:ad), + MapGet m (ad_div_2 a) = NONE -> + MapGet m' (ad_div_2 a) = NONE -> MapGet (M2 m m') a = NONE. Proof. - Intros. Rewrite (Map2_semantics_3 m m' a). - Case (ad_bit_0 a); Assumption. + intros. rewrite (Map2_semantics_3 m m' a). + case (ad_bit_0 a); assumption. Qed. - Lemma MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A) - (ad_xor a a')=(ad_x p) -> (ad_eq a a0)=false -> (ad_eq a' a0)=false -> - (MapGet (MapPut1 a y a' y' p) a0)=NONE. - Proof. - Induction p. Intros. Unfold MapPut1. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption. - Rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. Rewrite (negb_intro (ad_bit_0 a')). - Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H3. Reflexivity. - Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_neg_bit_0_2 a a' p0 H0). Rewrite H4. - Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2. - Apply M1_semantics_2; Assumption. - Intro; Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; - Apply M1_semantics_2; Assumption. - Intros. Simpl. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Reflexivity. - Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite H4. - Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Reflexivity. - Intro. Cut (ad_xor (ad_div_2 a) (ad_div_2 a'))=(ad_x p0). Intro. - Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Trivial; - Apply H; Assumption. - Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intros. Simpl. Elim (ad_neq a a0 H0). Intro. Rewrite H2. Rewrite if_negb. - Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption. - Rewrite (ad_neg_bit_0_1 a a' H) in H2. Rewrite (negb_intro (ad_bit_0 a')). - Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H2. Reflexivity. - Intro. Elim (ad_neq a' a0 H1). Intro. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite H3. - Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2. - Apply M1_semantics_2; Assumption. - Intro. Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Apply M1_semantics_2; Assumption. - Qed. - - Lemma MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (eqm (MapGet (MapPut1 a y a' y' p)) - [a0:ad] if (ad_eq a a0) then (SOME y) - else if (ad_eq a' a0) then (SOME y') else NONE). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. - Rewrite <- (ad_eq_complete ? ? H0). Exact (MapPut1_semantics_1 p a a' y y' H). - Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq a' a0)). Intro H1. - Rewrite <- (ad_eq_complete ? ? H1). Rewrite (ad_eq_correct a'). - Exact (MapPut1_semantics_2 p a a' y y' H). - Intro H1. Rewrite H1. Exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1). - Qed. - - Lemma MapPut1_semantics' : (p:positive) (a,a':ad) (y,y':A) - (ad_xor a a')=(ad_x p) - -> (eqm (MapGet (MapPut1 a y a' y' p)) - [a0:ad] if (ad_eq a' a0) then (SOME y') - else if (ad_eq a a0) then (SOME y) else NONE). - Proof. - Unfold eqm. Intros. Rewrite (MapPut1_semantics p a a' y y' H a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. - Rewrite <- (ad_eq_complete a a0 H0). Rewrite (ad_eq_comm a' a). - Rewrite (ad_xor_eq_false a a' p H). Reflexivity. - Intro H0. Rewrite H0. Reflexivity. - Qed. - - Fixpoint MapPut [m:Map] : ad -> A -> Map := - Cases m of - M0 => M1 - | (M1 a y) => [a':ad; y':A] - Cases (ad_xor a a') of - ad_z => (M1 a' y') - | (ad_x p) => (MapPut1 a y a' y' p) + Lemma MapPut1_semantics_3 : + forall (p:positive) (a a' a0:ad) (y y':A), + ad_xor a a' = ad_x p -> + ad_eq a a0 = false -> + ad_eq a' a0 = false -> MapGet (MapPut1 a y a' y' p) a0 = NONE. + Proof. + simple induction p. intros. unfold MapPut1 in |- *. elim (ad_neq a a0 H1). intro. rewrite H3. rewrite if_negb. + rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply ad_div_bit_neq. assumption. + rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. rewrite (negb_intro (ad_bit_0 a')). + rewrite (negb_intro (ad_bit_0 a0)). rewrite H3. reflexivity. + intro. elim (ad_neq a' a0 H2). intro. rewrite (ad_neg_bit_0_2 a a' p0 H0). rewrite H4. + rewrite (negb_elim (ad_bit_0 a0)). rewrite MapGet_M2_bit_0_2. + apply M1_semantics_2; assumption. + intro; case (ad_bit_0 a); apply MapGet_M2_both_NONE; apply M1_semantics_2; + assumption. + intros. simpl in |- *. elim (ad_neq a a0 H1). intro. rewrite H3. rewrite if_negb. + rewrite MapGet_M2_bit_0_2. reflexivity. + intro. elim (ad_neq a' a0 H2). intro. rewrite (ad_same_bit_0 a a' p0 H0). rewrite H4. + rewrite if_negb. rewrite MapGet_M2_bit_0_2. reflexivity. + intro. cut (ad_xor (ad_div_2 a) (ad_div_2 a') = ad_x p0). intro. + case (ad_bit_0 a); apply MapGet_M2_both_NONE; trivial; apply H; + assumption. + rewrite <- ad_xor_div_2. rewrite H0. reflexivity. + intros. simpl in |- *. elim (ad_neq a a0 H0). intro. rewrite H2. rewrite if_negb. + rewrite MapGet_M2_bit_0_2. apply M1_semantics_2. apply ad_div_bit_neq. assumption. + rewrite (ad_neg_bit_0_1 a a' H) in H2. rewrite (negb_intro (ad_bit_0 a')). + rewrite (negb_intro (ad_bit_0 a0)). rewrite H2. reflexivity. + intro. elim (ad_neq a' a0 H1). intro. rewrite (ad_neg_bit_0_1 a a' H). rewrite H3. + rewrite (negb_elim (ad_bit_0 a0)). rewrite MapGet_M2_bit_0_2. + apply M1_semantics_2; assumption. + intro. case (ad_bit_0 a); apply MapGet_M2_both_NONE; apply M1_semantics_2; + assumption. + Qed. + + Lemma MapPut1_semantics : + forall (p:positive) (a a':ad) (y y':A), + ad_xor a a' = ad_x p -> + eqm (MapGet (MapPut1 a y a' y' p)) + (fun a0:ad => + if ad_eq a a0 + then SOME y + else if ad_eq a' a0 then SOME y' else NONE). + Proof. + unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. + rewrite <- (ad_eq_complete _ _ H0). exact (MapPut1_semantics_1 p a a' y y' H). + intro H0. rewrite H0. elim (sumbool_of_bool (ad_eq a' a0)). intro H1. + rewrite <- (ad_eq_complete _ _ H1). rewrite (ad_eq_correct a'). + exact (MapPut1_semantics_2 p a a' y y' H). + intro H1. rewrite H1. exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1). + Qed. + + Lemma MapPut1_semantics' : + forall (p:positive) (a a':ad) (y y':A), + ad_xor a a' = ad_x p -> + eqm (MapGet (MapPut1 a y a' y' p)) + (fun a0:ad => + if ad_eq a' a0 + then SOME y' + else if ad_eq a a0 then SOME y else NONE). + Proof. + unfold eqm in |- *. intros. rewrite (MapPut1_semantics p a a' y y' H a0). + elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. + rewrite <- (ad_eq_complete a a0 H0). rewrite (ad_eq_comm a' a). + rewrite (ad_xor_eq_false a a' p H). reflexivity. + intro H0. rewrite H0. reflexivity. + Qed. + + Fixpoint MapPut (m:Map) : ad -> A -> Map := + match m with + | M0 => M1 + | M1 a y => + fun (a':ad) (y':A) => + match ad_xor a a' with + | ad_z => M1 a' y' + | ad_x p => MapPut1 a y a' y' p + end + | M2 m1 m2 => + fun (a:ad) (y:A) => + match a with + | ad_z => M2 (MapPut m1 ad_z y) m2 + | ad_x xH => M2 m1 (MapPut m2 ad_z y) + | ad_x (xO p) => M2 (MapPut m1 (ad_x p) y) m2 + | ad_x (xI p) => M2 m1 (MapPut m2 (ad_x p) y) end - | (M2 m1 m2) => [a:ad; y:A] - Cases a of - ad_z => (M2 (MapPut m1 ad_z y) m2) - | (ad_x xH) => (M2 m1 (MapPut m2 ad_z y)) - | (ad_x (xO p)) => (M2 (MapPut m1 (ad_x p) y) m2) - | (ad_x (xI p)) => (M2 m1 (MapPut m2 (ad_x p) y)) - end end. - Lemma MapPut_semantics_1 : (a:ad) (y:A) (a0:ad) - (MapGet (MapPut M0 a y) a0)=(MapGet (M1 a y) a0). - Proof. - Trivial. - Qed. - - Lemma MapPut_semantics_2_1 : (a:ad) (y,y':A) (a0:ad) - (MapGet (MapPut (M1 a y) a y') a0)=(if (ad_eq a a0) then (SOME y') else NONE). - Proof. - Simpl. Intros. Rewrite (ad_xor_nilpotent a). Trivial. - Qed. - - Lemma MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' -> - (MapGet (MapPut (M1 a y) a' y') a0)= - (if (ad_eq a' a0) then (SOME y') else - if (ad_eq a a0) then (SOME y) else NONE). - Proof. - Induction a''. Intro. Rewrite (ad_xor_eq ? ? H). Rewrite MapPut_semantics_2_1. - Case (ad_eq a' a0); Trivial. - Intros. Simpl. Rewrite H. Rewrite (MapPut1_semantics p a a' y y' H a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. Rewrite <- (ad_eq_complete ? ? H0). - Rewrite (ad_eq_comm a' a). Rewrite (ad_xor_eq_false ? ? ? H). Reflexivity. - Intro H0. Rewrite H0. Reflexivity. - Qed. - - Lemma MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad) - (MapGet (MapPut (M1 a y) a' y') a0)= - (if (ad_eq a' a0) then (SOME y') else - if (ad_eq a a0) then (SOME y) else NONE). - Proof. - Intros. Apply MapPut_semantics_2_2 with a'':=(ad_xor a a'); Trivial. - Qed. - - Lemma MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A) - (MapPut (M2 m m') a y)=(if (ad_bit_0 a) then (M2 m (MapPut m' (ad_div_2 a) y)) - else (M2 (MapPut m (ad_div_2 a) y) m')). - Proof. - Induction a. Trivial. - Induction p; Trivial. - Qed. - - Lemma MapPut_semantics : (m:Map) (a:ad) (y:A) - (eqm (MapGet (MapPut m a y)) [a':ad] if (ad_eq a a') then (SOME y) else (MapGet m a')). - Proof. - Unfold eqm. Induction m. Exact MapPut_semantics_1. - Intros. Unfold 2 MapGet. Apply MapPut_semantics_2; Assumption. - Intros. Rewrite MapPut_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a0). - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. - Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite H2. - Rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). Elim (sumbool_of_bool (ad_eq a a0)). - Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity. - Intro H2. Rewrite H2. Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq a0 a H2 H1). - Reflexivity. - Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). - Intro H2. Rewrite H2. Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity. - Intro H2. Rewrite H2. Rewrite (H (ad_div_2 a) y (ad_div_2 a0)). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. - Rewrite (ad_div_eq a a0 H3). Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq a a0 H3 H1). Reflexivity. - Qed. - - Fixpoint MapPut_behind [m:Map] : ad -> A -> Map := - Cases m of - M0 => M1 - | (M1 a y) => [a':ad; y':A] - Cases (ad_xor a a') of - ad_z => m - | (ad_x p) => (MapPut1 a y a' y' p) + Lemma MapPut_semantics_1 : + forall (a:ad) (y:A) (a0:ad), + MapGet (MapPut M0 a y) a0 = MapGet (M1 a y) a0. + Proof. + trivial. + Qed. + + Lemma MapPut_semantics_2_1 : + forall (a:ad) (y y':A) (a0:ad), + MapGet (MapPut (M1 a y) a y') a0 = + (if ad_eq a a0 then SOME y' else NONE). + Proof. + simpl in |- *. intros. rewrite (ad_xor_nilpotent a). trivial. + Qed. + + Lemma MapPut_semantics_2_2 : + forall (a a':ad) (y y':A) (a0 a'':ad), + ad_xor a a' = a'' -> + MapGet (MapPut (M1 a y) a' y') a0 = + (if ad_eq a' a0 then SOME y' else if ad_eq a a0 then SOME y else NONE). + Proof. + simple induction a''. intro. rewrite (ad_xor_eq _ _ H). rewrite MapPut_semantics_2_1. + case (ad_eq a' a0); trivial. + intros. simpl in |- *. rewrite H. rewrite (MapPut1_semantics p a a' y y' H a0). + elim (sumbool_of_bool (ad_eq a a0)). intro H0. rewrite H0. rewrite <- (ad_eq_complete _ _ H0). + rewrite (ad_eq_comm a' a). rewrite (ad_xor_eq_false _ _ _ H). reflexivity. + intro H0. rewrite H0. reflexivity. + Qed. + + Lemma MapPut_semantics_2 : + forall (a a':ad) (y y':A) (a0:ad), + MapGet (MapPut (M1 a y) a' y') a0 = + (if ad_eq a' a0 then SOME y' else if ad_eq a a0 then SOME y else NONE). + Proof. + intros. apply MapPut_semantics_2_2 with (a'' := ad_xor a a'); trivial. + Qed. + + Lemma MapPut_semantics_3_1 : + forall (m m':Map) (a:ad) (y:A), + MapPut (M2 m m') a y = + (if ad_bit_0 a + then M2 m (MapPut m' (ad_div_2 a) y) + else M2 (MapPut m (ad_div_2 a) y) m'). + Proof. + simple induction a. trivial. + simple induction p; trivial. + Qed. + + Lemma MapPut_semantics : + forall (m:Map) (a:ad) (y:A), + eqm (MapGet (MapPut m a y)) + (fun a':ad => if ad_eq a a' then SOME y else MapGet m a'). + Proof. + unfold eqm in |- *. simple induction m. exact MapPut_semantics_1. + intros. unfold MapGet at 2 in |- *. apply MapPut_semantics_2; assumption. + intros. rewrite MapPut_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a0). + elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. + elim (sumbool_of_bool (ad_bit_0 a0)). intro H2. rewrite H2. + rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). elim (sumbool_of_bool (ad_eq a a0)). + intro H3. rewrite H3. rewrite (ad_div_eq _ _ H3). reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). reflexivity. + intro H2. rewrite H2. rewrite (ad_eq_comm a a0). rewrite (ad_bit_0_neq a0 a H2 H1). + reflexivity. + intro H1. rewrite H1. rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a0)). + intro H2. rewrite H2. rewrite (ad_bit_0_neq a a0 H1 H2). reflexivity. + intro H2. rewrite H2. rewrite (H (ad_div_2 a) y (ad_div_2 a0)). + elim (sumbool_of_bool (ad_eq a a0)). intro H3. rewrite H3. + rewrite (ad_div_eq a a0 H3). reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq a a0 H3 H1). reflexivity. + Qed. + + Fixpoint MapPut_behind (m:Map) : ad -> A -> Map := + match m with + | M0 => M1 + | M1 a y => + fun (a':ad) (y':A) => + match ad_xor a a' with + | ad_z => m + | ad_x p => MapPut1 a y a' y' p + end + | M2 m1 m2 => + fun (a:ad) (y:A) => + match a with + | ad_z => M2 (MapPut_behind m1 ad_z y) m2 + | ad_x xH => M2 m1 (MapPut_behind m2 ad_z y) + | ad_x (xO p) => M2 (MapPut_behind m1 (ad_x p) y) m2 + | ad_x (xI p) => M2 m1 (MapPut_behind m2 (ad_x p) y) end - | (M2 m1 m2) => [a:ad; y:A] - Cases a of - ad_z => (M2 (MapPut_behind m1 ad_z y) m2) - | (ad_x xH) => (M2 m1 (MapPut_behind m2 ad_z y)) - | (ad_x (xO p)) => (M2 (MapPut_behind m1 (ad_x p) y) m2) - | (ad_x (xI p)) => (M2 m1 (MapPut_behind m2 (ad_x p) y)) - end end. - Lemma MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A) - (MapPut_behind (M2 m m') a y)= - (if (ad_bit_0 a) then (M2 m (MapPut_behind m' (ad_div_2 a) y)) - else (M2 (MapPut_behind m (ad_div_2 a) y) m')). - Proof. - Induction a. Trivial. - Induction p; Trivial. - Qed. - - Lemma MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false -> - (y,y':A) (MapGet (MapPut (M1 a y) a' y') a0) - =(MapGet (MapPut_behind (M1 a y) a' y') a0). - Proof. - Intros a a' a0. Simpl. Intros H y y'. Elim (ad_sum (ad_xor a a')). Intro H0. Elim H0. - Intros p H1. Rewrite H1. Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_xor_eq ? ? H0). Rewrite (M1_semantics_2 a' a0 y H). - Exact (M1_semantics_2 a' a0 y' H). - Qed. - - Lemma MapPut_behind_as_before : (m:Map) (a:ad) (y:A) - (a0:ad) (ad_eq a a0)=false -> - (MapGet (MapPut m a y) a0)=(MapGet (MapPut_behind m a y) a0). - Proof. - Induction m. Trivial. - Intros a y a' y' a0 H. Exact (MapPut_behind_as_before_1 a a' a0 H y y'). - Intros. Rewrite MapPut_semantics_3_1. Rewrite MapPut_behind_semantics_3_1. - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. - Rewrite H3. Apply H0. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2). - Intro H3. Rewrite H3. Reflexivity. - Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if. - Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. Rewrite H3. Reflexivity. - Intro H3. Rewrite H3. Apply H. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2). - Qed. - - Lemma MapPut_behind_new : (m:Map) (a:ad) (y:A) - (MapGet (MapPut_behind m a y) a)=(Cases (MapGet m a) of - (SOME y') => (SOME y') - | _ => (SOME y) - end). - Proof. - Induction m. Simpl. Intros. Rewrite (ad_eq_correct a). Reflexivity. - Intros. Elim (ad_sum (ad_xor a a1)). Intro H. Elim H. Intros p H0. Simpl. - Rewrite H0. Rewrite (ad_xor_eq_false a a1 p). Exact (MapPut1_semantics_2 p a a1 a0 y H0). - Assumption. - Intro H. Simpl. Rewrite H. Rewrite <- (ad_xor_eq ? ? H). Rewrite (ad_eq_correct a). - Exact (M1_semantics_1 a a0). - Intros. Rewrite MapPut_behind_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a). - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_1 a H1). - Exact (H0 (ad_div_2 a) y). - Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_0 a H1). Exact (H (ad_div_2 a) y). - Qed. - - Lemma MapPut_behind_semantics : (m:Map) (a:ad) (y:A) - (eqm (MapGet (MapPut_behind m a y)) - [a':ad] Cases (MapGet m a') of - (SOME y') => (SOME y') - | _ => if (ad_eq a a') then (SOME y) else NONE - end). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. - Rewrite (ad_eq_complete ? ? H). Apply MapPut_behind_new. - Intro H. Rewrite H. Rewrite <- (MapPut_behind_as_before m a y a0 H). - Rewrite (MapPut_semantics m a y a0). Rewrite H. Case (MapGet m a0); Trivial. - Qed. - - Definition makeM2 := [m,m':Map] Cases m m' of - M0 M0 => M0 - | M0 (M1 a y) => (M1 (ad_double_plus_un a) y) - | (M1 a y) M0 => (M1 (ad_double a) y) - | _ _ => (M2 m m') - end. - - Lemma makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))). - Proof. - Unfold eqm. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. - Rewrite (MapGet_M2_bit_0_1 a H m m'). Case m'. Case m. Reflexivity. - Intros a0 y. Simpl. Rewrite (ad_bit_0_1_not_double a H a0). Reflexivity. - Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity. - Assumption. - Case m. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double_plus_un a H). - Rewrite (ad_eq_correct a). Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. - Rewrite (ad_not_div_2_not_double_plus_un a a0 H0). Reflexivity. - Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity. - Assumption. - Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity. - Assumption. - Intros m1 m2. Unfold makeM2. - Cut (MapGet (M2 m (M2 m1 m2)) a)=(MapGet (M2 m1 m2) (ad_div_2 a)). - Case m; Trivial. - Exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)). - Intro H. Rewrite (MapGet_M2_bit_0_0 a H m m'). Case m. Case m'. Reflexivity. - Intros a0 y. Simpl. Rewrite (ad_bit_0_0_not_double_plus_un a H a0). Reflexivity. - Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity. - Assumption. - Case m'. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). Intro H0. - Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double a H). - Rewrite (ad_eq_correct a). Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_eq_comm (ad_double a0) a). - Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. Rewrite (ad_not_div_2_not_double a a0 H0). - Reflexivity. - Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity. - Assumption. - Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity. - Assumption. - Intros m1 m2. Unfold makeM2. Exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m'). - Qed. - - Fixpoint MapRemove [m:Map] : ad -> Map := - Cases m of - M0 => [_:ad] M0 - | (M1 a y) => [a':ad] - Cases (ad_eq a a') of - true => M0 - | false => m - end - | (M2 m1 m2) => [a:ad] - if (ad_bit_0 a) - then (makeM2 m1 (MapRemove m2 (ad_div_2 a))) - else (makeM2 (MapRemove m1 (ad_div_2 a)) m2) + Lemma MapPut_behind_semantics_3_1 : + forall (m m':Map) (a:ad) (y:A), + MapPut_behind (M2 m m') a y = + (if ad_bit_0 a + then M2 m (MapPut_behind m' (ad_div_2 a) y) + else M2 (MapPut_behind m (ad_div_2 a) y) m'). + Proof. + simple induction a. trivial. + simple induction p; trivial. + Qed. + + Lemma MapPut_behind_as_before_1 : + forall a a' a0:ad, + ad_eq a' a0 = false -> + forall y y':A, + MapGet (MapPut (M1 a y) a' y') a0 = + MapGet (MapPut_behind (M1 a y) a' y') a0. + Proof. + intros a a' a0. simpl in |- *. intros H y y'. elim (ad_sum (ad_xor a a')). intro H0. elim H0. + intros p H1. rewrite H1. reflexivity. + intro H0. rewrite H0. rewrite (ad_xor_eq _ _ H0). rewrite (M1_semantics_2 a' a0 y H). + exact (M1_semantics_2 a' a0 y' H). + Qed. + + Lemma MapPut_behind_as_before : + forall (m:Map) (a:ad) (y:A) (a0:ad), + ad_eq a a0 = false -> + MapGet (MapPut m a y) a0 = MapGet (MapPut_behind m a y) a0. + Proof. + simple induction m. trivial. + intros a y a' y' a0 H. exact (MapPut_behind_as_before_1 a a' a0 H y y'). + intros. rewrite MapPut_semantics_3_1. rewrite MapPut_behind_semantics_3_1. + elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a0)). intro H3. + rewrite H3. apply H0. rewrite <- H3 in H2. exact (ad_div_bit_neq a a0 H1 H2). + intro H3. rewrite H3. reflexivity. + intro H2. rewrite H2. rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. + elim (sumbool_of_bool (ad_bit_0 a0)). intro H3. rewrite H3. reflexivity. + intro H3. rewrite H3. apply H. rewrite <- H3 in H2. exact (ad_div_bit_neq a a0 H1 H2). + Qed. + + Lemma MapPut_behind_new : + forall (m:Map) (a:ad) (y:A), + MapGet (MapPut_behind m a y) a = + match MapGet m a with + | SOME y' => SOME y' + | _ => SOME y + end. + Proof. + simple induction m. simpl in |- *. intros. rewrite (ad_eq_correct a). reflexivity. + intros. elim (ad_sum (ad_xor a a1)). intro H. elim H. intros p H0. simpl in |- *. + rewrite H0. rewrite (ad_xor_eq_false a a1 p). exact (MapPut1_semantics_2 p a a1 a0 y H0). + assumption. + intro H. simpl in |- *. rewrite H. rewrite <- (ad_xor_eq _ _ H). rewrite (ad_eq_correct a). + exact (M1_semantics_1 a a0). + intros. rewrite MapPut_behind_semantics_3_1. rewrite (MapGet_M2_bit_0_if m0 m1 a). + elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_1 a H1). + exact (H0 (ad_div_2 a) y). + intro H1. rewrite H1. rewrite (MapGet_M2_bit_0_0 a H1). exact (H (ad_div_2 a) y). + Qed. + + Lemma MapPut_behind_semantics : + forall (m:Map) (a:ad) (y:A), + eqm (MapGet (MapPut_behind m a y)) + (fun a':ad => + match MapGet m a' with + | SOME y' => SOME y' + | _ => if ad_eq a a' then SOME y else NONE + end). + Proof. + unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H. rewrite H. + rewrite (ad_eq_complete _ _ H). apply MapPut_behind_new. + intro H. rewrite H. rewrite <- (MapPut_behind_as_before m a y a0 H). + rewrite (MapPut_semantics m a y a0). rewrite H. case (MapGet m a0); trivial. + Qed. + + Definition makeM2 (m m':Map) := + match m, m' with + | M0, M0 => M0 + | M0, M1 a y => M1 (ad_double_plus_un a) y + | M1 a y, M0 => M1 (ad_double a) y + | _, _ => M2 m m' end. - Lemma MapRemove_semantics : (m:Map) (a:ad) - (eqm (MapGet (MapRemove m a)) [a':ad] if (ad_eq a a') then NONE else (MapGet m a')). - Proof. - Unfold eqm. Induction m. Simpl. Intros. Case (ad_eq a a0); Trivial. - Intros. Simpl. Elim (sumbool_of_bool (ad_eq a1 a2)). Intro H. Rewrite H. - Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Reflexivity. - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H) in H0. Exact (M1_semantics_2 a a2 a0 H0). - Intro H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Rewrite H. - Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite H. Reflexivity. - Intro H0. Rewrite H0. Rewrite H. Reflexivity. - Intros. Change (MapGet (if (ad_bit_0 a) - then (makeM2 m0 (MapRemove m1 (ad_div_2 a))) - else (makeM2 (MapRemove m0 (ad_div_2 a)) m1)) - a0) - =(if (ad_eq a a0) then NONE else (MapGet (M2 m0 m1) a0)). - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. - Rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). Elim (sumbool_of_bool (ad_bit_0 a0)). - Intro H2. Rewrite MapGet_M2_bit_0_1. Rewrite (H0 (ad_div_2 a) (ad_div_2 a0)). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). - Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). - Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Reflexivity. - Assumption. - Intro H2. Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))). - Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq ? ? H2 H1). - Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Reflexivity. - Intro H1. Rewrite H1. Rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0). - Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite MapGet_M2_bit_0_1. - Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity. - Assumption. - Intro H2. Rewrite MapGet_M2_bit_0_0. Rewrite (H (ad_div_2 a) (ad_div_2 a0)). - Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. - Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity. - Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity. - Assumption. - Qed. - - Fixpoint MapCard [m:Map] : nat := - Cases m of - M0 => O - | (M1 _ _) => (S O) - | (M2 m m') => (plus (MapCard m) (MapCard m')) + Lemma makeM2_M2 : + forall m m':Map, eqm (MapGet (makeM2 m m')) (MapGet (M2 m m')). + Proof. + unfold eqm in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H. + rewrite (MapGet_M2_bit_0_1 a H m m'). case m'. case m. reflexivity. + intros a0 y. simpl in |- *. rewrite (ad_bit_0_1_not_double a H a0). reflexivity. + intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. + assumption. + case m. intros a0 y. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). + intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0). rewrite (ad_div_2_double_plus_un a H). + rewrite (ad_eq_correct a). reflexivity. + intro H0. rewrite H0. rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. + rewrite (ad_not_div_2_not_double_plus_un a a0 H0). reflexivity. + intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. + assumption. + intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_1. reflexivity. + assumption. + intros m1 m2. unfold makeM2 in |- *. + cut (MapGet (M2 m (M2 m1 m2)) a = MapGet (M2 m1 m2) (ad_div_2 a)). + case m; trivial. + exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)). + intro H. rewrite (MapGet_M2_bit_0_0 a H m m'). case m. case m'. reflexivity. + intros a0 y. simpl in |- *. rewrite (ad_bit_0_0_not_double_plus_un a H a0). reflexivity. + intros m1 m2. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. + assumption. + case m'. intros a0 y. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). intro H0. + rewrite H0. rewrite (ad_eq_complete _ _ H0). rewrite (ad_div_2_double a H). + rewrite (ad_eq_correct a). reflexivity. + intro H0. rewrite H0. rewrite (ad_eq_comm (ad_double a0) a). + rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. rewrite (ad_not_div_2_not_double a a0 H0). + reflexivity. + intros a0 y0 a1 y1. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. + assumption. + intros m1 m2 a0 y. unfold makeM2 in |- *. rewrite MapGet_M2_bit_0_0. reflexivity. + assumption. + intros m1 m2. unfold makeM2 in |- *. exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m'). + Qed. + + Fixpoint MapRemove (m:Map) : ad -> Map := + match m with + | M0 => fun _:ad => M0 + | M1 a y => + fun a':ad => match ad_eq a a' with + | true => M0 + | false => m + end + | M2 m1 m2 => + fun a:ad => + if ad_bit_0 a + then makeM2 m1 (MapRemove m2 (ad_div_2 a)) + else makeM2 (MapRemove m1 (ad_div_2 a)) m2 end. - Fixpoint MapMerge [m:Map] : Map -> Map := - Cases m of - M0 => [m':Map] m' - | (M1 a y) => [m':Map] (MapPut_behind m' a y) - | (M2 m1 m2) => [m':Map] Cases m' of - M0 => m - | (M1 a' y') => (MapPut m a' y') - | (M2 m'1 m'2) => (M2 (MapMerge m1 m'1) - (MapMerge m2 m'2)) - end + Lemma MapRemove_semantics : + forall (m:Map) (a:ad), + eqm (MapGet (MapRemove m a)) + (fun a':ad => if ad_eq a a' then NONE else MapGet m a'). + Proof. + unfold eqm in |- *. simple induction m. simpl in |- *. intros. case (ad_eq a a0); trivial. + intros. simpl in |- *. elim (sumbool_of_bool (ad_eq a1 a2)). intro H. rewrite H. + elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. reflexivity. + intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H) in H0. exact (M1_semantics_2 a a2 a0 H0). + intro H. elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. rewrite H. + rewrite <- (ad_eq_complete _ _ H0) in H. rewrite H. reflexivity. + intro H0. rewrite H0. rewrite H. reflexivity. + intros. change + (MapGet + (if ad_bit_0 a + then makeM2 m0 (MapRemove m1 (ad_div_2 a)) + else makeM2 (MapRemove m0 (ad_div_2 a)) m1) a0 = + (if ad_eq a a0 then NONE else MapGet (M2 m0 m1) a0)) + in |- *. + elim (sumbool_of_bool (ad_bit_0 a)). intro H1. rewrite H1. + rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). elim (sumbool_of_bool (ad_bit_0 a0)). + intro H2. rewrite MapGet_M2_bit_0_1. rewrite (H0 (ad_div_2 a) (ad_div_2 a0)). + elim (sumbool_of_bool (ad_eq a a0)). intro H3. rewrite H3. rewrite (ad_div_eq _ _ H3). + reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). + rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). reflexivity. + assumption. + intro H2. rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))). + rewrite (ad_eq_comm a a0). rewrite (ad_bit_0_neq _ _ H2 H1). + rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). reflexivity. + intro H1. rewrite H1. rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0). + elim (sumbool_of_bool (ad_bit_0 a0)). intro H2. rewrite MapGet_M2_bit_0_1. + rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). rewrite (ad_bit_0_neq a a0 H1 H2). reflexivity. + assumption. + intro H2. rewrite MapGet_M2_bit_0_0. rewrite (H (ad_div_2 a) (ad_div_2 a0)). + rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). elim (sumbool_of_bool (ad_eq a a0)). intro H3. + rewrite H3. rewrite (ad_div_eq _ _ H3). reflexivity. + intro H3. rewrite H3. rewrite <- H2 in H1. rewrite (ad_div_bit_neq _ _ H3 H1). reflexivity. + assumption. + Qed. + + Fixpoint MapCard (m:Map) : nat := + match m with + | M0 => 0 + | M1 _ _ => 1 + | M2 m m' => MapCard m + MapCard m' + end. + + Fixpoint MapMerge (m:Map) : Map -> Map := + match m with + | M0 => fun m':Map => m' + | M1 a y => fun m':Map => MapPut_behind m' a y + | M2 m1 m2 => + fun m':Map => + match m' with + | M0 => m + | M1 a' y' => MapPut m a' y' + | M2 m'1 m'2 => M2 (MapMerge m1 m'1) (MapMerge m2 m'2) + end end. - Lemma MapMerge_semantics : (m,m':Map) - (eqm (MapGet (MapMerge m m')) - [a0:ad] Cases (MapGet m' a0) of - (SOME y') => (SOME y') - | NONE => (MapGet m a0) - end). - Proof. - Unfold eqm. Induction m. Intros. Simpl. Case (MapGet m' a); Trivial. - Intros. Simpl. Rewrite (MapPut_behind_semantics m' a a0 a1). Reflexivity. - Induction m'. Trivial. - Intros. Unfold MapMerge. Rewrite (MapPut_semantics (M2 m0 m1) a a0 a1). - Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1). - Rewrite (M1_semantics_1 a1 a0). Reflexivity. - Intro H1. Rewrite H1. Rewrite (M1_semantics_2 a a1 a0 H1). Reflexivity. - Intros. Cut (MapMerge (M2 m0 m1) (M2 m2 m3))=(M2 (MapMerge m0 m2) (MapMerge m1 m3)). - Intro. Rewrite H3. Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). - Rewrite (H m2 (ad_div_2 a)). Rewrite (MapGet_M2_bit_0_if m2 m3 a). - Rewrite (MapGet_M2_bit_0_if m0 m1 a). Case (ad_bit_0 a); Trivial. - Reflexivity. + Lemma MapMerge_semantics : + forall m m':Map, + eqm (MapGet (MapMerge m m')) + (fun a0:ad => + match MapGet m' a0 with + | SOME y' => SOME y' + | NONE => MapGet m a0 + end). + Proof. + unfold eqm in |- *. simple induction m. intros. simpl in |- *. case (MapGet m' a); trivial. + intros. simpl in |- *. rewrite (MapPut_behind_semantics m' a a0 a1). reflexivity. + simple induction m'. trivial. + intros. unfold MapMerge in |- *. rewrite (MapPut_semantics (M2 m0 m1) a a0 a1). + elim (sumbool_of_bool (ad_eq a a1)). intro H1. rewrite H1. rewrite (ad_eq_complete _ _ H1). + rewrite (M1_semantics_1 a1 a0). reflexivity. + intro H1. rewrite H1. rewrite (M1_semantics_2 a a1 a0 H1). reflexivity. + intros. cut (MapMerge (M2 m0 m1) (M2 m2 m3) = M2 (MapMerge m0 m2) (MapMerge m1 m3)). + intro. rewrite H3. rewrite MapGet_M2_bit_0_if. rewrite (H0 m3 (ad_div_2 a)). + rewrite (H m2 (ad_div_2 a)). rewrite (MapGet_M2_bit_0_if m2 m3 a). + rewrite (MapGet_M2_bit_0_if m0 m1 a). case (ad_bit_0 a); trivial. + reflexivity. Qed. (** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse] not implemented: need a decidable equality on [A]. *) - Fixpoint MapDelta [m:Map] : Map -> Map := - Cases m of - M0 => [m':Map] m' - | (M1 a y) => [m':Map] Cases (MapGet m' a) of - NONE => (MapPut m' a y) - | _ => (MapRemove m' a) - end - | (M2 m1 m2) => [m':Map] Cases m' of - M0 => m - | (M1 a' y') => Cases (MapGet m a') of - NONE => (MapPut m a' y') - | _ => (MapRemove m a') - end - | (M2 m'1 m'2) => (makeM2 (MapDelta m1 m'1) - (MapDelta m2 m'2)) - end - end. - - Lemma MapDelta_semantics_comm : (m,m':Map) - (eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))). - Proof. - Unfold eqm. Induction m. Induction m'; Reflexivity. - Induction m'. Reflexivity. - Unfold MapDelta. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. - Rewrite <- (ad_eq_complete ? ? H). Rewrite (M1_semantics_1 a a2). - Rewrite (M1_semantics_1 a a0). Simpl. Rewrite (ad_eq_correct a). Reflexivity. - Intro H. Rewrite (M1_semantics_2 a a1 a0 H). Rewrite (ad_eq_comm a a1) in H. - Rewrite (M1_semantics_2 a1 a a2 H). Rewrite (MapPut_semantics (M1 a a0) a1 a2 a3). - Rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). Elim (sumbool_of_bool (ad_eq a a3)). - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0) in H. Rewrite H. - Rewrite (ad_eq_complete ? ? H0). Rewrite (M1_semantics_1 a3 a0). Reflexivity. - Intro H0. Rewrite H0. Rewrite (M1_semantics_2 a a3 a0 H0). - Elim (sumbool_of_bool (ad_eq a1 a3)). Intro H1. Rewrite H1. - Rewrite (ad_eq_complete ? ? H1). Exact (M1_semantics_1 a3 a2). - Intro H1. Rewrite H1. Exact (M1_semantics_2 a1 a3 a2 H1). - Intros. Reflexivity. - Induction m'. Reflexivity. - Reflexivity. - Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a). - Rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a). - Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). Reflexivity. - Qed. - - Lemma MapDelta_semantics_1_1 : (a:ad) (y:A) (m':Map) (a0:ad) - (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=NONE -> - (MapGet (MapDelta (M1 a y) m') a0)=NONE. - Proof. - Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H. - Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption. - Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial. - Qed. - - Lemma MapDelta_semantics_1 : (m,m':Map) (a:ad) - (MapGet m a)=NONE -> (MapGet m' a)=NONE -> - (MapGet (MapDelta m m') a)=NONE. - Proof. - Induction m. Trivial. - Exact MapDelta_semantics_1_1. - Induction m'. Trivial. - Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - Apply MapDelta_semantics_1_1; Trivial. - Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5. - Apply H0. Rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. Exact H3. - Rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. Exact H4. - Intro H5. Rewrite H5. Apply H. Rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. Exact H3. - Rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. Exact H4. - Qed. - - Lemma MapDelta_semantics_2_1 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A) - (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=(SOME y0) -> - (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0). - Proof. - Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H. - Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption. - Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial. - Qed. - - Lemma MapDelta_semantics_2_2 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A) - (MapGet (M1 a y) a0)=(SOME y0) -> (MapGet m' a0)=NONE -> - (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0). - Proof. - Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_eq_complete ? ? H1). - Rewrite H0. Rewrite (MapPut_semantics m' a0 y a0). Rewrite (ad_eq_correct a0). - Rewrite (M1_semantics_1 a0 y) in H. Simple Inversion H. Assumption. - Intro H1. Rewrite (M1_semantics_2 a a0 y H1) in H. Discriminate H. - Qed. - - Lemma MapDelta_semantics_2 : (m,m':Map) (a:ad) (y:A) - (MapGet m a)=NONE -> (MapGet m' a)=(SOME y) -> - (MapGet (MapDelta m m') a)=(SOME y). - Proof. - Induction m. Trivial. - Exact MapDelta_semantics_2_1. - Induction m'. Intros. Discriminate H2. - Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - Apply MapDelta_semantics_2_2; Assumption. - Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5. - Apply H0. Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption. - Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption. - Intro H5. Rewrite H5. Apply H. Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption. - Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption. - Qed. - - Lemma MapDelta_semantics_3_1 : (a0:ad) (y0:A) (m':Map) (a:ad) (y,y':A) - (MapGet (M1 a0 y0) a)=(SOME y) -> (MapGet m' a)=(SOME y') -> - (MapGet (MapDelta (M1 a0 y0) m') a)=NONE. - Proof. - Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H1. - Rewrite (ad_eq_complete a0 a H1). Rewrite H0. Rewrite (MapRemove_semantics m' a a). - Rewrite (ad_eq_correct a). Reflexivity. - Intro H1. Rewrite (M1_semantics_2 a0 a y0 H1) in H. Discriminate H. - Qed. - - Lemma MapDelta_semantics_3 : (m,m':Map) (a:ad) (y,y':A) - (MapGet m a)=(SOME y) -> (MapGet m' a)=(SOME y') -> - (MapGet (MapDelta m m') a)=NONE. - Proof. - Induction m. Intros. Discriminate H. - Exact MapDelta_semantics_3_1. - Induction m'. Intros. Discriminate H2. - Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). - Exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1). - Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). - Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5. - Apply (H0 m3 (ad_div_2 a) y y'). Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption. - Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption. - Intro H5. Rewrite H5. Apply (H m2 (ad_div_2 a) y y'). - Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption. - Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption. - Qed. - - Lemma MapDelta_semantics : (m,m':Map) - (eqm (MapGet (MapDelta m m')) - [a0:ad] Cases (MapGet m a0) (MapGet m' a0) of - NONE (SOME y') => (SOME y') - | (SOME y) NONE => (SOME y) - | _ _ => NONE - end). - Proof. - Unfold eqm. Intros. Elim (option_sum (MapGet m' a)). Intro H. Elim H. Intros a0 H0. - Rewrite H0. Elim (option_sum (MapGet m a)). Intro H1. Elim H1. Intros a1 H2. Rewrite H2. - Exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0). - Intro H1. Rewrite H1. Exact (MapDelta_semantics_2 m m' a a0 H1 H0). - Intro H. Rewrite H. Elim (option_sum (MapGet m a)). Intro H0. Elim H0. Intros a0 H1. - Rewrite H1. Rewrite (MapDelta_semantics_comm m m' a). - Exact (MapDelta_semantics_2 m' m a a0 H H1). - Intro H0. Rewrite H0. Exact (MapDelta_semantics_1 m m' a H0 H). - Qed. - - Definition MapEmptyp := [m:Map] - Cases m of - M0 => true - | _ => false + Fixpoint MapDelta (m:Map) : Map -> Map := + match m with + | M0 => fun m':Map => m' + | M1 a y => + fun m':Map => + match MapGet m' a with + | NONE => MapPut m' a y + | _ => MapRemove m' a + end + | M2 m1 m2 => + fun m':Map => + match m' with + | M0 => m + | M1 a' y' => + match MapGet m a' with + | NONE => MapPut m a' y' + | _ => MapRemove m a' + end + | M2 m'1 m'2 => makeM2 (MapDelta m1 m'1) (MapDelta m2 m'2) + end end. - Lemma MapEmptyp_correct : (MapEmptyp M0)=true. - Proof. - Reflexivity. - Qed. - - Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0. + Lemma MapDelta_semantics_comm : + forall m m':Map, eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m)). + Proof. + unfold eqm in |- *. simple induction m. simple induction m'; reflexivity. + simple induction m'. reflexivity. + unfold MapDelta in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H. + rewrite <- (ad_eq_complete _ _ H). rewrite (M1_semantics_1 a a2). + rewrite (M1_semantics_1 a a0). simpl in |- *. rewrite (ad_eq_correct a). reflexivity. + intro H. rewrite (M1_semantics_2 a a1 a0 H). rewrite (ad_eq_comm a a1) in H. + rewrite (M1_semantics_2 a1 a a2 H). rewrite (MapPut_semantics (M1 a a0) a1 a2 a3). + rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). elim (sumbool_of_bool (ad_eq a a3)). + intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0) in H. rewrite H. + rewrite (ad_eq_complete _ _ H0). rewrite (M1_semantics_1 a3 a0). reflexivity. + intro H0. rewrite H0. rewrite (M1_semantics_2 a a3 a0 H0). + elim (sumbool_of_bool (ad_eq a1 a3)). intro H1. rewrite H1. + rewrite (ad_eq_complete _ _ H1). exact (M1_semantics_1 a3 a2). + intro H1. rewrite H1. exact (M1_semantics_2 a1 a3 a2 H1). + intros. reflexivity. + simple induction m'. reflexivity. + reflexivity. + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a). + rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a). + rewrite (H0 m3 (ad_div_2 a)). rewrite (H m2 (ad_div_2 a)). reflexivity. + Qed. + + Lemma MapDelta_semantics_1_1 : + forall (a:ad) (y:A) (m':Map) (a0:ad), + MapGet (M1 a y) a0 = NONE -> + MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = NONE. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1. + rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. + intro H1. case (MapGet m' a). rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. + rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial. + Qed. + + Lemma MapDelta_semantics_1 : + forall (m m':Map) (a:ad), + MapGet m a = NONE -> + MapGet m' a = NONE -> MapGet (MapDelta m m') a = NONE. + Proof. + simple induction m. trivial. + exact MapDelta_semantics_1_1. + simple induction m'. trivial. + intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). + apply MapDelta_semantics_1_1; trivial. + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5. + apply H0. rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. exact H3. + rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. exact H4. + intro H5. rewrite H5. apply H. rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. exact H3. + rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. exact H4. + Qed. + + Lemma MapDelta_semantics_2_1 : + forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), + MapGet (M1 a y) a0 = NONE -> + MapGet m' a0 = SOME y0 -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1. + rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 a0 y) in H. discriminate H. + intro H1. case (MapGet m' a). rewrite (MapPut_semantics m' a y a0). rewrite H1. assumption. + rewrite (MapRemove_semantics m' a a0). rewrite H1. trivial. + Qed. + + Lemma MapDelta_semantics_2_2 : + forall (a:ad) (y:A) (m':Map) (a0:ad) (y0:A), + MapGet (M1 a y) a0 = SOME y0 -> + MapGet m' a0 = NONE -> MapGet (MapDelta (M1 a y) m') a0 = SOME y0. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a a0)). intro H1. + rewrite (ad_eq_complete _ _ H1) in H. rewrite (ad_eq_complete _ _ H1). + rewrite H0. rewrite (MapPut_semantics m' a0 y a0). rewrite (ad_eq_correct a0). + rewrite (M1_semantics_1 a0 y) in H. simple inversion H. assumption. + intro H1. rewrite (M1_semantics_2 a a0 y H1) in H. discriminate H. + Qed. + + Lemma MapDelta_semantics_2 : + forall (m m':Map) (a:ad) (y:A), + MapGet m a = NONE -> + MapGet m' a = SOME y -> MapGet (MapDelta m m') a = SOME y. + Proof. + simple induction m. trivial. + exact MapDelta_semantics_2_1. + simple induction m'. intros. discriminate H2. + intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). + apply MapDelta_semantics_2_2; assumption. + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5. + apply H0. rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. + rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption. + intro H5. rewrite H5. apply H. rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption. + rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption. + Qed. + + Lemma MapDelta_semantics_3_1 : + forall (a0:ad) (y0:A) (m':Map) (a:ad) (y y':A), + MapGet (M1 a0 y0) a = SOME y -> + MapGet m' a = SOME y' -> MapGet (MapDelta (M1 a0 y0) m') a = NONE. + Proof. + intros. unfold MapDelta in |- *. elim (sumbool_of_bool (ad_eq a0 a)). intro H1. + rewrite (ad_eq_complete a0 a H1). rewrite H0. rewrite (MapRemove_semantics m' a a). + rewrite (ad_eq_correct a). reflexivity. + intro H1. rewrite (M1_semantics_2 a0 a y0 H1) in H. discriminate H. + Qed. + + Lemma MapDelta_semantics_3 : + forall (m m':Map) (a:ad) (y y':A), + MapGet m a = SOME y -> + MapGet m' a = SOME y' -> MapGet (MapDelta m m') a = NONE. + Proof. + simple induction m. intros. discriminate H. + exact MapDelta_semantics_3_1. + simple induction m'. intros. discriminate H2. + intros. rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1). + exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1). + intros. simpl in |- *. rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a). + rewrite MapGet_M2_bit_0_if. elim (sumbool_of_bool (ad_bit_0 a)). intro H5. rewrite H5. + apply (H0 m3 (ad_div_2 a) y y'). rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). assumption. + rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). assumption. + intro H5. rewrite H5. apply (H m2 (ad_div_2 a) y y'). + rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). assumption. + rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). assumption. + Qed. + + Lemma MapDelta_semantics : + forall m m':Map, + eqm (MapGet (MapDelta m m')) + (fun a0:ad => + match MapGet m a0, MapGet m' a0 with + | NONE, SOME y' => SOME y' + | SOME y, NONE => SOME y + | _, _ => NONE + end). + Proof. + unfold eqm in |- *. intros. elim (option_sum (MapGet m' a)). intro H. elim H. intros a0 H0. + rewrite H0. elim (option_sum (MapGet m a)). intro H1. elim H1. intros a1 H2. rewrite H2. + exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0). + intro H1. rewrite H1. exact (MapDelta_semantics_2 m m' a a0 H1 H0). + intro H. rewrite H. elim (option_sum (MapGet m a)). intro H0. elim H0. intros a0 H1. + rewrite H1. rewrite (MapDelta_semantics_comm m m' a). + exact (MapDelta_semantics_2 m' m a a0 H H1). + intro H0. rewrite H0. exact (MapDelta_semantics_1 m m' a H0 H). + Qed. + + Definition MapEmptyp (m:Map) := match m with + | M0 => true + | _ => false + end. + + Lemma MapEmptyp_correct : MapEmptyp M0 = true. Proof. - Induction m; Trivial. Intros. Discriminate H. - Intros. Discriminate H1. + reflexivity. + Qed. + + Lemma MapEmptyp_complete : forall m:Map, MapEmptyp m = true -> m = M0. + Proof. + simple induction m; trivial. intros. discriminate H. + intros. discriminate H1. Qed. (** [MapSplit] not implemented: not the preferred way of recursing over Maps (use [MapSweep], [MapCollect], or [MapFold] in Mapiter.v. *) -End MapDefs. +End MapDefs.
\ No newline at end of file diff --git a/theories/IntMap/Mapaxioms.v b/theories/IntMap/Mapaxioms.v index 7ab131c77..874a4b9ef 100644 --- a/theories/IntMap/Mapaxioms.v +++ b/theories/IntMap/Mapaxioms.v @@ -7,664 +7,757 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. Section MapAxioms. - Variable A, B, C : Set. + Variables A B C : Set. - Lemma eqm_sym : (f,f':ad->(option A)) (eqm A f f') -> (eqm A f' f). + Lemma eqm_sym : forall f f':ad -> option A, eqm A f f' -> eqm A f' f. Proof. - Unfold eqm. Intros. Rewrite H. Reflexivity. + unfold eqm in |- *. intros. rewrite H. reflexivity. Qed. - Lemma eqm_refl : (f:ad->(option A)) (eqm A f f). + Lemma eqm_refl : forall f:ad -> option A, eqm A f f. Proof. - Unfold eqm. Trivial. + unfold eqm in |- *. trivial. Qed. - Lemma eqm_trans : (f,f',f'':ad->(option A)) (eqm A f f') -> (eqm A f' f'') -> (eqm A f f''). + Lemma eqm_trans : + forall f f' f'':ad -> option A, eqm A f f' -> eqm A f' f'' -> eqm A f f''. Proof. - Unfold eqm. Intros. Rewrite H. Exact (H0 a). + unfold eqm in |- *. intros. rewrite H. exact (H0 a). Qed. - Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')). + Definition eqmap (m m':Map A) := eqm A (MapGet A m) (MapGet A m'). - Lemma eqmap_sym : (m,m':(Map A)) (eqmap m m') -> (eqmap m' m). + Lemma eqmap_sym : forall m m':Map A, eqmap m m' -> eqmap m' m. Proof. - Intros. Unfold eqmap. Apply eqm_sym. Assumption. + intros. unfold eqmap in |- *. apply eqm_sym. assumption. Qed. - Lemma eqmap_refl : (m:(Map A)) (eqmap m m). + Lemma eqmap_refl : forall m:Map A, eqmap m m. Proof. - Intros. Unfold eqmap. Apply eqm_refl. + intros. unfold eqmap in |- *. apply eqm_refl. Qed. - Lemma eqmap_trans : (m,m',m'':(Map A)) (eqmap m m') -> (eqmap m' m'') -> (eqmap m m''). + Lemma eqmap_trans : + forall m m' m'':Map A, eqmap m m' -> eqmap m' m'' -> eqmap m m''. Proof. - Intros. Exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0). + intros. exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0). Qed. - Lemma MapPut_as_Merge : (m:(Map A)) (a:ad) (y:A) - (eqmap (MapPut A m a y) (MapMerge A m (M1 A a y))). + Lemma MapPut_as_Merge : + forall (m:Map A) (a:ad) (y:A), + eqmap (MapPut A m a y) (MapMerge A m (M1 A a y)). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m a y a0). - Rewrite (MapMerge_semantics A m (M1 A a y) a0). Unfold 2 MapGet. - Elim (sumbool_of_bool (ad_eq a a0)); Intro H; Rewrite H; Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m a y a0). + rewrite (MapMerge_semantics A m (M1 A a y) a0). unfold MapGet at 2 in |- *. + elim (sumbool_of_bool (ad_eq a a0)); intro H; rewrite H; reflexivity. Qed. - Lemma MapPut_ext : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (y:A) (eqmap (MapPut A m a y) (MapPut A m' a y)). + Lemma MapPut_ext : + forall m m':Map A, + eqmap m m' -> + forall (a:ad) (y:A), eqmap (MapPut A m a y) (MapPut A m' a y). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m' a y a0). - Rewrite (MapPut_semantics A m a y a0). - Case (ad_eq a a0); [ Reflexivity | Apply H ]. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_semantics A m' a y a0). + rewrite (MapPut_semantics A m a y a0). + case (ad_eq a a0); [ reflexivity | apply H ]. Qed. - Lemma MapPut_behind_as_Merge : (m:(Map A)) (a:ad) (y:A) - (eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m)). + Lemma MapPut_behind_as_Merge : + forall (m:Map A) (a:ad) (y:A), + eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m a y a0). - Rewrite (MapMerge_semantics A (M1 A a y) m a0). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m a y a0). + rewrite (MapMerge_semantics A (M1 A a y) m a0). reflexivity. Qed. - Lemma MapPut_behind_ext : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)). + Lemma MapPut_behind_ext : + forall m m':Map A, + eqmap m m' -> + forall (a:ad) (y:A), + eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m' a y a0). - Rewrite (MapPut_behind_semantics A m a y a0). Rewrite (H a0). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapPut_behind_semantics A m' a y a0). + rewrite (MapPut_behind_semantics A m a y a0). rewrite (H a0). reflexivity. Qed. - Lemma MapMerge_empty_m_1 : (m:(Map A)) (MapMerge A (M0 A) m)=m. + Lemma MapMerge_empty_m_1 : forall m:Map A, MapMerge A (M0 A) m = m. Proof. - Trivial. + trivial. Qed. - Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 A) m) m). + Lemma MapMerge_empty_m : forall m:Map A, eqmap (MapMerge A (M0 A) m) m. Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m. + Lemma MapMerge_m_empty_1 : forall m:Map A, MapMerge A m (M0 A) = m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m). + Lemma MapMerge_m_empty : forall m:Map A, eqmap (MapMerge A m (M0 A)) m. Proof. - Unfold eqmap eqm. Intros. Rewrite MapMerge_m_empty_1. Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite MapMerge_m_empty_1. reflexivity. Qed. - Lemma MapMerge_empty_l : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) -> - (eqmap m (M0 A)). + Lemma MapMerge_empty_l : + forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m (M0 A). Proof. - Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a). - Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial. - Intros. Discriminate H0. - Exact (H a). + unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). + rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial. + intros. discriminate H0. + exact (H a). Qed. - Lemma MapMerge_empty_r : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) -> - (eqmap m' (M0 A)). + Lemma MapMerge_empty_r : + forall m m':Map A, eqmap (MapMerge A m m') (M0 A) -> eqmap m' (M0 A). Proof. - Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a). - Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial. - Intros. Discriminate H0. - Exact (H a). + unfold eqmap, eqm in |- *. intros. cut (MapGet A (MapMerge A m m') a = MapGet A (M0 A) a). + rewrite (MapMerge_semantics A m m' a). case (MapGet A m' a). trivial. + intros. discriminate H0. + exact (H a). Qed. - Lemma MapMerge_assoc : (m,m',m'':(Map A)) (eqmap - (MapMerge A (MapMerge A m m') m'') - (MapMerge A m (MapMerge A m' m''))). + Lemma MapMerge_assoc : + forall m m' m'':Map A, + eqmap (MapMerge A (MapMerge A m m') m'') + (MapMerge A m (MapMerge A m' m'')). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapMerge A m m') m'' a). - Rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). Rewrite (MapMerge_semantics A m m' a). - Rewrite (MapMerge_semantics A m' m'' a). - Case (MapGet A m'' a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapMerge A m m') m'' a). + rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). rewrite (MapMerge_semantics A m m' a). + rewrite (MapMerge_semantics A m' m'' a). + case (MapGet A m'' a); case (MapGet A m' a); trivial. Qed. - Lemma MapMerge_idempotent : (m:(Map A)) (eqmap (MapMerge A m m) m). + Lemma MapMerge_idempotent : forall m:Map A, eqmap (MapMerge A m m) m. Proof. - Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m m a). - Case (MapGet A m a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m m a). + case (MapGet A m a); trivial. Qed. - Lemma MapMerge_ext : (m1,m2,m'1,m'2:(Map A)) - (eqmap m1 m'1) -> (eqmap m2 m'2) -> - (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2)). + Lemma MapMerge_ext : + forall m1 m2 m'1 m'2:Map A, + eqmap m1 m'1 -> + eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m1 m2 a). - Rewrite (MapMerge_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A m1 m2 a). + rewrite (MapMerge_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. - Lemma MapMerge_ext_l : (m1,m'1,m2:(Map A)) - (eqmap m1 m'1) -> (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2)). + Lemma MapMerge_ext_l : + forall m1 m'1 m2:Map A, + eqmap m1 m'1 -> eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2). Proof. - Intros. Apply MapMerge_ext. Assumption. - Apply eqmap_refl. + intros. apply MapMerge_ext. assumption. + apply eqmap_refl. Qed. - Lemma MapMerge_ext_r : (m1,m2,m'2:(Map A)) - (eqmap m2 m'2) -> (eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2)). + Lemma MapMerge_ext_r : + forall m1 m2 m'2:Map A, + eqmap m2 m'2 -> eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2). Proof. - Intros. Apply MapMerge_ext. Apply eqmap_refl. - Assumption. + intros. apply MapMerge_ext. apply eqmap_refl. + assumption. Qed. - Lemma MapMerge_RestrTo_l : (m,m',m'':(Map A)) - (eqmap (MapMerge A (MapDomRestrTo A A m m') m'') - (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''))). + Lemma MapMerge_RestrTo_l : + forall m m' m'':Map A, + eqmap (MapMerge A (MapDomRestrTo A A m m') m'') + (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a). - Rewrite (MapDomRestrTo_semantics A A m m' a). - Rewrite (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a). - Rewrite (MapMerge_semantics A m' m'' a). Rewrite (MapMerge_semantics A m m'' a). - Case (MapGet A m'' a); Case (MapGet A m' a); Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a). + rewrite (MapDomRestrTo_semantics A A m m' a). + rewrite + (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a) + . + rewrite (MapMerge_semantics A m' m'' a). rewrite (MapMerge_semantics A m m'' a). + case (MapGet A m'' a); case (MapGet A m' a); reflexivity. Qed. - Lemma MapRemove_as_RestrBy : (m:(Map A)) (a:ad) (y:B) - (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))). + Lemma MapRemove_as_RestrBy : + forall (m:Map A) (a:ad) (y:B), + eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y)). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m a a0). - Rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). Elim (sumbool_of_bool (ad_eq a a0)). - Intro H. Rewrite H. Rewrite (ad_eq_complete a a0 H). Rewrite (M1_semantics_1 B a0 y). - Reflexivity. - Intro H. Rewrite H. Rewrite (M1_semantics_2 B a a0 y H). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m a a0). + rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). elim (sumbool_of_bool (ad_eq a a0)). + intro H. rewrite H. rewrite (ad_eq_complete a a0 H). rewrite (M1_semantics_1 B a0 y). + reflexivity. + intro H. rewrite H. rewrite (M1_semantics_2 B a a0 y H). reflexivity. Qed. - Lemma MapRemove_ext : (m,m':(Map A)) (eqmap m m') -> - (a:ad) (eqmap (MapRemove A m a) (MapRemove A m' a)). + Lemma MapRemove_ext : + forall m m':Map A, + eqmap m m' -> forall a:ad, eqmap (MapRemove A m a) (MapRemove A m' a). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m' a a0). - Rewrite (MapRemove_semantics A m a a0). - Case (ad_eq a a0); [ Reflexivity | Apply H ]. + unfold eqmap, eqm in |- *. intros. rewrite (MapRemove_semantics A m' a a0). + rewrite (MapRemove_semantics A m a a0). + case (ad_eq a a0); [ reflexivity | apply H ]. Qed. - Lemma MapDomRestrTo_empty_m_1 : - (m:(Map B)) (MapDomRestrTo A B (M0 A) m)=(M0 A). + Lemma MapDomRestrTo_empty_m_1 : + forall m:Map B, MapDomRestrTo A B (M0 A) m = M0 A. Proof. - Trivial. + trivial. Qed. - Lemma MapDomRestrTo_empty_m : - (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 A) m) (M0 A)). + Lemma MapDomRestrTo_empty_m : + forall m:Map B, eqmap (MapDomRestrTo A B (M0 A) m) (M0 A). Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapDomRestrTo_m_empty_1 : - (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A). + Lemma MapDomRestrTo_m_empty_1 : + forall m:Map A, MapDomRestrTo A B m (M0 B) = M0 A. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapDomRestrTo_m_empty : - (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)). + Lemma MapDomRestrTo_m_empty : + forall m:Map A, eqmap (MapDomRestrTo A B m (M0 B)) (M0 A). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_m_empty_1 m). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_m_empty_1 m). reflexivity. Qed. - Lemma MapDomRestrTo_assoc : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B m (MapDomRestrTo B C m' m''))). + Lemma MapDomRestrTo_assoc : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a). - Rewrite (MapDomRestrTo_semantics B C m' m'' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a). + rewrite (MapDomRestrTo_semantics B C m' m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_idempotent : (m:(Map A)) (eqmap (MapDomRestrTo A A m m) m). + Lemma MapDomRestrTo_idempotent : + forall m:Map A, eqmap (MapDomRestrTo A A m m) m. Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A A m m a). - Case (MapGet A m a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A A m m a). + case (MapGet A m a); trivial. Qed. - Lemma MapDomRestrTo_Dom : (m:(Map A)) (m':(Map B)) - (eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m'))). + Lemma MapDomRestrTo_Dom : + forall (m:Map A) (m':Map B), + eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m')). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a). - Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H. - Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0. Unfold in_FSet in_dom in H. - Generalize H. Case (MapGet unit (MapDom B m') a); Trivial. Intro H1. Discriminate H1. - Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H. - Generalize H. Case (MapGet unit (MapDom B m') a). Trivial. - Intros H0 H1. Discriminate H1. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a). + elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H. + elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. unfold in_FSet, in_dom in H. + generalize H. case (MapGet unit (MapDom B m') a); trivial. intro H1. discriminate H1. + intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. + generalize H. case (MapGet unit (MapDom B m') a). trivial. + intros H0 H1. discriminate H1. Qed. - Lemma MapDomRestrBy_empty_m_1 : - (m:(Map B)) (MapDomRestrBy A B (M0 A) m)=(M0 A). + Lemma MapDomRestrBy_empty_m_1 : + forall m:Map B, MapDomRestrBy A B (M0 A) m = M0 A. Proof. - Trivial. + trivial. Qed. - Lemma MapDomRestrBy_empty_m : - (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 A) m) (M0 A)). + Lemma MapDomRestrBy_empty_m : + forall m:Map B, eqmap (MapDomRestrBy A B (M0 A) m) (M0 A). Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m. + Lemma MapDomRestrBy_m_empty_1 : + forall m:Map A, MapDomRestrBy A B m (M0 B) = m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m). + Lemma MapDomRestrBy_m_empty : + forall m:Map A, eqmap (MapDomRestrBy A B m (M0 B)) m. Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_m_empty_1 m). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_m_empty_1 m). reflexivity. Qed. - Lemma MapDomRestrBy_Dom : (m:(Map A)) (m':(Map B)) - (eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m'))). + Lemma MapDomRestrBy_Dom : + forall (m:Map A) (m':Map B), + eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m')). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a). - Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H. - Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0. - Unfold in_FSet in_dom in H. Generalize H. Case (MapGet unit (MapDom B m') a); Trivial. - Intro H1. Discriminate H1. - Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H. - Generalize H. Case (MapGet unit (MapDom B m') a). Trivial. - Intros H0 H1. Discriminate H1. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a). + elim (sumbool_of_bool (in_FSet a (MapDom B m'))). intro H. + elim (MapDom_semantics_2 B m' a H). intros y H0. rewrite H0. + unfold in_FSet, in_dom in H. generalize H. case (MapGet unit (MapDom B m') a); trivial. + intro H1. discriminate H1. + intro H. rewrite (MapDom_semantics_4 B m' a H). unfold in_FSet, in_dom in H. + generalize H. case (MapGet unit (MapDom B m') a). trivial. + intros H0 H1. discriminate H1. Qed. - Lemma MapDomRestrBy_m_m_1 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)). + Lemma MapDomRestrBy_m_m_1 : + forall m:Map A, eqmap (MapDomRestrBy A A m m) (M0 A). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A A m m a). - Case (MapGet A m a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A A m m a). + case (MapGet A m a); trivial. Qed. - Lemma MapDomRestrBy_By : (m:(Map A)) (m':(Map B)) (m'':(Map B)) - (eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'') - (MapDomRestrBy A B m (MapMerge B m' m''))). + Lemma MapDomRestrBy_By : + forall (m:Map A) (m' m'':Map B), + eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'') + (MapDomRestrBy A B m (MapMerge B m' m'')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a). - Rewrite (MapMerge_semantics B m' m'' a). - Case (MapGet B m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a). + rewrite (MapMerge_semantics B m' m'' a). + case (MapGet B m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrBy_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'') - (MapDomRestrBy A B (MapDomRestrBy A C m m'') m')). + Lemma MapDomRestrBy_By_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'') + (MapDomRestrBy A B (MapDomRestrBy A C m m'') m'). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a). - Rewrite (MapDomRestrBy_semantics A C m m'' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a). + rewrite (MapDomRestrBy_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrBy_To : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B m (MapDomRestrBy B C m' m''))). + Lemma MapDomRestrBy_To : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a). - Rewrite (MapDomRestrBy_semantics B C m' m'' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a). + rewrite (MapDomRestrBy_semantics B C m' m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrBy_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B (MapDomRestrBy A C m m'') m')). + Lemma MapDomRestrBy_To_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B (MapDomRestrBy A C m m'') m'). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a). - Rewrite (MapDomRestrBy_semantics A C m m'' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a). + rewrite (MapDomRestrBy_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_By : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') - (MapDomRestrTo A C m (MapDomRestrBy C B m'' m'))). + Lemma MapDomRestrTo_By : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') + (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a). - Rewrite (MapDomRestrBy_semantics C B m'' m' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a). + rewrite (MapDomRestrBy_semantics C B m'' m' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') - (MapDomRestrBy A B (MapDomRestrTo A C m m'') m')). + Lemma MapDomRestrTo_By_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'') + (MapDomRestrBy A B (MapDomRestrTo A C m m'') m'). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a). - Rewrite (MapDomRestrTo_semantics A C m m'' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a). + rewrite (MapDomRestrTo_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapDomRestrTo_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') - (MapDomRestrTo A B (MapDomRestrTo A C m m'') m')). + Lemma MapDomRestrTo_To_comm : + forall (m:Map A) (m':Map B) (m'':Map C), + eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'') + (MapDomRestrTo A B (MapDomRestrTo A C m m'') m'). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a). - Rewrite (MapDomRestrTo_semantics A C m m'' a). - Case (MapGet C m'' a); Case (MapGet B m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a). + rewrite (MapDomRestrTo_semantics A C m m'' a). + case (MapGet C m'' a); case (MapGet B m' a); trivial. Qed. - Lemma MapMerge_DomRestrTo : (m,m':(Map A)) (m'':(Map B)) - (eqmap (MapDomRestrTo A B (MapMerge A m m') m'') - (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''))). + Lemma MapMerge_DomRestrTo : + forall (m m':Map A) (m'':Map B), + eqmap (MapDomRestrTo A B (MapMerge A m m') m'') + (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a). - Rewrite (MapMerge_semantics A m m' a). - Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'') a). - Rewrite (MapDomRestrTo_semantics A B m' m'' a). - Rewrite (MapDomRestrTo_semantics A B m m'' a). - Case (MapGet B m'' a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a). + rewrite (MapMerge_semantics A m m' a). + rewrite + (MapMerge_semantics A (MapDomRestrTo A B m m'') + (MapDomRestrTo A B m' m'') a). + rewrite (MapDomRestrTo_semantics A B m' m'' a). + rewrite (MapDomRestrTo_semantics A B m m'' a). + case (MapGet B m'' a); case (MapGet A m' a); trivial. Qed. - Lemma MapMerge_DomRestrBy : (m,m':(Map A)) (m'':(Map B)) - (eqmap (MapDomRestrBy A B (MapMerge A m m') m'') - (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''))). + Lemma MapMerge_DomRestrBy : + forall (m m':Map A) (m'':Map B), + eqmap (MapDomRestrBy A B (MapMerge A m m') m'') + (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a). - Rewrite (MapMerge_semantics A m m' a). - Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'') a). - Rewrite (MapDomRestrBy_semantics A B m' m'' a). - Rewrite (MapDomRestrBy_semantics A B m m'' a). - Case (MapGet B m'' a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a). + rewrite (MapMerge_semantics A m m' a). + rewrite + (MapMerge_semantics A (MapDomRestrBy A B m m'') + (MapDomRestrBy A B m' m'') a). + rewrite (MapDomRestrBy_semantics A B m' m'' a). + rewrite (MapDomRestrBy_semantics A B m m'' a). + case (MapGet B m'' a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_empty_m_1 : (m:(Map A)) (MapDelta A (M0 A) m)=m. + Lemma MapDelta_empty_m_1 : forall m:Map A, MapDelta A (M0 A) m = m. Proof. - Trivial. + trivial. Qed. - Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 A) m) m). + Lemma MapDelta_empty_m : forall m:Map A, eqmap (MapDelta A (M0 A) m) m. Proof. - Unfold eqmap eqm. Trivial. + unfold eqmap, eqm in |- *. trivial. Qed. - Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m. + Lemma MapDelta_m_empty_1 : forall m:Map A, MapDelta A m (M0 A) = m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m). + Lemma MapDelta_m_empty : forall m:Map A, eqmap (MapDelta A m (M0 A)) m. Proof. - Unfold eqmap eqm. Intros. Rewrite MapDelta_m_empty_1. Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite MapDelta_m_empty_1. reflexivity. Qed. - Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)). + Lemma MapDelta_nilpotent : forall m:Map A, eqmap (MapDelta A m m) (M0 A). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m a). - Case (MapGet A m a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m a). + case (MapGet A m a); trivial. Qed. - Lemma MapDelta_as_Merge : (m,m':(Map A)) (eqmap (MapDelta A m m') - (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m))). + Lemma MapDelta_as_Merge : + forall m m':Map A, + eqmap (MapDelta A m m') + (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDelta_semantics A m m' a). - Rewrite (MapMerge_semantics A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m) a). - Rewrite (MapDomRestrBy_semantics A A m' m a). - Rewrite (MapDomRestrBy_semantics A A m m' a). - Case (MapGet A m a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite (MapDelta_semantics A m m' a). + rewrite + (MapMerge_semantics A (MapDomRestrBy A A m m') ( + MapDomRestrBy A A m' m) a). + rewrite (MapDomRestrBy_semantics A A m' m a). + rewrite (MapDomRestrBy_semantics A A m m' a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_as_DomRestrBy : (m,m':(Map A)) (eqmap (MapDelta A m m') - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'))). + Lemma MapDelta_as_DomRestrBy : + forall m m':Map A, + eqmap (MapDelta A m m') + (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a). - Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m m') a). - Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite (MapMerge_semantics A m m' a). - Case (MapGet A m a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). + rewrite + (MapDomRestrBy_semantics A A (MapMerge A m m') ( + MapDomRestrTo A A m m') a). + rewrite (MapDomRestrTo_semantics A A m m' a). rewrite (MapMerge_semantics A m m' a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_as_DomRestrBy_2 : (m,m':(Map A)) (eqmap (MapDelta A m m') - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m))). + Lemma MapDelta_as_DomRestrBy_2 : + forall m m':Map A, + eqmap (MapDelta A m m') + (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a). - Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m' m) a). - Rewrite (MapDomRestrTo_semantics A A m' m a). Rewrite (MapMerge_semantics A m m' a). - Case (MapGet A m a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). + rewrite + (MapDomRestrBy_semantics A A (MapMerge A m m') ( + MapDomRestrTo A A m' m) a). + rewrite (MapDomRestrTo_semantics A A m' m a). rewrite (MapMerge_semantics A m m' a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_sym : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)). + Lemma MapDelta_sym : + forall m m':Map A, eqmap (MapDelta A m m') (MapDelta A m' m). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a). - Rewrite (MapDelta_semantics A m' m a). - Case (MapGet A m a); Case (MapGet A m' a); Trivial. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m m' a). + rewrite (MapDelta_semantics A m' m a). + case (MapGet A m a); case (MapGet A m' a); trivial. Qed. - Lemma MapDelta_ext : (m1,m2,m'1,m'2:(Map A)) - (eqmap m1 m'1) -> (eqmap m2 m'2) -> - (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2)). + Lemma MapDelta_ext : + forall m1 m2 m'1 m'2:Map A, + eqmap m1 m'1 -> + eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m1 m2 a). - Rewrite (MapDelta_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics A m1 m2 a). + rewrite (MapDelta_semantics A m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. - Lemma MapDelta_ext_l : (m1,m'1,m2:(Map A)) - (eqmap m1 m'1) -> (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2)). + Lemma MapDelta_ext_l : + forall m1 m'1 m2:Map A, + eqmap m1 m'1 -> eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2). Proof. - Intros. Apply MapDelta_ext. Assumption. - Apply eqmap_refl. + intros. apply MapDelta_ext. assumption. + apply eqmap_refl. Qed. - Lemma MapDelta_ext_r : (m1,m2,m'2:(Map A)) - (eqmap m2 m'2) -> (eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2)). + Lemma MapDelta_ext_r : + forall m1 m2 m'2:Map A, + eqmap m2 m'2 -> eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2). Proof. - Intros. Apply MapDelta_ext. Apply eqmap_refl. - Assumption. + intros. apply MapDelta_ext. apply eqmap_refl. + assumption. Qed. - Lemma MapDom_Split_1 : (m:(Map A)) (m':(Map B)) - (eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))). + Lemma MapDom_Split_1 : + forall (m:Map A) (m':Map B), + eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')). Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Case (MapGet B m' a); Case (MapGet A m a); Trivial. + unfold eqmap, eqm in |- *. intros. + rewrite + (MapMerge_semantics A (MapDomRestrTo A B m m') ( + MapDomRestrBy A B m m') a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + case (MapGet B m' a); case (MapGet A m a); trivial. Qed. - Lemma MapDom_Split_2 : (m:(Map A)) (m':(Map B)) - (eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'))). - Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m') a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Case (MapGet B m' a); Case (MapGet A m a); Trivial. - Qed. - - Lemma MapDom_Split_3 : (m:(Map A)) (m':(Map B)) - (eqmap (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) - (M0 A)). - Proof. - Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a). - Rewrite (MapDomRestrBy_semantics A B m m' a). - Rewrite (MapDomRestrTo_semantics A B m m' a). - Case (MapGet B m' a); Case (MapGet A m a); Trivial. + Lemma MapDom_Split_2 : + forall (m:Map A) (m':Map B), + eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')). + Proof. + unfold eqmap, eqm in |- *. intros. + rewrite + (MapMerge_semantics A (MapDomRestrBy A B m m') ( + MapDomRestrTo A B m m') a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + case (MapGet B m' a); case (MapGet A m a); trivial. + Qed. + + Lemma MapDom_Split_3 : + forall (m:Map A) (m':Map B), + eqmap + (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) + (M0 A). + Proof. + unfold eqmap, eqm in |- *. intros. + rewrite + (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') + (MapDomRestrBy A B m m') a). + rewrite (MapDomRestrBy_semantics A B m m' a). + rewrite (MapDomRestrTo_semantics A B m m' a). + case (MapGet B m' a); case (MapGet A m a); trivial. Qed. End MapAxioms. -Lemma MapDomRestrTo_ext : (A,B:Set) - (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B)) - (eqmap A m1 m'1) -> (eqmap B m2 m'2) -> - (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2)). +Lemma MapDomRestrTo_ext : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A) + (m'2:Map B), + eqmap A m1 m'1 -> + eqmap B m2 m'2 -> + eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m1 m2 a). - Rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrTo_semantics A B m1 m2 a). + rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. -Lemma MapDomRestrTo_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) - (eqmap A m1 m'1) -> - (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2)). +Lemma MapDomRestrTo_ext_l : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A), + eqmap A m1 m'1 -> + eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2). Proof. - Intros. Apply MapDomRestrTo_ext; [ Assumption | Apply eqmap_refl ]. + intros. apply MapDomRestrTo_ext; [ assumption | apply eqmap_refl ]. Qed. -Lemma MapDomRestrTo_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B)) - (eqmap B m2 m'2) -> - (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2)). +Lemma MapDomRestrTo_ext_r : + forall (A B:Set) (m1:Map A) (m2 m'2:Map B), + eqmap B m2 m'2 -> + eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2). Proof. - Intros. Apply MapDomRestrTo_ext; [ Apply eqmap_refl | Assumption ]. + intros. apply MapDomRestrTo_ext; [ apply eqmap_refl | assumption ]. Qed. -Lemma MapDomRestrBy_ext : (A,B:Set) - (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B)) - (eqmap A m1 m'1) -> (eqmap B m2 m'2) -> - (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2)). +Lemma MapDomRestrBy_ext : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A) + (m'2:Map B), + eqmap A m1 m'1 -> + eqmap B m2 m'2 -> + eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m1 m2 a). - Rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDomRestrBy_semantics A B m1 m2 a). + rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). rewrite (H a). rewrite (H0 a). reflexivity. Qed. -Lemma MapDomRestrBy_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) - (eqmap A m1 m'1) -> - (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2)). +Lemma MapDomRestrBy_ext_l : + forall (A B:Set) (m1:Map A) (m2:Map B) (m'1:Map A), + eqmap A m1 m'1 -> + eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2). Proof. - Intros. Apply MapDomRestrBy_ext; [ Assumption | Apply eqmap_refl ]. + intros. apply MapDomRestrBy_ext; [ assumption | apply eqmap_refl ]. Qed. -Lemma MapDomRestrBy_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B)) - (eqmap B m2 m'2) -> - (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2)). +Lemma MapDomRestrBy_ext_r : + forall (A B:Set) (m1:Map A) (m2 m'2:Map B), + eqmap B m2 m'2 -> + eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2). Proof. - Intros. Apply MapDomRestrBy_ext; [ Apply eqmap_refl | Assumption ]. + intros. apply MapDomRestrBy_ext; [ apply eqmap_refl | assumption ]. Qed. -Lemma MapDomRestrBy_m_m : (A:Set) (m:(Map A)) - (eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A)). +Lemma MapDomRestrBy_m_m : + forall (A:Set) (m:Map A), + eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A). Proof. - Intros. Apply eqmap_trans with m':=(MapDomRestrBy A A m m). Apply eqmap_sym. - Apply MapDomRestrBy_Dom. - Apply MapDomRestrBy_m_m_1. + intros. apply eqmap_trans with (m' := MapDomRestrBy A A m m). apply eqmap_sym. + apply MapDomRestrBy_Dom. + apply MapDomRestrBy_m_m_1. Qed. -Lemma FSetDelta_assoc : (s,s',s'':FSet) - (eqmap unit (MapDelta ? (MapDelta ? s s') s'') (MapDelta ? s (MapDelta ? s' s''))). +Lemma FSetDelta_assoc : + forall s s' s'':FSet, + eqmap unit (MapDelta _ (MapDelta _ s s') s'') + (MapDelta _ s (MapDelta _ s' s'')). Proof. - Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a). - Rewrite (MapDelta_semantics unit s s' a). - Rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a). - Rewrite (MapDelta_semantics unit s' s'' a). - Case (MapGet ? s a); Case (MapGet ? s' a); Case (MapGet ? s'' a); Trivial. - Intros. Elim u. Elim u1. Reflexivity. + unfold eqmap, eqm in |- *. intros. rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a). + rewrite (MapDelta_semantics unit s s' a). + rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a). + rewrite (MapDelta_semantics unit s' s'' a). + case (MapGet _ s a); case (MapGet _ s' a); case (MapGet _ s'' a); trivial. + intros. elim u. elim u1. reflexivity. Qed. -Lemma FSet_ext : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) -> (eqmap unit s s'). +Lemma FSet_ext : + forall s s':FSet, + (forall a:ad, in_FSet a s = in_FSet a s') -> eqmap unit s s'. Proof. - Unfold in_FSet eqmap eqm. Intros. Elim (sumbool_of_bool (in_dom ? a s)). Intro H0. - Elim (in_dom_some ? s a H0). Intros y H1. Rewrite (H a) in H0. Elim (in_dom_some ? s' a H0). - Intros y' H2. Rewrite H1. Rewrite H2. Elim y. Elim y'. Reflexivity. - Intro H0. Rewrite (in_dom_none ? s a H0). Rewrite (H a) in H0. Rewrite (in_dom_none ? s' a H0). - Reflexivity. + unfold in_FSet, eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_dom _ a s)). intro H0. + elim (in_dom_some _ s a H0). intros y H1. rewrite (H a) in H0. elim (in_dom_some _ s' a H0). + intros y' H2. rewrite H1. rewrite H2. elim y. elim y'. reflexivity. + intro H0. rewrite (in_dom_none _ s a H0). rewrite (H a) in H0. rewrite (in_dom_none _ s' a H0). + reflexivity. Qed. -Lemma FSetUnion_comm : (s,s':FSet) (eqmap unit (FSetUnion s s') (FSetUnion s' s)). +Lemma FSetUnion_comm : + forall s s':FSet, eqmap unit (FSetUnion s s') (FSetUnion s' s). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_union. Apply orb_sym. + intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_union. apply orb_comm. Qed. -Lemma FSetUnion_assoc : (s,s',s'':FSet) (eqmap unit - (FSetUnion (FSetUnion s s') s'') (FSetUnion s (FSetUnion s' s''))). +Lemma FSetUnion_assoc : + forall s s' s'':FSet, + eqmap unit (FSetUnion (FSetUnion s s') s'') + (FSetUnion s (FSetUnion s' s'')). Proof. - Exact (MapMerge_assoc unit). + exact (MapMerge_assoc unit). Qed. -Lemma FSetUnion_M0_s : (s:FSet) (eqmap unit (FSetUnion (M0 unit) s) s). +Lemma FSetUnion_M0_s : forall s:FSet, eqmap unit (FSetUnion (M0 unit) s) s. Proof. - Exact (MapMerge_empty_m unit). + exact (MapMerge_empty_m unit). Qed. -Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s). +Lemma FSetUnion_s_M0 : forall s:FSet, eqmap unit (FSetUnion s (M0 unit)) s. Proof. - Exact (MapMerge_m_empty unit). + exact (MapMerge_m_empty unit). Qed. -Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s s) s). +Lemma FSetUnion_idempotent : forall s:FSet, eqmap unit (FSetUnion s s) s. Proof. - Exact (MapMerge_idempotent unit). + exact (MapMerge_idempotent unit). Qed. -Lemma FSetInter_comm : (s,s':FSet) (eqmap unit (FSetInter s s') (FSetInter s' s)). +Lemma FSetInter_comm : + forall s s':FSet, eqmap unit (FSetInter s s') (FSetInter s' s). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_inter. Apply andb_sym. + intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_inter. apply andb_comm. Qed. -Lemma FSetInter_assoc : (s,s',s'':FSet) (eqmap unit - (FSetInter (FSetInter s s') s'') (FSetInter s (FSetInter s' s''))). +Lemma FSetInter_assoc : + forall s s' s'':FSet, + eqmap unit (FSetInter (FSetInter s s') s'') + (FSetInter s (FSetInter s' s'')). Proof. - Exact (MapDomRestrTo_assoc unit unit unit). + exact (MapDomRestrTo_assoc unit unit unit). Qed. -Lemma FSetInter_M0_s : (s:FSet) (eqmap unit (FSetInter (M0 unit) s) (M0 unit)). +Lemma FSetInter_M0_s : + forall s:FSet, eqmap unit (FSetInter (M0 unit) s) (M0 unit). Proof. - Exact (MapDomRestrTo_empty_m unit unit). + exact (MapDomRestrTo_empty_m unit unit). Qed. -Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)). +Lemma FSetInter_s_M0 : + forall s:FSet, eqmap unit (FSetInter s (M0 unit)) (M0 unit). Proof. - Exact (MapDomRestrTo_m_empty unit unit). + exact (MapDomRestrTo_m_empty unit unit). Qed. -Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s s) s). +Lemma FSetInter_idempotent : forall s:FSet, eqmap unit (FSetInter s s) s. Proof. - Exact (MapDomRestrTo_idempotent unit). + exact (MapDomRestrTo_idempotent unit). Qed. -Lemma FSetUnion_Inter_l : (s,s',s'':FSet) (eqmap unit - (FSetUnion (FSetInter s s') s'') (FSetInter (FSetUnion s s'') (FSetUnion s' s''))). +Lemma FSetUnion_Inter_l : + forall s s' s'':FSet, + eqmap unit (FSetUnion (FSetInter s s') s'') + (FSetInter (FSetUnion s s'') (FSetUnion s' s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter. - Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. + intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_inter. + rewrite in_FSet_inter. rewrite in_FSet_union. rewrite in_FSet_union. + case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. Qed. -Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (eqmap unit - (FSetUnion s (FSetInter s' s'')) (FSetInter (FSetUnion s s') (FSetUnion s s''))). +Lemma FSetUnion_Inter_r : + forall s s' s'':FSet, + eqmap unit (FSetUnion s (FSetInter s' s'')) + (FSetInter (FSetUnion s s') (FSetUnion s s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter. - Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. + intros. apply FSet_ext. intro. rewrite in_FSet_union. rewrite in_FSet_inter. + rewrite in_FSet_inter. rewrite in_FSet_union. rewrite in_FSet_union. + case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. Qed. -Lemma FSetInter_Union_l : (s,s',s'':FSet) (eqmap unit - (FSetInter (FSetUnion s s') s'') (FSetUnion (FSetInter s s'') (FSetInter s' s''))). +Lemma FSetInter_Union_l : + forall s s' s'':FSet, + eqmap unit (FSetInter (FSetUnion s s') s'') + (FSetUnion (FSetInter s s'') (FSetInter s' s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union. - Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. + intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union. + rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter. + case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. Qed. -Lemma FSetInter_Union_r : (s,s',s'':FSet) (eqmap unit - (FSetInter s (FSetUnion s' s'')) (FSetUnion (FSetInter s s') (FSetInter s s''))). +Lemma FSetInter_Union_r : + forall s s' s'':FSet, + eqmap unit (FSetInter s (FSetUnion s' s'')) + (FSetUnion (FSetInter s s') (FSetInter s s'')). Proof. - Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union. - Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter. - Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity. -Qed. + intros. apply FSet_ext. intro. rewrite in_FSet_inter. rewrite in_FSet_union. + rewrite in_FSet_union. rewrite in_FSet_inter. rewrite in_FSet_inter. + case (in_FSet a s); case (in_FSet a s'); case (in_FSet a s''); reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Mapc.v b/theories/IntMap/Mapc.v index b7cede944..8420ba381 100644 --- a/theories/IntMap/Mapc.v +++ b/theories/IntMap/Mapc.v @@ -7,451 +7,536 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Fset. -Require Mapiter. -Require Mapsubset. -Require PolyList. -Require Lsort. -Require Mapcard. -Require Mapcanon. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Fset. +Require Import Mapiter. +Require Import Mapsubset. +Require Import List. +Require Import Lsort. +Require Import Mapcard. +Require Import Mapcanon. Section MapC. - Variable A, B, C : Set. + Variables A B C : Set. - Lemma MapPut_as_Merge_c : (m:(Map A)) (mapcanon A m) -> - (a:ad) (y:A) (MapPut A m a y)=(MapMerge A m (M1 A a y)). + Lemma MapPut_as_Merge_c : + forall m:Map A, + mapcanon A m -> + forall (a:ad) (y:A), MapPut A m a y = MapMerge A m (M1 A a y). Proof. - Intros. Apply mapcanon_unique. Exact (MapPut_canon A m H a y). - Apply MapMerge_canon. Assumption. - Apply M1_canon. - Apply MapPut_as_Merge. + intros. apply mapcanon_unique. exact (MapPut_canon A m H a y). + apply MapMerge_canon. assumption. + apply M1_canon. + apply MapPut_as_Merge. Qed. - Lemma MapPut_behind_as_Merge_c : (m:(Map A)) (mapcanon A m) -> - (a:ad) (y:A) (MapPut_behind A m a y)=(MapMerge A (M1 A a y) m). + Lemma MapPut_behind_as_Merge_c : + forall m:Map A, + mapcanon A m -> + forall (a:ad) (y:A), MapPut_behind A m a y = MapMerge A (M1 A a y) m. Proof. - Intros. Apply mapcanon_unique. Exact (MapPut_behind_canon A m H a y). - Apply MapMerge_canon. Apply M1_canon. - Assumption. - Apply MapPut_behind_as_Merge. + intros. apply mapcanon_unique. exact (MapPut_behind_canon A m H a y). + apply MapMerge_canon. apply M1_canon. + assumption. + apply MapPut_behind_as_Merge. Qed. - Lemma MapMerge_empty_m_c : (m:(Map A)) (MapMerge A (M0 A) m)=m. + Lemma MapMerge_empty_m_c : forall m:Map A, MapMerge A (M0 A) m = m. Proof. - Trivial. + trivial. Qed. - Lemma MapMerge_assoc_c : (m,m',m'':(Map A)) - (mapcanon A m) -> (mapcanon A m') -> (mapcanon A m'') -> - (MapMerge A (MapMerge A m m') m'')=(MapMerge A m (MapMerge A m' m'')). + Lemma MapMerge_assoc_c : + forall m m' m'':Map A, + mapcanon A m -> + mapcanon A m' -> + mapcanon A m'' -> + MapMerge A (MapMerge A m m') m'' = MapMerge A m (MapMerge A m' m''). Proof. - Intros. Apply mapcanon_unique. - (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption). - (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption). - Apply MapMerge_assoc. + intros. apply mapcanon_unique. + apply MapMerge_canon; try assumption. apply MapMerge_canon; try assumption. + apply MapMerge_canon; try assumption. apply MapMerge_canon; try assumption. + apply MapMerge_assoc. Qed. - Lemma MapMerge_idempotent_c : (m:(Map A)) (mapcanon A m) -> (MapMerge A m m)=m. + Lemma MapMerge_idempotent_c : + forall m:Map A, mapcanon A m -> MapMerge A m m = m. Proof. - Intros. Apply mapcanon_unique. (Apply MapMerge_canon; Assumption). - Assumption. - Apply MapMerge_idempotent. + intros. apply mapcanon_unique. apply MapMerge_canon; assumption. + assumption. + apply MapMerge_idempotent. Qed. - Lemma MapMerge_RestrTo_l_c : (m,m',m'':(Map A)) - (mapcanon A m) -> (mapcanon A m'') -> - (MapMerge A (MapDomRestrTo A A m m') m'')= - (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')). + Lemma MapMerge_RestrTo_l_c : + forall m m' m'':Map A, + mapcanon A m -> + mapcanon A m'' -> + MapMerge A (MapDomRestrTo A A m m') m'' = + MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption. - Assumption. - Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption. - Apply MapMerge_RestrTo_l. + intros. apply mapcanon_unique. apply MapMerge_canon. apply MapDomRestrTo_canon; assumption. + assumption. + apply MapDomRestrTo_canon; apply MapMerge_canon; assumption. + apply MapMerge_RestrTo_l. Qed. - Lemma MapRemove_as_RestrBy_c : (m:(Map A)) (mapcanon A m) -> - (a:ad) (y:B) (MapRemove A m a)=(MapDomRestrBy A B m (M1 B a y)). + Lemma MapRemove_as_RestrBy_c : + forall m:Map A, + mapcanon A m -> + forall (a:ad) (y:B), MapRemove A m a = MapDomRestrBy A B m (M1 B a y). Proof. - Intros. Apply mapcanon_unique. (Apply MapRemove_canon; Assumption). - (Apply MapDomRestrBy_canon; Assumption). - Apply MapRemove_as_RestrBy. + intros. apply mapcanon_unique. apply MapRemove_canon; assumption. + apply MapDomRestrBy_canon; assumption. + apply MapRemove_as_RestrBy. Qed. - Lemma MapDomRestrTo_assoc_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')= - (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')). + Lemma MapDomRestrTo_assoc_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B m (MapDomRestrTo B C m' m''). Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Try Assumption). - (Apply MapDomRestrTo_canon; Try Assumption). - (Apply MapDomRestrTo_canon; Try Assumption). - Apply MapDomRestrTo_assoc. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon; try assumption. + apply MapDomRestrTo_canon; try assumption. + apply MapDomRestrTo_canon; try assumption. + apply MapDomRestrTo_assoc. Qed. - Lemma MapDomRestrTo_idempotent_c : (m:(Map A)) (mapcanon A m) -> - (MapDomRestrTo A A m m)=m. + Lemma MapDomRestrTo_idempotent_c : + forall m:Map A, mapcanon A m -> MapDomRestrTo A A m m = m. Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption). - Assumption. - Apply MapDomRestrTo_idempotent. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon; assumption. + assumption. + apply MapDomRestrTo_idempotent. Qed. - Lemma MapDomRestrTo_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) -> - (MapDomRestrTo A B m m')=(MapDomRestrTo A unit m (MapDom B m')). + Lemma MapDomRestrTo_Dom_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + MapDomRestrTo A B m m' = MapDomRestrTo A unit m (MapDom B m'). Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapDomRestrTo_Dom. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_Dom. Qed. - Lemma MapDomRestrBy_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) -> - (MapDomRestrBy A B m m')=(MapDomRestrBy A unit m (MapDom B m')). + Lemma MapDomRestrBy_Dom_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + MapDomRestrBy A B m m' = MapDomRestrBy A unit m (MapDom B m'). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_Dom. + intros. apply mapcanon_unique. apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_Dom. Qed. - Lemma MapDomRestrBy_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map B)) - (mapcanon A m) -> - (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')= - (MapDomRestrBy A B m (MapMerge B m' m'')). + Lemma MapDomRestrBy_By_c : + forall (m:Map A) (m' m'':Map B), + mapcanon A m -> + MapDomRestrBy A B (MapDomRestrBy A B m m') m'' = + MapDomRestrBy A B m (MapMerge B m' m''). Proof. - Intros. Apply mapcanon_unique. (Apply MapDomRestrBy_canon; Try Assumption). - (Apply MapDomRestrBy_canon; Try Assumption). - (Apply MapDomRestrBy_canon; Try Assumption). - Apply MapDomRestrBy_By. + intros. apply mapcanon_unique. apply MapDomRestrBy_canon; try assumption. + apply MapDomRestrBy_canon; try assumption. + apply MapDomRestrBy_canon; try assumption. + apply MapDomRestrBy_By. Qed. - Lemma MapDomRestrBy_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')= - (MapDomRestrBy A B (MapDomRestrBy A C m m'') m'). + Lemma MapDomRestrBy_By_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrBy A C (MapDomRestrBy A B m m') m'' = + MapDomRestrBy A B (MapDomRestrBy A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. - (Apply MapDomRestrBy_canon; Assumption). - Apply MapDomRestrBy_canon. (Apply MapDomRestrBy_canon; Assumption). - Apply MapDomRestrBy_By_comm. + intros. apply mapcanon_unique. apply MapDomRestrBy_canon. + apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_canon. apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_By_comm. Qed. - Lemma MapDomRestrBy_To_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')= - (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')). + Lemma MapDomRestrBy_To_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrBy A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B m (MapDomRestrBy B C m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. - (Apply MapDomRestrTo_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapDomRestrBy_To. + intros. apply mapcanon_unique. apply MapDomRestrBy_canon. + apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_canon; assumption. + apply MapDomRestrBy_To. Qed. - Lemma MapDomRestrBy_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')= - (MapDomRestrTo A B (MapDomRestrBy A C m m'') m'). + Lemma MapDomRestrBy_To_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrBy A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B (MapDomRestrBy A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. - Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_canon. Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_To_comm. + intros. apply mapcanon_unique. apply MapDomRestrBy_canon. + apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_canon. apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_To_comm. Qed. - Lemma MapDomRestrTo_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')= - (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')). + Lemma MapDomRestrTo_By_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrBy A B m m') m'' = + MapDomRestrTo A C m (MapDomRestrBy C B m'' m'). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_By. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon. + apply MapDomRestrBy_canon; assumption. + apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_By. Qed. - Lemma MapDomRestrTo_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')= - (MapDomRestrBy A B (MapDomRestrTo A C m m'') m'). + Lemma MapDomRestrTo_By_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrBy A B m m') m'' = + MapDomRestrBy A B (MapDomRestrTo A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - (Apply MapDomRestrBy_canon; Assumption). - Apply MapDomRestrBy_canon. (Apply MapDomRestrTo_canon; Assumption). - Apply MapDomRestrTo_By_comm. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon. + apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_canon. apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_By_comm. Qed. - Lemma MapDomRestrTo_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (mapcanon A m) -> - (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')= - (MapDomRestrTo A B (MapDomRestrTo A C m m'') m'). + Lemma MapDomRestrTo_To_comm_c : + forall (m:Map A) (m':Map B) (m'':Map C), + mapcanon A m -> + MapDomRestrTo A C (MapDomRestrTo A B m m') m'' = + MapDomRestrTo A B (MapDomRestrTo A C m m'') m'. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_canon. Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrTo_To_comm. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon. + apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_canon. apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_To_comm. Qed. - Lemma MapMerge_DomRestrTo_c : (m,m':(Map A)) (m'':(Map B)) - (mapcanon A m) -> (mapcanon A m') -> - (MapDomRestrTo A B (MapMerge A m m') m'')= - (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')). + Lemma MapMerge_DomRestrTo_c : + forall (m m':Map A) (m'':Map B), + mapcanon A m -> + mapcanon A m' -> + MapDomRestrTo A B (MapMerge A m m') m'' = + MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - (Apply MapMerge_canon; Assumption). - Apply MapMerge_canon. (Apply MapDomRestrTo_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapMerge_DomRestrTo. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon. + apply MapMerge_canon; assumption. + apply MapMerge_canon. apply MapDomRestrTo_canon; assumption. + apply MapDomRestrTo_canon; assumption. + apply MapMerge_DomRestrTo. Qed. - Lemma MapMerge_DomRestrBy_c : (m,m':(Map A)) (m'':(Map B)) - (mapcanon A m) -> (mapcanon A m') -> - (MapDomRestrBy A B (MapMerge A m m') m'')= - (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')). + Lemma MapMerge_DomRestrBy_c : + forall (m m':Map A) (m'':Map B), + mapcanon A m -> + mapcanon A m' -> + MapDomRestrBy A B (MapMerge A m m') m'' = + MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''). Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption. - Apply MapMerge_canon. Apply MapDomRestrBy_canon; Assumption. - Apply MapDomRestrBy_canon; Assumption. - Apply MapMerge_DomRestrBy. + intros. apply mapcanon_unique. apply MapDomRestrBy_canon. apply MapMerge_canon; assumption. + apply MapMerge_canon. apply MapDomRestrBy_canon; assumption. + apply MapDomRestrBy_canon; assumption. + apply MapMerge_DomRestrBy. Qed. - Lemma MapDelta_nilpotent_c : (m:(Map A)) (mapcanon A m) -> - (MapDelta A m m)=(M0 A). + Lemma MapDelta_nilpotent_c : + forall m:Map A, mapcanon A m -> MapDelta A m m = M0 A. Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - Apply M0_canon. - Apply MapDelta_nilpotent. + intros. apply mapcanon_unique. apply MapDelta_canon; assumption. + apply M0_canon. + apply MapDelta_nilpotent. Qed. - Lemma MapDelta_as_Merge_c : (m,m':(Map A)) - (mapcanon A m) -> (mapcanon A m') -> - (MapDelta A m m')= - (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)). + Lemma MapDelta_as_Merge_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDelta A m m' = + MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m). Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - (Apply MapMerge_canon; Apply MapDomRestrBy_canon; Assumption). - Apply MapDelta_as_Merge. + intros. apply mapcanon_unique. apply MapDelta_canon; assumption. + apply MapMerge_canon; apply MapDomRestrBy_canon; assumption. + apply MapDelta_as_Merge. Qed. - Lemma MapDelta_as_DomRestrBy_c : (m,m':(Map A)) - (mapcanon A m) -> (mapcanon A m') -> - (MapDelta A m m')= - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). + Lemma MapDelta_as_DomRestrBy_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDelta A m m' = + MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'). Proof. - Intros. Apply mapcanon_unique. Apply MapDelta_canon; Assumption. - Apply MapDomRestrBy_canon. (Apply MapMerge_canon; Assumption). - Apply MapDelta_as_DomRestrBy. + intros. apply mapcanon_unique. apply MapDelta_canon; assumption. + apply MapDomRestrBy_canon. apply MapMerge_canon; assumption. + apply MapDelta_as_DomRestrBy. Qed. - Lemma MapDelta_as_DomRestrBy_2_c : (m,m':(Map A)) - (mapcanon A m) -> (mapcanon A m') -> - (MapDelta A m m')= - (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)). + Lemma MapDelta_as_DomRestrBy_2_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDelta A m m' = + MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m). Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption. - Apply MapDelta_as_DomRestrBy_2. + intros. apply mapcanon_unique. apply MapDelta_canon; assumption. + apply MapDomRestrBy_canon. apply MapMerge_canon; assumption. + apply MapDelta_as_DomRestrBy_2. Qed. - Lemma MapDelta_sym_c : (m,m':(Map A)) - (mapcanon A m) -> (mapcanon A m') -> (MapDelta A m m')=(MapDelta A m' m). + Lemma MapDelta_sym_c : + forall m m':Map A, + mapcanon A m -> mapcanon A m' -> MapDelta A m m' = MapDelta A m' m. Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - (Apply MapDelta_canon; Assumption). Apply MapDelta_sym. + intros. apply mapcanon_unique. apply MapDelta_canon; assumption. + apply MapDelta_canon; assumption. apply MapDelta_sym. Qed. - Lemma MapDom_Split_1_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) -> - m=(MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')). + Lemma MapDom_Split_1_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + m = MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'). Proof. - Intros. Apply mapcanon_unique. Assumption. - Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption. - Apply MapDomRestrBy_canon; Assumption. - Apply MapDom_Split_1. + intros. apply mapcanon_unique. assumption. + apply MapMerge_canon. apply MapDomRestrTo_canon; assumption. + apply MapDomRestrBy_canon; assumption. + apply MapDom_Split_1. Qed. - Lemma MapDom_Split_2_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) -> - m=(MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')). + Lemma MapDom_Split_2_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + m = MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'). Proof. - Intros. Apply mapcanon_unique. Assumption. - Apply MapMerge_canon. (Apply MapDomRestrBy_canon; Assumption). - (Apply MapDomRestrTo_canon; Assumption). - Apply MapDom_Split_2. + intros. apply mapcanon_unique. assumption. + apply MapMerge_canon. apply MapDomRestrBy_canon; assumption. + apply MapDomRestrTo_canon; assumption. + apply MapDom_Split_2. Qed. - Lemma MapDom_Split_3_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) -> - (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))= - (M0 A). + Lemma MapDom_Split_3_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') = + M0 A. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon. - Apply MapDomRestrTo_canon; Assumption. - Apply M0_canon. - Apply MapDom_Split_3. + intros. apply mapcanon_unique. apply MapDomRestrTo_canon. + apply MapDomRestrTo_canon; assumption. + apply M0_canon. + apply MapDom_Split_3. Qed. - Lemma Map_of_alist_of_Map_c : (m:(Map A)) (mapcanon A m) -> - (Map_of_alist A (alist_of_Map A m))=m. + Lemma Map_of_alist_of_Map_c : + forall m:Map A, mapcanon A m -> Map_of_alist A (alist_of_Map A m) = m. Proof. - Intros. (Apply mapcanon_unique; Try Assumption). Apply Map_of_alist_canon. - Apply Map_of_alist_of_Map. + intros. apply mapcanon_unique; try assumption. apply Map_of_alist_canon. + apply Map_of_alist_of_Map. Qed. - Lemma alist_of_Map_of_alist_c : (l:(alist A)) (alist_sorted_2 A l) -> - (alist_of_Map A (Map_of_alist A l))=l. + Lemma alist_of_Map_of_alist_c : + forall l:alist A, + alist_sorted_2 A l -> alist_of_Map A (Map_of_alist A l) = l. Proof. - Intros. Apply alist_canonical. Apply alist_of_Map_of_alist. - Apply alist_of_Map_sorts2. - Assumption. + intros. apply alist_canonical. apply alist_of_Map_of_alist. + apply alist_of_Map_sorts2. + assumption. Qed. - Lemma MapSubset_antisym_c : (m:(Map A)) (m':(Map B)) - (mapcanon A m) -> (mapcanon B m') -> - (MapSubset A B m m') -> (MapSubset B A m' m) -> (MapDom A m)=(MapDom B m'). + Lemma MapSubset_antisym_c : + forall (m:Map A) (m':Map B), + mapcanon A m -> + mapcanon B m' -> + MapSubset A B m m' -> MapSubset B A m' m -> MapDom A m = MapDom B m'. Proof. - Intros. Apply (mapcanon_unique unit). (Apply MapDom_canon; Assumption). - (Apply MapDom_canon; Assumption). - (Apply MapSubset_antisym; Assumption). + intros. apply (mapcanon_unique unit). apply MapDom_canon; assumption. + apply MapDom_canon; assumption. + apply MapSubset_antisym; assumption. Qed. - Lemma FSubset_antisym_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> s=s'. + Lemma FSubset_antisym_c : + forall s s':FSet, + mapcanon unit s -> + mapcanon unit s' -> MapSubset _ _ s s' -> MapSubset _ _ s' s -> s = s'. Proof. - Intros. Apply (mapcanon_unique unit); Try Assumption. Apply FSubset_antisym; Assumption. + intros. apply (mapcanon_unique unit); try assumption. apply FSubset_antisym; assumption. Qed. - Lemma MapDisjoint_empty_c : (m:(Map A)) (mapcanon A m) -> - (MapDisjoint A A m m) -> m=(M0 A). + Lemma MapDisjoint_empty_c : + forall m:Map A, mapcanon A m -> MapDisjoint A A m m -> m = M0 A. Proof. - Intros. Apply mapcanon_unique; Try Assumption; Try Apply M0_canon. - Apply MapDisjoint_empty; Assumption. + intros. apply mapcanon_unique; try assumption; try apply M0_canon. + apply MapDisjoint_empty; assumption. Qed. - Lemma MapDelta_disjoint_c : (m,m':(Map A)) (mapcanon A m) -> (mapcanon A m') -> - (MapDisjoint A A m m') -> (MapDelta A m m')=(MapMerge A m m'). + Lemma MapDelta_disjoint_c : + forall m m':Map A, + mapcanon A m -> + mapcanon A m' -> + MapDisjoint A A m m' -> MapDelta A m m' = MapMerge A m m'. Proof. - Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption). - (Apply MapMerge_canon; Assumption). Apply MapDelta_disjoint; Assumption. + intros. apply mapcanon_unique. apply MapDelta_canon; assumption. + apply MapMerge_canon; assumption. apply MapDelta_disjoint; assumption. Qed. End MapC. -Lemma FSetDelta_assoc_c : (s,s',s'':FSet) - (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') -> - (MapDelta ? (MapDelta ? s s') s'')=(MapDelta ? s (MapDelta ? s' s'')). +Lemma FSetDelta_assoc_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + mapcanon unit s'' -> + MapDelta _ (MapDelta _ s s') s'' = MapDelta _ s (MapDelta _ s' s''). Proof. - Intros. Apply (mapcanon_unique unit). Apply MapDelta_canon. (Apply MapDelta_canon; Assumption). - Assumption. - Apply MapDelta_canon. Assumption. - (Apply MapDelta_canon; Assumption). - Apply FSetDelta_assoc; Assumption. + intros. apply (mapcanon_unique unit). apply MapDelta_canon. apply MapDelta_canon; assumption. + assumption. + apply MapDelta_canon. assumption. + apply MapDelta_canon; assumption. + apply FSetDelta_assoc; assumption. Qed. -Lemma FSet_ext_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - ((a:ad) (in_FSet a s)=(in_FSet a s')) -> s=s'. +Lemma FSet_ext_c : + forall s s':FSet, + mapcanon unit s -> + mapcanon unit s' -> (forall a:ad, in_FSet a s = in_FSet a s') -> s = s'. Proof. - Intros. (Apply (mapcanon_unique unit); Try Assumption). Apply FSet_ext. Assumption. + intros. apply (mapcanon_unique unit); try assumption. apply FSet_ext. assumption. Qed. -Lemma FSetUnion_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetUnion s s')=(FSetUnion s' s). +Lemma FSetUnion_comm_c : + forall s s':FSet, + mapcanon unit s -> mapcanon unit s' -> FSetUnion s s' = FSetUnion s' s. Proof. - Intros. - Apply (mapcanon_unique unit); Try (Unfold FSetUnion; Apply MapMerge_canon; Assumption). - Apply FSetUnion_comm. + intros. + apply (mapcanon_unique unit); + try (unfold FSetUnion in |- *; apply MapMerge_canon; assumption). + apply FSetUnion_comm. Qed. -Lemma FSetUnion_assoc_c : (s,s',s'':FSet) - (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') -> - (FSetUnion (FSetUnion s s') s'')=(FSetUnion s (FSetUnion s' s'')). +Lemma FSetUnion_assoc_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + mapcanon unit s'' -> + FSetUnion (FSetUnion s s') s'' = FSetUnion s (FSetUnion s' s''). Proof. - Exact (MapMerge_assoc_c unit). + exact (MapMerge_assoc_c unit). Qed. -Lemma FSetUnion_M0_s_c : (s:FSet) (FSetUnion (M0 unit) s)=s. +Lemma FSetUnion_M0_s_c : forall s:FSet, FSetUnion (M0 unit) s = s. Proof. - Exact (MapMerge_empty_m_c unit). + exact (MapMerge_empty_m_c unit). Qed. -Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s. +Lemma FSetUnion_s_M0_c : forall s:FSet, FSetUnion s (M0 unit) = s. Proof. - Exact (MapMerge_m_empty_1 unit). + exact (MapMerge_m_empty_1 unit). Qed. -Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s) -> (FSetUnion s s)=s. +Lemma FSetUnion_idempotent : + forall s:FSet, mapcanon unit s -> FSetUnion s s = s. Proof. - Exact (MapMerge_idempotent_c unit). + exact (MapMerge_idempotent_c unit). Qed. -Lemma FSetInter_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetInter s s')=(FSetInter s' s). +Lemma FSetInter_comm_c : + forall s s':FSet, + mapcanon unit s -> mapcanon unit s' -> FSetInter s s' = FSetInter s' s. Proof. - Intros. - Apply (mapcanon_unique unit); Try (Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption). - Apply FSetInter_comm. + intros. + apply (mapcanon_unique unit); + try (unfold FSetInter in |- *; apply MapDomRestrTo_canon; assumption). + apply FSetInter_comm. Qed. -Lemma FSetInter_assoc_c : (s,s',s'':FSet) - (mapcanon unit s) -> - (FSetInter (FSetInter s s') s'')=(FSetInter s (FSetInter s' s'')). +Lemma FSetInter_assoc_c : + forall s s' s'':FSet, + mapcanon unit s -> + FSetInter (FSetInter s s') s'' = FSetInter s (FSetInter s' s''). Proof. - Exact (MapDomRestrTo_assoc_c unit unit unit). + exact (MapDomRestrTo_assoc_c unit unit unit). Qed. -Lemma FSetInter_M0_s_c : (s:FSet) (FSetInter (M0 unit) s)=(M0 unit). +Lemma FSetInter_M0_s_c : forall s:FSet, FSetInter (M0 unit) s = M0 unit. Proof. - Trivial. + trivial. Qed. -Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit). +Lemma FSetInter_s_M0_c : forall s:FSet, FSetInter s (M0 unit) = M0 unit. Proof. - Exact (MapDomRestrTo_m_empty_1 unit unit). + exact (MapDomRestrTo_m_empty_1 unit unit). Qed. -Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s) -> (FSetInter s s)=s. +Lemma FSetInter_idempotent : + forall s:FSet, mapcanon unit s -> FSetInter s s = s. Proof. - Exact (MapDomRestrTo_idempotent_c unit). + exact (MapDomRestrTo_idempotent_c unit). Qed. -Lemma FSetUnion_Inter_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s'') -> - (FSetUnion (FSetInter s s') s'')=(FSetInter (FSetUnion s s'') (FSetUnion s' s'')). +Lemma FSetUnion_Inter_l_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s'' -> + FSetUnion (FSetInter s s') s'' = + FSetInter (FSetUnion s s'') (FSetUnion s' s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption). - Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption). - Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption. - Apply FSetUnion_Inter_l. + intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption. + unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption. + unfold FSetInter in |- *; unfold FSetUnion in |- *; + apply MapDomRestrTo_canon; apply MapMerge_canon; + assumption. + apply FSetUnion_Inter_l. Qed. -Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetUnion s (FSetInter s' s''))=(FSetInter (FSetUnion s s') (FSetUnion s s'')). +Lemma FSetUnion_Inter_r : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + FSetUnion s (FSetInter s' s'') = + FSetInter (FSetUnion s s') (FSetUnion s s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption). - Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption). - Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption. - Apply FSetUnion_Inter_r. + intros. apply (mapcanon_unique unit). unfold FSetUnion in |- *. apply MapMerge_canon; try assumption. + unfold FSetInter in |- *. apply MapDomRestrTo_canon; assumption. + unfold FSetInter in |- *; unfold FSetUnion in |- *; + apply MapDomRestrTo_canon; apply MapMerge_canon; + assumption. + apply FSetUnion_Inter_r. Qed. -Lemma FSetInter_Union_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetInter (FSetUnion s s') s'')=(FSetUnion (FSetInter s s'') (FSetInter s' s'')). +Lemma FSetInter_Union_l_c : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + FSetInter (FSetUnion s s') s'' = + FSetUnion (FSetInter s s'') (FSetInter s' s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetInter. - Apply MapDomRestrTo_canon; Try Assumption. Unfold FSetUnion. - Apply MapMerge_canon; Assumption. - Unfold FSetUnion; Unfold FSetInter; Apply MapMerge_canon; Apply MapDomRestrTo_canon; - Assumption. - Apply FSetInter_Union_l. + intros. apply (mapcanon_unique unit). unfold FSetInter in |- *. + apply MapDomRestrTo_canon; try assumption. unfold FSetUnion in |- *. + apply MapMerge_canon; assumption. + unfold FSetUnion in |- *; unfold FSetInter in |- *; apply MapMerge_canon; + apply MapDomRestrTo_canon; assumption. + apply FSetInter_Union_l. Qed. -Lemma FSetInter_Union_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') -> - (FSetInter s (FSetUnion s' s''))=(FSetUnion (FSetInter s s') (FSetInter s s'')). +Lemma FSetInter_Union_r : + forall s s' s'':FSet, + mapcanon unit s -> + mapcanon unit s' -> + FSetInter s (FSetUnion s' s'') = + FSetUnion (FSetInter s s') (FSetInter s s''). Proof. - Intros. Apply (mapcanon_unique unit). Unfold FSetInter. - Apply MapDomRestrTo_canon; Try Assumption. - Unfold FSetUnion. Apply MapMerge_canon; Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption. - Apply FSetInter_Union_r. -Qed. + intros. apply (mapcanon_unique unit). unfold FSetInter in |- *. + apply MapDomRestrTo_canon; try assumption. + unfold FSetUnion in |- *. apply MapMerge_canon; unfold FSetInter in |- *; apply MapDomRestrTo_canon; + assumption. + apply FSetInter_Union_r. +Qed.
\ No newline at end of file diff --git a/theories/IntMap/Mapcanon.v b/theories/IntMap/Mapcanon.v index b98e9b233..70966c60d 100644 --- a/theories/IntMap/Mapcanon.v +++ b/theories/IntMap/Mapcanon.v @@ -7,316 +7,328 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Mapiter. -Require Fset. -Require PolyList. -Require Lsort. -Require Mapsubset. -Require Mapcard. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Mapiter. +Require Import Fset. +Require Import List. +Require Import Lsort. +Require Import Mapsubset. +Require Import Mapcard. Section MapCanon. Variable A : Set. - Inductive mapcanon : (Map A) -> Prop := - M0_canon : (mapcanon (M0 A)) - | M1_canon : (a:ad) (y:A) (mapcanon (M1 A a y)) - | M2_canon : (m1,m2:(Map A)) (mapcanon m1) -> (mapcanon m2) -> - (le (2) (MapCard A (M2 A m1 m2))) -> (mapcanon (M2 A m1 m2)). + Inductive mapcanon : Map A -> Prop := + | M0_canon : mapcanon (M0 A) + | M1_canon : forall (a:ad) (y:A), mapcanon (M1 A a y) + | M2_canon : + forall m1 m2:Map A, + mapcanon m1 -> + mapcanon m2 -> 2 <= MapCard A (M2 A m1 m2) -> mapcanon (M2 A m1 m2). - Lemma mapcanon_M2 : - (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (le (2) (MapCard A (M2 A m1 m2))). + Lemma mapcanon_M2 : + forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> 2 <= MapCard A (M2 A m1 m2). Proof. - Intros. Inversion H. Assumption. + intros. inversion H. assumption. Qed. - Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m1). + Lemma mapcanon_M2_1 : + forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m1. Proof. - Intros. Inversion H. Assumption. + intros. inversion H. assumption. Qed. - Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m2). + Lemma mapcanon_M2_2 : + forall m1 m2:Map A, mapcanon (M2 A m1 m2) -> mapcanon m2. Proof. - Intros. Inversion H. Assumption. + intros. inversion H. assumption. Qed. - Lemma M2_eqmap_1 : (m0,m1,m2,m3:(Map A)) - (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m0 m2). + Lemma M2_eqmap_1 : + forall m0 m1 m2 m3:Map A, + eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m0 m2. Proof. - Unfold eqmap eqm. Intros. Rewrite <- (ad_double_div_2 a). - Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1). - Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m2 m3). - Exact (H (ad_double a)). + unfold eqmap, eqm in |- *. intros. rewrite <- (ad_double_div_2 a). + rewrite <- (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m0 m1). + rewrite <- (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m2 m3). + exact (H (ad_double a)). Qed. - Lemma M2_eqmap_2 : (m0,m1,m2,m3:(Map A)) - (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m1 m3). + Lemma M2_eqmap_2 : + forall m0 m1 m2 m3:Map A, + eqmap A (M2 A m0 m1) (M2 A m2 m3) -> eqmap A m1 m3. Proof. - Unfold eqmap eqm. Intros. Rewrite <- (ad_double_plus_un_div_2 a). - Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m2 m3). - Exact (H (ad_double_plus_un a)). + unfold eqmap, eqm in |- *. intros. rewrite <- (ad_double_plus_un_div_2 a). + rewrite <- (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m0 m1). + rewrite <- (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m2 m3). + exact (H (ad_double_plus_un a)). Qed. - Lemma mapcanon_unique : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (eqmap A m m') -> m=m'. + Lemma mapcanon_unique : + forall m m':Map A, mapcanon m -> mapcanon m' -> eqmap A m m' -> m = m'. Proof. - Induction m. Induction m'. Trivial. - Intros a y H H0 H1. Cut (NONE A)=(MapGet A (M1 A a y) a). Simpl. Rewrite (ad_eq_correct a). - Intro. Discriminate H2. - Exact (H1 a). - Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4). - Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2). - Intros a y. Induction m'. Intros. Cut (MapGet A (M1 A a y) a)=(NONE A). Simpl. - Rewrite (ad_eq_correct a). Intro. Discriminate H2. - Exact (H1 a). - Intros a0 y0 H H0 H1. Cut (MapGet A (M1 A a y) a)=(MapGet A (M1 A a0 y0) a). Simpl. - Rewrite (ad_eq_correct a). Intro. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H3. - Rewrite H3 in H2. Inversion H2. Rewrite (ad_eq_complete ? ? H3). Reflexivity. - Intro H3. Rewrite H3 in H2. Discriminate H2. - Exact (H1 a). - Intros. Cut (le (2) (MapCard A (M1 A a y))). Intro. Elim (le_Sn_O ? (le_S_n ? ? H4)). - Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2). - Induction m'. Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4). - Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1). - Intros a y H1 H2 H3. Cut (le (2) (MapCard A (M1 A a y))). Intro. - Elim (le_Sn_O ? (le_S_n ? ? H4)). - Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1). - Intros. Rewrite (H m2). Rewrite (H0 m3). Reflexivity. - Exact (mapcanon_M2_2 ? ? H3). - Exact (mapcanon_M2_2 ? ? H4). - Exact (M2_eqmap_2 ? ? ? ? H5). - Exact (mapcanon_M2_1 ? ? H3). - Exact (mapcanon_M2_1 ? ? H4). - Exact (M2_eqmap_1 ? ? ? ? H5). + simple induction m. simple induction m'. trivial. + intros a y H H0 H1. cut (NONE A = MapGet A (M1 A a y) a). simpl in |- *. rewrite (ad_eq_correct a). + intro. discriminate H2. + exact (H1 a). + intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). + rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). + intros a y. simple induction m'. intros. cut (MapGet A (M1 A a y) a = NONE A). simpl in |- *. + rewrite (ad_eq_correct a). intro. discriminate H2. + exact (H1 a). + intros a0 y0 H H0 H1. cut (MapGet A (M1 A a y) a = MapGet A (M1 A a0 y0) a). simpl in |- *. + rewrite (ad_eq_correct a). intro. elim (sumbool_of_bool (ad_eq a0 a)). intro H3. + rewrite H3 in H2. inversion H2. rewrite (ad_eq_complete _ _ H3). reflexivity. + intro H3. rewrite H3 in H2. discriminate H2. + exact (H1 a). + intros. cut (2 <= MapCard A (M1 A a y)). intro. elim (le_Sn_O _ (le_S_n _ _ H4)). + rewrite (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H2). + simple induction m'. intros. cut (2 <= MapCard A (M0 A)). intro. elim (le_Sn_O _ H4). + rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1). + intros a y H1 H2 H3. cut (2 <= MapCard A (M1 A a y)). intro. + elim (le_Sn_O _ (le_S_n _ _ H4)). + rewrite <- (MapCard_ext A _ _ H3). exact (mapcanon_M2 _ _ H1). + intros. rewrite (H m2). rewrite (H0 m3). reflexivity. + exact (mapcanon_M2_2 _ _ H3). + exact (mapcanon_M2_2 _ _ H4). + exact (M2_eqmap_2 _ _ _ _ H5). + exact (mapcanon_M2_1 _ _ H3). + exact (mapcanon_M2_1 _ _ H4). + exact (M2_eqmap_1 _ _ _ _ H5). Qed. - Lemma MapPut1_canon : - (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)). + Lemma MapPut1_canon : + forall (p:positive) (a a':ad) (y y':A), mapcanon (MapPut1 A a y a' y' p). Proof. - Induction p. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon. - Apply M1_canon. - Apply le_n. - Apply M2_canon. Apply M1_canon. - Apply M1_canon. - Apply le_n. - Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M0_canon. - Apply H. - Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n. - Apply M2_canon. Apply H. - Apply M0_canon. - Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n. - Simpl. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon. - Apply M1_canon. - Simpl. Apply le_n. - Apply M2_canon. Apply M1_canon. - Apply M1_canon. - Simpl. Apply le_n. + simple induction p. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon. + apply M1_canon. + apply le_n. + apply M2_canon. apply M1_canon. + apply M1_canon. + apply le_n. + simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M0_canon. + apply H. + simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. + apply M2_canon. apply H. + apply M0_canon. + simpl in |- *. rewrite MapCard_Put1_equals_2. apply le_n. + simpl in |- *. simpl in |- *. intros. case (ad_bit_0 a). apply M2_canon. apply M1_canon. + apply M1_canon. + simpl in |- *. apply le_n. + apply M2_canon. apply M1_canon. + apply M1_canon. + simpl in |- *. apply le_n. Qed. - Lemma MapPut_canon : - (m:(Map A)) (mapcanon m) -> (a:ad) (y:A) (mapcanon (MapPut A m a y)). + Lemma MapPut_canon : + forall m:Map A, + mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut A m a y). Proof. - Induction m. Intros. Simpl. Apply M1_canon. - Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon. - Intro. Apply MapPut1_canon. - Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1). - Apply le_plus_plus. Exact (MapCard_Put_lb A m0 ad_z y). - Apply le_n. - Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1). - Apply H0. Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Exact (MapCard_Put_lb A m1 (ad_x p0) y). - Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_r. Exact (MapCard_Put_lb A m0 (ad_x p0) y). - Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1). - Apply H0. Apply (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Exact (MapCard_Put_lb A m1 ad_z y). + simple induction m. intros. simpl in |- *. apply M1_canon. + intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon. + intro. apply MapPut1_canon. + intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). + apply plus_le_compat. exact (MapCard_Put_lb A m0 ad_z y). + apply le_n. + intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1). + apply H0. exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. exact (MapCard_Put_lb A m1 (ad_x p0) y). + intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_r. exact (MapCard_Put_lb A m0 (ad_x p0) y). + apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). + apply H0. apply (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. exact (MapCard_Put_lb A m1 ad_z y). Qed. - Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m) -> - (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)). + Lemma MapPut_behind_canon : + forall m:Map A, + mapcanon m -> forall (a:ad) (y:A), mapcanon (MapPut_behind A m a y). Proof. - Induction m. Intros. Simpl. Apply M1_canon. - Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon. - Intro. Apply MapPut1_canon. - Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1). - Apply le_plus_plus. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 ad_z y). - Apply le_n. - Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1). - Apply H0. Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 (ad_x p0) y). - Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Exact (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_r. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 (ad_x p0) y). - Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1). - Apply H0. Apply (mapcanon_M2_2 m0 m1 H1). - Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). - Exact (mapcanon_M2 m0 m1 H1). - Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 ad_z y). + simple induction m. intros. simpl in |- *. apply M1_canon. + intros a0 y0 H a y. simpl in |- *. case (ad_xor a0 a). apply M1_canon. + intro. apply MapPut1_canon. + intros. simpl in |- *. elim a. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). exact (mapcanon_M2 _ _ H1). + apply plus_le_compat. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 ad_z y). + apply le_n. + intro. case p. intro. apply M2_canon. exact (mapcanon_M2_1 m0 m1 H1). + apply H0. exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 (ad_x p0) y). + intro. apply M2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + exact (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_r. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m0 (ad_x p0) y). + apply M2_canon. apply (mapcanon_M2_1 m0 m1 H1). + apply H0. apply (mapcanon_M2_2 m0 m1 H1). + simpl in |- *. apply le_trans with (m := MapCard A m0 + MapCard A m1). + exact (mapcanon_M2 m0 m1 H1). + apply plus_le_compat_l. rewrite MapCard_Put_behind_Put. exact (MapCard_Put_lb A m1 ad_z y). Qed. - Lemma makeM2_canon : - (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> (mapcanon (makeM2 A m m')). + Lemma makeM2_canon : + forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (makeM2 A m m'). Proof. - Intro. Case m. Intro. Case m'. Intros. Exact M0_canon. - Intros a y H H0. Exact (M1_canon (ad_double_plus_un a) y). - Intros. Simpl. (Apply M2_canon; Try Assumption). Exact (mapcanon_M2 m0 m1 H0). - Intros a y m'. Case m'. Intros. Exact (M1_canon (ad_double a) y). - Intros a0 y0 H H0. Simpl. (Apply M2_canon; Try Assumption). Apply le_n. - Intros. Simpl. (Apply M2_canon; Try Assumption). - Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H0). - Exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))). - Simpl. Intros. (Apply M2_canon; Try Assumption). - Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H). - Exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')). + intro. case m. intro. case m'. intros. exact M0_canon. + intros a y H H0. exact (M1_canon (ad_double_plus_un a) y). + intros. simpl in |- *. apply M2_canon; try assumption. exact (mapcanon_M2 m0 m1 H0). + intros a y m'. case m'. intros. exact (M1_canon (ad_double a) y). + intros a0 y0 H H0. simpl in |- *. apply M2_canon; try assumption. apply le_n. + intros. simpl in |- *. apply M2_canon; try assumption. + apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H0). + exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))). + simpl in |- *. intros. apply M2_canon; try assumption. + apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H). + exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')). Qed. - Fixpoint MapCanonicalize [m:(Map A)] : (Map A) := - Cases m of - (M2 m0 m1) => (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1)) - | _ => m - end. + Fixpoint MapCanonicalize (m:Map A) : Map A := + match m with + | M2 m0 m1 => makeM2 A (MapCanonicalize m0) (MapCanonicalize m1) + | _ => m + end. - Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)). + Lemma mapcanon_exists_1 : forall m:Map A, eqmap A m (MapCanonicalize m). Proof. - Induction m. Apply eqmap_refl. - Intros. Apply eqmap_refl. - Intros. Simpl. Unfold eqmap eqm. Intro. - Rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a). - Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if. - Rewrite <- (H (ad_div_2 a)). Rewrite <- (H0 (ad_div_2 a)). Reflexivity. + simple induction m. apply eqmap_refl. + intros. apply eqmap_refl. + intros. simpl in |- *. unfold eqmap, eqm in |- *. intro. + rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a). + rewrite MapGet_M2_bit_0_if. rewrite MapGet_M2_bit_0_if. + rewrite <- (H (ad_div_2 a)). rewrite <- (H0 (ad_div_2 a)). reflexivity. Qed. - Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)). + Lemma mapcanon_exists_2 : forall m:Map A, mapcanon (MapCanonicalize m). Proof. - Induction m. Apply M0_canon. - Intros. Simpl. Apply M1_canon. - Intros. Simpl. (Apply makeM2_canon; Assumption). + simple induction m. apply M0_canon. + intros. simpl in |- *. apply M1_canon. + intros. simpl in |- *. apply makeM2_canon; assumption. Qed. - Lemma mapcanon_exists : - (m:(Map A)) {m':(Map A) | (eqmap A m m') /\ (mapcanon m')}. + Lemma mapcanon_exists : + forall m:Map A, {m' : Map A | eqmap A m m' /\ mapcanon m'}. Proof. - Intro. Split with (MapCanonicalize m). Split. Apply mapcanon_exists_1. - Apply mapcanon_exists_2. + intro. split with (MapCanonicalize m). split. apply mapcanon_exists_1. + apply mapcanon_exists_2. Qed. - Lemma MapRemove_canon : - (m:(Map A)) (mapcanon m) -> (a:ad) (mapcanon (MapRemove A m a)). + Lemma MapRemove_canon : + forall m:Map A, mapcanon m -> forall a:ad, mapcanon (MapRemove A m a). Proof. - Induction m. Intros. Exact M0_canon. - Intros a y H a0. Simpl. Case (ad_eq a a0). Exact M0_canon. - Assumption. - Intros. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1). - Apply H0. Exact (mapcanon_M2_2 ? ? H1). - Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1). - Exact (mapcanon_M2_2 ? ? H1). + simple induction m. intros. exact M0_canon. + intros a y H a0. simpl in |- *. case (ad_eq a a0). exact M0_canon. + assumption. + intros. simpl in |- *. case (ad_bit_0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). + apply H0. exact (mapcanon_M2_2 _ _ H1). + apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1). + exact (mapcanon_M2_2 _ _ H1). Qed. - Lemma MapMerge_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (mapcanon (MapMerge A m m')). + Lemma MapMerge_canon : + forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapMerge A m m'). Proof. - Induction m. Intros. Exact H0. - Simpl. Intros a y m' H H0. Exact (MapPut_behind_canon m' H0 a y). - Induction m'. Intros. Exact H1. - Intros a y H1 H2. Unfold MapMerge. Exact (MapPut_canon ? H1 a y). - Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3). - Exact (mapcanon_M2_1 ? ? H4). - Apply H0. Exact (mapcanon_M2_2 ? ? H3). - Exact (mapcanon_M2_2 ? ? H4). - Change (le (2) (MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3)))). - Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H3). - Exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)). + simple induction m. intros. exact H0. + simpl in |- *. intros a y m' H H0. exact (MapPut_behind_canon m' H0 a y). + simple induction m'. intros. exact H1. + intros a y H1 H2. unfold MapMerge in |- *. exact (MapPut_canon _ H1 a y). + intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). + exact (mapcanon_M2_1 _ _ H4). + apply H0. exact (mapcanon_M2_2 _ _ H3). + exact (mapcanon_M2_2 _ _ H4). + change (2 <= MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3))) in |- *. + apply le_trans with (m := MapCard A (M2 A m0 m1)). exact (mapcanon_M2 _ _ H3). + exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)). Qed. - Lemma MapDelta_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> - (mapcanon (MapDelta A m m')). + Lemma MapDelta_canon : + forall m m':Map A, mapcanon m -> mapcanon m' -> mapcanon (MapDelta A m m'). Proof. - Induction m. Intros. Exact H0. - Simpl. Intros a y m' H H0. Case (MapGet A m' a). Exact (MapPut_canon m' H0 a y). - Intro. Exact (MapRemove_canon m' H0 a). - Induction m'. Intros. Exact H1. - Unfold MapDelta. Intros a y H1 H2. Case (MapGet A (M2 A m0 m1) a). - Exact (MapPut_canon ? H1 a y). - Intro. Exact (MapRemove_canon ? H1 a). - Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3). - Exact (mapcanon_M2_1 ? ? H4). - Apply H0. Exact (mapcanon_M2_2 ? ? H3). - Exact (mapcanon_M2_2 ? ? H4). + simple induction m. intros. exact H0. + simpl in |- *. intros a y m' H H0. case (MapGet A m' a). exact (MapPut_canon m' H0 a y). + intro. exact (MapRemove_canon m' H0 a). + simple induction m'. intros. exact H1. + unfold MapDelta in |- *. intros a y H1 H2. case (MapGet A (M2 A m0 m1) a). + exact (MapPut_canon _ H1 a y). + intro. exact (MapRemove_canon _ H1 a). + intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H3). + exact (mapcanon_M2_1 _ _ H4). + apply H0. exact (mapcanon_M2_2 _ _ H3). + exact (mapcanon_M2_2 _ _ H4). Qed. Variable B : Set. - Lemma MapDomRestrTo_canon : (m:(Map A)) (mapcanon m) -> - (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')). + Lemma MapDomRestrTo_canon : + forall m:Map A, + mapcanon m -> forall m':Map B, mapcanon (MapDomRestrTo A B m m'). Proof. - Induction m. Intros. Exact M0_canon. - Simpl. Intros a y H m'. Case (MapGet B m' a). Exact M0_canon. - Intro. Apply M1_canon. - Induction m'. Exact M0_canon. - Unfold MapDomRestrTo. Intros a y. Case (MapGet A (M2 A m0 m1) a). Exact M0_canon. - Intro. Apply M1_canon. - Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1). - Apply H0. Exact (mapcanon_M2_2 m0 m1 H1). + simple induction m. intros. exact M0_canon. + simpl in |- *. intros a y H m'. case (MapGet B m' a). exact M0_canon. + intro. apply M1_canon. + simple induction m'. exact M0_canon. + unfold MapDomRestrTo in |- *. intros a y. case (MapGet A (M2 A m0 m1) a). exact M0_canon. + intro. apply M1_canon. + intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 m0 m1 H1). + apply H0. exact (mapcanon_M2_2 m0 m1 H1). Qed. - Lemma MapDomRestrBy_canon : (m:(Map A)) (mapcanon m) -> - (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')). + Lemma MapDomRestrBy_canon : + forall m:Map A, + mapcanon m -> forall m':Map B, mapcanon (MapDomRestrBy A B m m'). Proof. - Induction m. Intros. Exact M0_canon. - Simpl. Intros a y H m'. Case (MapGet B m' a). Assumption. - Intro. Exact M0_canon. - Induction m'. Exact H1. - Intros a y. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1). - Apply MapRemove_canon. Exact (mapcanon_M2_2 ? ? H1). - Apply makeM2_canon. Apply MapRemove_canon. Exact (mapcanon_M2_1 ? ? H1). - Exact (mapcanon_M2_2 ? ? H1). - Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1). - Apply H0. Exact (mapcanon_M2_2 ? ? H1). + simple induction m. intros. exact M0_canon. + simpl in |- *. intros a y H m'. case (MapGet B m' a). assumption. + intro. exact M0_canon. + simple induction m'. exact H1. + intros a y. simpl in |- *. case (ad_bit_0 a). apply makeM2_canon. exact (mapcanon_M2_1 _ _ H1). + apply MapRemove_canon. exact (mapcanon_M2_2 _ _ H1). + apply makeM2_canon. apply MapRemove_canon. exact (mapcanon_M2_1 _ _ H1). + exact (mapcanon_M2_2 _ _ H1). + intros. simpl in |- *. apply makeM2_canon. apply H. exact (mapcanon_M2_1 _ _ H1). + apply H0. exact (mapcanon_M2_2 _ _ H1). Qed. - Lemma Map_of_alist_canon : (l:(alist A)) (mapcanon (Map_of_alist A l)). + Lemma Map_of_alist_canon : forall l:alist A, mapcanon (Map_of_alist A l). Proof. - Induction l. Exact M0_canon. - Intro r. Elim r. Intros a y l0 H. Simpl. Apply MapPut_canon. Assumption. + simple induction l. exact M0_canon. + intro r. elim r. intros a y l0 H. simpl in |- *. apply MapPut_canon. assumption. Qed. - Lemma MapSubset_c_1 : (m:(Map A)) (m':(Map B)) (mapcanon m) -> - (MapSubset A B m m') -> (MapDomRestrBy A B m m')=(M0 A). + Lemma MapSubset_c_1 : + forall (m:Map A) (m':Map B), + mapcanon m -> MapSubset A B m m' -> MapDomRestrBy A B m m' = M0 A. Proof. - Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Assumption. - Apply M0_canon. - Exact (MapSubset_imp_2 ? ? m m' H0). + intros. apply mapcanon_unique. apply MapDomRestrBy_canon. assumption. + apply M0_canon. + exact (MapSubset_imp_2 _ _ m m' H0). Qed. - Lemma MapSubset_c_2 : (m:(Map A)) (m':(Map B)) - (MapDomRestrBy A B m m')=(M0 A) -> (MapSubset A B m m'). + Lemma MapSubset_c_2 : + forall (m:Map A) (m':Map B), + MapDomRestrBy A B m m' = M0 A -> MapSubset A B m m'. Proof. - Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. Rewrite H. Apply eqmap_refl. + intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. rewrite H. apply eqmap_refl. Qed. End MapCanon. @@ -325,52 +337,63 @@ Section FSetCanon. Variable A : Set. - Lemma MapDom_canon : (m:(Map A)) (mapcanon A m) -> (mapcanon unit (MapDom A m)). + Lemma MapDom_canon : + forall m:Map A, mapcanon A m -> mapcanon unit (MapDom A m). Proof. - Induction m. Intro. Exact (M0_canon unit). - Intros a y H. Exact (M1_canon unit a ?). - Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 A ? ? H1). - Apply H0. Exact (mapcanon_M2_2 A ? ? H1). - Change (le (2) (MapCard unit (MapDom A (M2 A m0 m1)))). Rewrite <- MapCard_Dom. - Exact (mapcanon_M2 A ? ? H1). + simple induction m. intro. exact (M0_canon unit). + intros a y H. exact (M1_canon unit a _). + intros. simpl in |- *. apply M2_canon. apply H. exact (mapcanon_M2_1 A _ _ H1). + apply H0. exact (mapcanon_M2_2 A _ _ H1). + change (2 <= MapCard unit (MapDom A (M2 A m0 m1))) in |- *. rewrite <- MapCard_Dom. + exact (mapcanon_M2 A _ _ H1). Qed. End FSetCanon. Section MapFoldCanon. - Variable A, B : Set. - - Lemma MapFold_canon_1 : (m0:(Map B)) (mapcanon B m0) -> - (op : (Map B) -> (Map B) -> (Map B)) - ((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) -> - (mapcanon B (op m1 m2))) -> - (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) -> - (m:(Map A)) (pf : ad->ad) (mapcanon B (MapFold1 A (Map B) m0 op f pf m)). + Variables A B : Set. + + Lemma MapFold_canon_1 : + forall m0:Map B, + mapcanon B m0 -> + forall op:Map B -> Map B -> Map B, + (forall m1:Map B, + mapcanon B m1 -> + forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) -> + forall f:ad -> A -> Map B, + (forall (a:ad) (y:A), mapcanon B (f a y)) -> + forall (m:Map A) (pf:ad -> ad), + mapcanon B (MapFold1 A (Map B) m0 op f pf m). Proof. - Induction m. Intro. Exact H. - Intros a y pf. Simpl. Apply H1. - Intros. Simpl. Apply H0. Apply H2. - Apply H3. + simple induction m. intro. exact H. + intros a y pf. simpl in |- *. apply H1. + intros. simpl in |- *. apply H0. apply H2. + apply H3. Qed. - Lemma MapFold_canon : (m0:(Map B)) (mapcanon B m0) -> - (op : (Map B) -> (Map B) -> (Map B)) - ((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) -> - (mapcanon B (op m1 m2))) -> - (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) -> - (m:(Map A)) (mapcanon B (MapFold A (Map B) m0 op f m)). + Lemma MapFold_canon : + forall m0:Map B, + mapcanon B m0 -> + forall op:Map B -> Map B -> Map B, + (forall m1:Map B, + mapcanon B m1 -> + forall m2:Map B, mapcanon B m2 -> mapcanon B (op m1 m2)) -> + forall f:ad -> A -> Map B, + (forall (a:ad) (y:A), mapcanon B (f a y)) -> + forall m:Map A, mapcanon B (MapFold A (Map B) m0 op f m). Proof. - Intros. Exact (MapFold_canon_1 m0 H op H0 f H1 m [a:ad]a). + intros. exact (MapFold_canon_1 m0 H op H0 f H1 m (fun a:ad => a)). Qed. - Lemma MapCollect_canon : - (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) -> - (m:(Map A)) (mapcanon B (MapCollect A B f m)). + Lemma MapCollect_canon : + forall f:ad -> A -> Map B, + (forall (a:ad) (y:A), mapcanon B (f a y)) -> + forall m:Map A, mapcanon B (MapCollect A B f m). Proof. - Intros. Rewrite MapCollect_as_Fold. Apply MapFold_canon. Apply M0_canon. - Intros. Exact (MapMerge_canon B m1 m2 H0 H1). - Assumption. + intros. rewrite MapCollect_as_Fold. apply MapFold_canon. apply M0_canon. + intros. exact (MapMerge_canon B m1 m2 H0 H1). + assumption. Qed. -End MapFoldCanon. +End MapFoldCanon.
\ No newline at end of file diff --git a/theories/IntMap/Mapcard.v b/theories/IntMap/Mapcard.v index e124a11f6..fe598c412 100644 --- a/theories/IntMap/Mapcard.v +++ b/theories/IntMap/Mapcard.v @@ -7,664 +7,758 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Mapiter. -Require Fset. -Require Mapsubset. -Require PolyList. -Require Lsort. -Require Peano_dec. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Mapiter. +Require Import Fset. +Require Import Mapsubset. +Require Import List. +Require Import Lsort. +Require Import Peano_dec. Section MapCard. - Variable A, B : Set. + Variables A B : Set. + + Lemma MapCard_M0 : MapCard A (M0 A) = 0. + Proof. + trivial. + Qed. + + Lemma MapCard_M1 : forall (a:ad) (y:A), MapCard A (M1 A a y) = 1. + Proof. + trivial. + Qed. + + Lemma MapCard_is_O : + forall m:Map A, MapCard A m = 0 -> forall a:ad, MapGet A m a = NONE A. + Proof. + simple induction m. trivial. + intros a y H. discriminate H. + intros. simpl in H1. elim (plus_is_O _ _ H1). intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a). + case (ad_bit_0 a). apply H0. assumption. + apply H. assumption. + Qed. - Lemma MapCard_M0 : (MapCard A (M0 A))=O. + Lemma MapCard_is_not_O : + forall (m:Map A) (a:ad) (y:A), + MapGet A m a = SOME A y -> {n : nat | MapCard A m = S n}. Proof. - Trivial. + simple induction m. intros. discriminate H. + intros a y a0 y0 H. simpl in H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. split with 0. + reflexivity. + intro H0. rewrite H0 in H. discriminate H. + intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. elim (H0 (ad_div_2 a) y H1). intros n H3. + simpl in |- *. rewrite H3. split with (MapCard A m0 + n). + rewrite <- (plus_Snm_nSm (MapCard A m0) n). reflexivity. + intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. elim (H (ad_div_2 a) y H1). + intros n H3. simpl in |- *. rewrite H3. split with (n + MapCard A m1). reflexivity. Qed. - Lemma MapCard_M1 : (a:ad) (y:A) (MapCard A (M1 A a y))=(1). + Lemma MapCard_is_one : + forall m:Map A, + MapCard A m = 1 -> {a : ad & {y : A | MapGet A m a = SOME A y}}. Proof. - Trivial. + simple induction m. intro. discriminate H. + intros a y H. split with a. split with y. apply M1_semantics_1. + intros. simpl in H1. elim (plus_is_one (MapCard A m0) (MapCard A m1) H1). + intro H2. elim H2. intros. elim (H0 H4). intros a H5. split with (ad_double_plus_un a). + rewrite (MapGet_M2_bit_0_1 A _ (ad_double_plus_un_bit_0 a) m0 m1). + rewrite ad_double_plus_un_div_2. exact H5. + intro H2. elim H2. intros. elim (H H3). intros a H5. split with (ad_double a). + rewrite (MapGet_M2_bit_0_0 A _ (ad_double_bit_0 a) m0 m1). + rewrite ad_double_div_2. exact H5. Qed. - Lemma MapCard_is_O : (m:(Map A)) (MapCard A m)=O -> - (a:ad) (MapGet A m a)=(NONE A). + Lemma MapCard_is_one_unique : + forall m:Map A, + MapCard A m = 1 -> + forall (a a':ad) (y y':A), + MapGet A m a = SOME A y -> + MapGet A m a' = SOME A y' -> a = a' /\ y = y'. Proof. - Induction m. Trivial. - Intros a y H. Discriminate H. - Intros. Simpl in H1. Elim (plus_is_O ? ? H1). Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Case (ad_bit_0 a). Apply H0. Assumption. - Apply H. Assumption. + simple induction m. intro. discriminate H. + intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. rewrite (ad_eq_complete _ _ H2) in H0. + rewrite (M1_semantics_1 A a1 a0) in H0. inversion H0. elim (sumbool_of_bool (ad_eq a a')). + intro H5. rewrite (ad_eq_complete _ _ H5) in H1. rewrite (M1_semantics_1 A a' a0) in H1. + inversion H1. rewrite <- (ad_eq_complete _ _ H2). rewrite <- (ad_eq_complete _ _ H5). + rewrite <- H4. rewrite <- H6. split; reflexivity. + intro H5. rewrite (M1_semantics_2 A a a' a0 H5) in H1. discriminate H1. + intro H2. rewrite (M1_semantics_2 A a a1 a0 H2) in H0. discriminate H0. + intros. simpl in H1. elim (plus_is_one _ _ H1). intro H4. elim H4. intros. + rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. elim (sumbool_of_bool (ad_bit_0 a)). + intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. + elim (sumbool_of_bool (ad_bit_0 a')). intro H8. rewrite H8 in H3. elim (H0 H6 _ _ _ _ H2 H3). + intros. split. rewrite <- (ad_div_2_double_plus_un a H7). + rewrite <- (ad_div_2_double_plus_un a' H8). rewrite H9. reflexivity. + assumption. + intro H8. rewrite H8 in H3. rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3. + discriminate H3. + intro H7. rewrite H7 in H2. rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2. + discriminate H2. + intro H4. elim H4. intros. rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. + elim (sumbool_of_bool (ad_bit_0 a)). intro H7. rewrite H7 in H2. + rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. discriminate H2. + intro H7. rewrite H7 in H2. rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. + elim (sumbool_of_bool (ad_bit_0 a')). intro H8. rewrite H8 in H3. + rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. discriminate H3. + intro H8. rewrite H8 in H3. elim (H H5 _ _ _ _ H2 H3). intros. split. + rewrite <- (ad_div_2_double a H7). rewrite <- (ad_div_2_double a' H8). + rewrite H9. reflexivity. + assumption. Qed. - Lemma MapCard_is_not_O : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y) -> - {n:nat | (MapCard A m)=(S n)}. + Lemma length_as_fold : + forall (C:Set) (l:list C), + length l = fold_right (fun (_:C) (n:nat) => S n) 0 l. Proof. - Induction m. Intros. Discriminate H. - Intros a y a0 y0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Split with O. - Reflexivity. - Intro H0. Rewrite H0 in H. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Elim (H0 (ad_div_2 a) y H1). Intros n H3. - Simpl. Rewrite H3. Split with (plus (MapCard A m0) n). - Rewrite <- (plus_Snm_nSm (MapCard A m0) n). Reflexivity. - Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Elim (H (ad_div_2 a) y H1). - Intros n H3. Simpl. Rewrite H3. Split with (plus n (MapCard A m1)). Reflexivity. + simple induction l. reflexivity. + intros. simpl in |- *. rewrite H. reflexivity. Qed. - Lemma MapCard_is_one : (m:(Map A)) (MapCard A m)=(1) -> - {a:ad & {y:A | (MapGet A m a)=(SOME A y)}}. - Proof. - Induction m. Intro. Discriminate H. - Intros a y H. Split with a. Split with y. Apply M1_semantics_1. - Intros. Simpl in H1. Elim (plus_is_one (MapCard A m0) (MapCard A m1) H1). - Intro H2. Elim H2. Intros. Elim (H0 H4). Intros a H5. Split with (ad_double_plus_un a). - Rewrite (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite ad_double_plus_un_div_2. Exact H5. - Intro H2. Elim H2. Intros. Elim (H H3). Intros a H5. Split with (ad_double a). - Rewrite (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1). - Rewrite ad_double_div_2. Exact H5. - Qed. - - Lemma MapCard_is_one_unique : (m:(Map A)) (MapCard A m)=(1) -> (a,a':ad) (y,y':A) - (MapGet A m a)=(SOME A y) -> (MapGet A m a')=(SOME A y') -> - a=a' /\ y=y'. - Proof. - Induction m. Intro. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0. - Rewrite (M1_semantics_1 A a1 a0) in H0. Inversion H0. Elim (sumbool_of_bool (ad_eq a a')). - Intro H5. Rewrite (ad_eq_complete ? ? H5) in H1. Rewrite (M1_semantics_1 A a' a0) in H1. - Inversion H1. Rewrite <- (ad_eq_complete ? ? H2). Rewrite <- (ad_eq_complete ? ? H5). - Rewrite <- H4. Rewrite <- H6. (Split; Reflexivity). - Intro H5. Rewrite (M1_semantics_2 A a a' a0 H5) in H1. Discriminate H1. - Intro H2. Rewrite (M1_semantics_2 A a a1 a0 H2) in H0. Discriminate H0. - Intros. Simpl in H1. Elim (plus_is_one ? ? H1). Intro H4. Elim H4. Intros. - Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. Elim (sumbool_of_bool (ad_bit_0 a)). - Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. Elim (H0 H6 ? ? ? ? H2 H3). - Intros. Split. Rewrite <- (ad_div_2_double_plus_un a H7). - Rewrite <- (ad_div_2_double_plus_un a' H8). Rewrite H9. Reflexivity. - Assumption. - Intro H8. Rewrite H8 in H3. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3. - Discriminate H3. - Intro H7. Rewrite H7 in H2. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2. - Discriminate H2. - Intro H4. Elim H4. Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H7. Rewrite H7 in H2. - Rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. Discriminate H2. - Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3. - Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. - Rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. Discriminate H3. - Intro H8. Rewrite H8 in H3. Elim (H H5 ? ? ? ? H2 H3). Intros. Split. - Rewrite <- (ad_div_2_double a H7). Rewrite <- (ad_div_2_double a' H8). - Rewrite H9. Reflexivity. - Assumption. - Qed. - - Lemma length_as_fold : (C:Set) (l:(list C)) - (length l)=(fold_right [_:C][n:nat](S n) O l). - Proof. - Induction l. Reflexivity. - Intros. Simpl. Rewrite H. Reflexivity. - Qed. - - Lemma length_as_fold_2 : (l:(alist A)) - (length l)=(fold_right [r:ad*A][n:nat]let (a,y)=r in (plus (1) n) O l). - Proof. - Induction l. Reflexivity. - Intros. Simpl. Rewrite H. (Elim a; Reflexivity). - Qed. - - Lemma MapCard_as_Fold_1 : (m:(Map A)) (pf:ad->ad) - (MapCard A m)=(MapFold1 A nat O plus [_:ad][_:A](1) pf m). - Proof. - Induction m. Trivial. - Trivial. - Intros. Simpl. Rewrite <- (H [a0:ad](pf (ad_double a0))). - Rewrite <- (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity. - Qed. - - Lemma MapCard_as_Fold : - (m:(Map A)) (MapCard A m)=(MapFold A nat O plus [_:ad][_:A](1) m). - Proof. - Intro. Exact (MapCard_as_Fold_1 m [a0:ad]a0). + Lemma length_as_fold_2 : + forall l:alist A, + length l = + fold_right (fun (r:ad * A) (n:nat) => let (a, y) := r in 1 + n) 0 l. + Proof. + simple induction l. reflexivity. + intros. simpl in |- *. rewrite H. elim a; reflexivity. + Qed. + + Lemma MapCard_as_Fold_1 : + forall (m:Map A) (pf:ad -> ad), + MapCard A m = MapFold1 A nat 0 plus (fun (_:ad) (_:A) => 1) pf m. + Proof. + simple induction m. trivial. + trivial. + intros. simpl in |- *. rewrite <- (H (fun a0:ad => pf (ad_double a0))). + rewrite <- (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. + Qed. + + Lemma MapCard_as_Fold : + forall m:Map A, + MapCard A m = MapFold A nat 0 plus (fun (_:ad) (_:A) => 1) m. + Proof. + intro. exact (MapCard_as_Fold_1 m (fun a0:ad => a0)). Qed. - Lemma MapCard_as_length : (m:(Map A)) (MapCard A m)=(length (alist_of_Map A m)). - Proof. - Intro. Rewrite MapCard_as_Fold. Rewrite length_as_fold_2. - Apply MapFold_as_fold with op:=plus neutral:=O f:=[_:ad][_:A](1). Exact plus_assoc_r. - Trivial. - Intro. Rewrite <- plus_n_O. Reflexivity. - Qed. - - Lemma MapCard_Put1_equals_2 : (p:positive) (a,a':ad) (y,y':A) - (MapCard A (MapPut1 A a y a' y' p))=(2). - Proof. - Induction p. Intros. Simpl. (Case (ad_bit_0 a); Reflexivity). - Intros. Simpl. Case (ad_bit_0 a). Exact (H (ad_div_2 a) (ad_div_2 a') y y'). - Simpl. Rewrite <- plus_n_O. Exact (H (ad_div_2 a) (ad_div_2 a') y y'). - Intros. Simpl. (Case (ad_bit_0 a); Reflexivity). - Qed. - - Lemma MapCard_Put_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat) - m'=(MapPut A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') -> - {n'=n}+{n'=(S n)}. - Proof. - Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Right . - Rewrite H0. Rewrite H1. Reflexivity. - Intros a y m' a0 y0 n n' H H0 H1. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H2. - Elim H2. Intros p H3. Rewrite H3 in H. Rewrite H in H1. - Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. Simpl in H0. Right . - Rewrite H0. Rewrite H1. Reflexivity. - Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Simpl in H0. Left . - Rewrite H0. Rewrite H1. Reflexivity. - Intros. Simpl in H2. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. - Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4. Rewrite H4 in H1. - Elim (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m1) - (MapCard A (MapPut A m1 (ad_div_2 a) y)) (refl_equal ? ?) - (refl_equal ? ?) (refl_equal ? ?)). - Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3. Left . - Assumption. - Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. - Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3. - Simpl in H3. Rewrite <- H2 in H3. Right . Assumption. - Intro H4. Rewrite H4 in H1. - Elim (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m0) - (MapCard A (MapPut A m0 (ad_div_2 a) y)) (refl_equal ? ?) - (refl_equal ? ?) (refl_equal ? ?)). - Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3. - Left . Assumption. - Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Simpl in H3. Rewrite <- H2 in H3. - Right . Assumption. - Qed. - - Lemma MapCard_Put_lb : (m:(Map A)) (a:ad) (y:A) - (ge (MapCard A (MapPut A m a y)) (MapCard A m)). - Proof. - Unfold ge. Intros. - Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) - (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H. Rewrite H. Apply le_n. - Intro H. Rewrite H. Apply le_n_Sn. - Qed. - - Lemma MapCard_Put_ub : (m:(Map A)) (a:ad) (y:A) - (le (MapCard A (MapPut A m a y)) (S (MapCard A m))). - Proof. - Intros. - Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) - (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H. Rewrite H. Apply le_n_Sn. - Intro H. Rewrite H. Apply le_n. - Qed. - - Lemma MapCard_Put_1 : (m:(Map A)) (a:ad) (y:A) - (MapCard A (MapPut A m a y))=(MapCard A m) -> - {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y a0 y0 H. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H0. Elim H0. - Intros p H1. Rewrite H1 in H. Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H. - Discriminate H. - Intro H0. Rewrite H0 in H. Rewrite (ad_xor_eq ? ? H0). Split with y. Apply M1_semantics_1. - Intros. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. Elim (sumbool_of_bool (ad_bit_0 a)). - Intro H2. Rewrite H2 in H1. Simpl in H1. Elim (H0 (ad_div_2 a) y (simpl_plus_l ? ? ? H1)). - Intros y0 H3. Split with y0. Rewrite <- H3. Exact (MapGet_M2_bit_0_1 A a H2 m0 m1). - Intro H2. Rewrite H2 in H1. Simpl in H1. - Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H1. - Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. - Elim (H (ad_div_2 a) y (simpl_plus_l ? ? ? H1)). Intros y0 H3. Split with y0. - Rewrite <- H3. Exact (MapGet_M2_bit_0_0 A a H2 m0 m1). - Qed. - - Lemma MapCard_Put_2 : (m:(Map A)) (a:ad) (y:A) - (MapCard A (MapPut A m a y))=(S (MapCard A m)) -> (MapGet A m a)=(NONE A). - Proof. - Induction m. Trivial. - Intros. Simpl in H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. - Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_xor_nilpotent a1) in H. Discriminate H. - Intro H0. Exact (M1_semantics_2 A a a1 a0 H0). - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply (H0 (ad_div_2 a) y). - Apply simpl_plus_l with n:=(MapCard A m0). - Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). Simpl in H1. Simpl. Rewrite <- H1. - Clear H1. - NewInduction a. Discriminate H2. - NewInduction p. Reflexivity. - Discriminate H2. - Reflexivity. - Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply (H (ad_div_2 a) y). - Cut (plus (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) - =(plus (S (MapCard A m0)) (MapCard A m1)). - Intro. Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H3. - Rewrite (plus_sym (S (MapCard A m0)) (MapCard A m1)) in H3. Exact (simpl_plus_l ? ? ? H3). - Simpl. Simpl in H1. Rewrite <- H1. NewInduction a. Trivial. - NewInduction p. Discriminate H2. - Reflexivity. - Discriminate H2. - Qed. - - Lemma MapCard_Put_1_conv : (m:(Map A)) (a:ad) (y,y':A) - (MapGet A m a)=(SOME A y) -> (MapCard A (MapPut A m a y'))=(MapCard A m). - Proof. - Intros. - Elim (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m) - (MapCard A (MapPut A m a y')) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Trivial. - Intro H0. Rewrite (MapCard_Put_2 m a y' H0) in H. Discriminate H. - Qed. - - Lemma MapCard_Put_2_conv : (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(NONE A) -> (MapCard A (MapPut A m a y))=(S (MapCard A m)). - Proof. - Intros. - Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) - (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H0. Elim (MapCard_Put_1 m a y H0). Intros y' H1. Rewrite H1 in H. Discriminate H. - Trivial. - Qed. - - Lemma MapCard_ext : (m,m':(Map A)) - (eqm A (MapGet A m) (MapGet A m')) -> (MapCard A m)=(MapCard A m'). - Proof. - Unfold eqm. Intros. Rewrite (MapCard_as_length m). Rewrite (MapCard_as_length m'). - Rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). Reflexivity. - Unfold eqm. Intro. Rewrite (Map_of_alist_semantics A (alist_of_Map A m) a). - Rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). Rewrite (Map_of_alist_of_Map A m' a). - Rewrite (Map_of_alist_of_Map A m a). Exact (H a). - Apply alist_of_Map_sorts2. - Apply alist_of_Map_sorts2. - Qed. - - Lemma MapCard_Dom : (m:(Map A)) (MapCard A m)=(MapCard unit (MapDom A m)). - Proof. - (Induction m; Trivial). Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity. - Qed. - - Lemma MapCard_Dom_Put_behind : (m:(Map A)) (a:ad) (y:A) - (MapDom A (MapPut_behind A m a y))=(MapDom A (MapPut A m a y)). - Proof. - Induction m. Trivial. - Intros a y a0 y0. Simpl. Elim (ad_sum (ad_xor a a0)). Intro H. Elim H. - Intros p H0. Rewrite H0. Reflexivity. - Intro H. Rewrite H. Rewrite (ad_xor_eq ? ? H). Reflexivity. - Intros. Simpl. Elim (ad_sum a). Intro H1. Elim H1. Intros p H2. Rewrite H2. Case p. - Intro p0. Simpl. Rewrite H0. Reflexivity. - Intro p0. Simpl. Rewrite H. Reflexivity. - Simpl. Rewrite H0. Reflexivity. - Intro H1. Rewrite H1. Simpl. Rewrite H. Reflexivity. - Qed. - - Lemma MapCard_Put_behind_Put : (m:(Map A)) (a:ad) (y:A) - (MapCard A (MapPut_behind A m a y))=(MapCard A (MapPut A m a y)). - Proof. - Intros. Rewrite MapCard_Dom. Rewrite MapCard_Dom. Rewrite MapCard_Dom_Put_behind. - Reflexivity. - Qed. - - Lemma MapCard_Put_behind_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat) - m'=(MapPut_behind A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') -> - {n'=n}+{n'=(S n)}. - Proof. - Intros. (Apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); Trivial). - Rewrite <- MapCard_Put_behind_Put. Rewrite <- H. Assumption. - Qed. + Lemma MapCard_as_length : + forall m:Map A, MapCard A m = length (alist_of_Map A m). + Proof. + intro. rewrite MapCard_as_Fold. rewrite length_as_fold_2. + apply MapFold_as_fold with + (op := plus) (neutral := 0) (f := fun (_:ad) (_:A) => 1). exact plus_assoc_reverse. + trivial. + intro. rewrite <- plus_n_O. reflexivity. + Qed. + + Lemma MapCard_Put1_equals_2 : + forall (p:positive) (a a':ad) (y y':A), + MapCard A (MapPut1 A a y a' y' p) = 2. + Proof. + simple induction p. intros. simpl in |- *. case (ad_bit_0 a); reflexivity. + intros. simpl in |- *. case (ad_bit_0 a). exact (H (ad_div_2 a) (ad_div_2 a') y y'). + simpl in |- *. rewrite <- plus_n_O. exact (H (ad_div_2 a) (ad_div_2 a') y y'). + intros. simpl in |- *. case (ad_bit_0 a); reflexivity. + Qed. + + Lemma MapCard_Put_sum : + forall (m m':Map A) (a:ad) (y:A) (n n':nat), + m' = MapPut A m a y -> + n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}. + Proof. + simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. right. + rewrite H0. rewrite H1. reflexivity. + intros a y m' a0 y0 n n' H H0 H1. simpl in H. elim (ad_sum (ad_xor a a0)). intro H2. + elim H2. intros p H3. rewrite H3 in H. rewrite H in H1. + rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. simpl in H0. right. + rewrite H0. rewrite H1. reflexivity. + intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. simpl in H0. left. + rewrite H0. rewrite H1. reflexivity. + intros. simpl in H2. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. + elim (sumbool_of_bool (ad_bit_0 a)). intro H4. rewrite H4 in H1. + elim + (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y ( + MapCard A m1) (MapCard A (MapPut A m1 (ad_div_2 a) y)) ( + refl_equal _) (refl_equal _) (refl_equal _)). + intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. left. + assumption. + intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. + rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3. + simpl in H3. rewrite <- H2 in H3. right. assumption. + intro H4. rewrite H4 in H1. + elim + (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y ( + MapCard A m0) (MapCard A (MapPut A m0 (ad_div_2 a) y)) ( + refl_equal _) (refl_equal _) (refl_equal _)). + intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. rewrite <- H2 in H3. + left. assumption. + intro H5. rewrite H1 in H3. simpl in H3. rewrite H5 in H3. simpl in H3. rewrite <- H2 in H3. + right. assumption. + Qed. + + Lemma MapCard_Put_lb : + forall (m:Map A) (a:ad) (y:A), MapCard A (MapPut A m a y) >= MapCard A m. + Proof. + unfold ge in |- *. intros. + elim + (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) + (MapCard A (MapPut A m a y)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n. + intro H. rewrite H. apply le_n_Sn. + Qed. + + Lemma MapCard_Put_ub : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut A m a y) <= S (MapCard A m). + Proof. + intros. + elim + (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) + (MapCard A (MapPut A m a y)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n_Sn. + intro H. rewrite H. apply le_n. + Qed. + + Lemma MapCard_Put_1 : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut A m a y) = MapCard A m -> + {y : A | MapGet A m a = SOME A y}. + Proof. + simple induction m. intros. discriminate H. + intros a y a0 y0 H. simpl in H. elim (ad_sum (ad_xor a a0)). intro H0. elim H0. + intros p H1. rewrite H1 in H. rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H. + discriminate H. + intro H0. rewrite H0 in H. rewrite (ad_xor_eq _ _ H0). split with y. apply M1_semantics_1. + intros. rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. elim (sumbool_of_bool (ad_bit_0 a)). + intro H2. rewrite H2 in H1. simpl in H1. elim (H0 (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). + intros y0 H3. split with y0. rewrite <- H3. exact (MapGet_M2_bit_0_1 A a H2 m0 m1). + intro H2. rewrite H2 in H1. simpl in H1. + rewrite + (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) + in H1. + rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. + elim (H (ad_div_2 a) y ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1)). intros y0 H3. split with y0. + rewrite <- H3. exact (MapGet_M2_bit_0_0 A a H2 m0 m1). + Qed. + + Lemma MapCard_Put_2 : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut A m a y) = S (MapCard A m) -> MapGet A m a = NONE A. + Proof. + simple induction m. trivial. + intros. simpl in H. elim (sumbool_of_bool (ad_eq a a1)). intro H0. + rewrite (ad_eq_complete _ _ H0) in H. rewrite (ad_xor_nilpotent a1) in H. discriminate H. + intro H0. exact (M1_semantics_2 A a a1 a0 H0). + intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply (H0 (ad_div_2 a) y). + apply (fun n m p:nat => plus_reg_l m p n) with (n := MapCard A m0). + rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). simpl in H1. simpl in |- *. rewrite <- H1. + clear H1. + induction a. discriminate H2. + induction p. reflexivity. + discriminate H2. + reflexivity. + intro H2. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply (H (ad_div_2 a) y). + cut + (MapCard A (MapPut A m0 (ad_div_2 a) y) + MapCard A m1 = + S (MapCard A m0) + MapCard A m1). + intro. rewrite (plus_comm (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) + in H3. + rewrite (plus_comm (S (MapCard A m0)) (MapCard A m1)) in H3. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H3). + simpl in |- *. simpl in H1. rewrite <- H1. induction a. trivial. + induction p. discriminate H2. + reflexivity. + discriminate H2. + Qed. + + Lemma MapCard_Put_1_conv : + forall (m:Map A) (a:ad) (y y':A), + MapGet A m a = SOME A y -> MapCard A (MapPut A m a y') = MapCard A m. + Proof. + intros. + elim + (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m) + (MapCard A (MapPut A m a y')) (refl_equal _) ( + refl_equal _) (refl_equal _)). + trivial. + intro H0. rewrite (MapCard_Put_2 m a y' H0) in H. discriminate H. + Qed. + + Lemma MapCard_Put_2_conv : + forall (m:Map A) (a:ad) (y:A), + MapGet A m a = NONE A -> MapCard A (MapPut A m a y) = S (MapCard A m). + Proof. + intros. + elim + (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m) + (MapCard A (MapPut A m a y)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H0. elim (MapCard_Put_1 m a y H0). intros y' H1. rewrite H1 in H. discriminate H. + trivial. + Qed. + + Lemma MapCard_ext : + forall m m':Map A, + eqm A (MapGet A m) (MapGet A m') -> MapCard A m = MapCard A m'. + Proof. + unfold eqm in |- *. intros. rewrite (MapCard_as_length m). rewrite (MapCard_as_length m'). + rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). reflexivity. + unfold eqm in |- *. intro. rewrite (Map_of_alist_semantics A (alist_of_Map A m) a). + rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). rewrite (Map_of_alist_of_Map A m' a). + rewrite (Map_of_alist_of_Map A m a). exact (H a). + apply alist_of_Map_sorts2. + apply alist_of_Map_sorts2. + Qed. + + Lemma MapCard_Dom : forall m:Map A, MapCard A m = MapCard unit (MapDom A m). + Proof. + simple induction m; trivial. intros. simpl in |- *. rewrite H. rewrite H0. reflexivity. + Qed. + + Lemma MapCard_Dom_Put_behind : + forall (m:Map A) (a:ad) (y:A), + MapDom A (MapPut_behind A m a y) = MapDom A (MapPut A m a y). + Proof. + simple induction m. trivial. + intros a y a0 y0. simpl in |- *. elim (ad_sum (ad_xor a a0)). intro H. elim H. + intros p H0. rewrite H0. reflexivity. + intro H. rewrite H. rewrite (ad_xor_eq _ _ H). reflexivity. + intros. simpl in |- *. elim (ad_sum a). intro H1. elim H1. intros p H2. rewrite H2. case p. + intro p0. simpl in |- *. rewrite H0. reflexivity. + intro p0. simpl in |- *. rewrite H. reflexivity. + simpl in |- *. rewrite H0. reflexivity. + intro H1. rewrite H1. simpl in |- *. rewrite H. reflexivity. + Qed. + + Lemma MapCard_Put_behind_Put : + forall (m:Map A) (a:ad) (y:A), + MapCard A (MapPut_behind A m a y) = MapCard A (MapPut A m a y). + Proof. + intros. rewrite MapCard_Dom. rewrite MapCard_Dom. rewrite MapCard_Dom_Put_behind. + reflexivity. + Qed. - Lemma MapCard_makeM2 : (m,m':(Map A)) - (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')). + Lemma MapCard_Put_behind_sum : + forall (m m':Map A) (a:ad) (y:A) (n n':nat), + m' = MapPut_behind A m a y -> + n = MapCard A m -> n' = MapCard A m' -> {n' = n} + {n' = S n}. + Proof. + intros. apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); trivial. + rewrite <- MapCard_Put_behind_Put. rewrite <- H. assumption. + Qed. + + Lemma MapCard_makeM2 : + forall m m':Map A, MapCard A (makeM2 A m m') = MapCard A m + MapCard A m'. Proof. - Intros. Rewrite (MapCard_ext ? ? (makeM2_M2 A m m')). Reflexivity. + intros. rewrite (MapCard_ext _ _ (makeM2_M2 A m m')). reflexivity. Qed. - Lemma MapCard_Remove_sum : (m,m':(Map A)) (a:ad) (n,n':nat) - m'=(MapRemove A m a) -> n=(MapCard A m) -> n'=(MapCard A m') -> - {n=n'}+{n=(S n')}. - Proof. - Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption. - Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite H2 in H. - Rewrite H in H1. Simpl in H1. Right . Rewrite H1. Assumption. - Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption. - Intros. Simpl in H1. Simpl in H2. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4. - Rewrite H4 in H1. Rewrite H1 in H3. - Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3. - Elim (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) (MapCard A m1) - (MapCard A (MapRemove A m1 (ad_div_2 a))) (refl_equal ? ?) - (refl_equal ? ?) (refl_equal ? ?)). - Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2. - Intro H5. Rewrite H5 in H2. - Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H2. - Right . Rewrite H3. Exact H2. - Intro H4. Rewrite H4 in H1. Rewrite H1 in H3. - Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3. - Elim (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) (MapCard A m0) - (MapCard A (MapRemove A m0 (ad_div_2 a))) (refl_equal ? ?) - (refl_equal ? ?) (refl_equal ? ?)). - Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2. - Intro H5. Rewrite H5 in H2. Right . Rewrite H3. Exact H2. - Qed. - - Lemma MapCard_Remove_ub : (m:(Map A)) (a:ad) - (le (MapCard A (MapRemove A m a)) (MapCard A m)). - Proof. - Intros. - Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H. Rewrite H. Apply le_n. - Intro H. Rewrite H. Apply le_n_Sn. - Qed. - - Lemma MapCard_Remove_lb : (m:(Map A)) (a:ad) - (ge (S (MapCard A (MapRemove A m a))) (MapCard A m)). - Proof. - Unfold ge. Intros. - Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H. Rewrite H. Apply le_n_Sn. - Intro H. Rewrite H. Apply le_n. - Qed. - - Lemma MapCard_Remove_1 : (m:(Map A)) (a:ad) - (MapCard A (MapRemove A m a))=(MapCard A m) -> (MapGet A m a)=(NONE A). - Proof. - Induction m. Trivial. - Simpl. Intros a y a0 H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. - Rewrite H0 in H. Discriminate H. - Intro H0. Rewrite H0. Reflexivity. - Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1. - Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. Exact (simpl_plus_l ? ? ? H1). - Intro H2. Rewrite H2 in H1. - Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. - Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H. - Rewrite (plus_sym (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) in H1. - Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1). - Qed. - - Lemma MapCard_Remove_2 : (m:(Map A)) (a:ad) - (S (MapCard A (MapRemove A m a)))=(MapCard A m) -> - {y:A | (MapGet A m a)=(SOME A y)}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y a0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. - Rewrite (ad_eq_complete ? ? H0). Split with y. Exact (M1_semantics_1 A a0 y). - Intro H0. Rewrite H0 in H. Discriminate H. - Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1. - Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. - Change (plus (S (MapCard A m0)) (MapCard A (MapRemove A m1 (ad_div_2 a)))) - =(plus (MapCard A m0) (MapCard A m1)) in H1. - Rewrite (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H1. - Exact (simpl_plus_l ? ? ? H1). - Intro H2. Rewrite H2 in H1. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H. - Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. - Change (plus (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) - =(plus (MapCard A m0) (MapCard A m1)) in H1. - Rewrite (plus_sym (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) in H1. - Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1). - Qed. - - Lemma MapCard_Remove_1_conv : (m:(Map A)) (a:ad) - (MapGet A m a)=(NONE A) -> (MapCard A (MapRemove A m a))=(MapCard A m). - Proof. - Intros. - Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H0. Rewrite H0. Reflexivity. - Intro H0. Elim (MapCard_Remove_2 m a (sym_eq ? ? ? H0)). Intros y H1. Rewrite H1 in H. - Discriminate H. - Qed. - - Lemma MapCard_Remove_2_conv : (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(SOME A y) -> - (S (MapCard A (MapRemove A m a)))=(MapCard A m). - Proof. - Intros. - Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) - (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?) - (refl_equal ? ?)). - Intro H0. Rewrite (MapCard_Remove_1 m a (sym_eq ? ? ? H0)) in H. Discriminate H. - Intro H0. Rewrite H0. Reflexivity. - Qed. - - Lemma MapMerge_Restr_Card : (m,m':(Map A)) - (plus (MapCard A m) (MapCard A m'))= - (plus (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))). - Proof. - Induction m. Simpl. Intro. Apply plus_n_O. - Simpl. Intros a y m'. Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y0 H0. - Rewrite H0. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_1_conv m' a y0 y H0). - Simpl. Rewrite <- plus_Snm_nSm. Apply plus_n_O. - Intro H. Rewrite H. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_2_conv m' a y H). - Apply plus_n_O. - Intros. - Change (plus (plus (MapCard A m0) (MapCard A m1)) (MapCard A m')) - =(plus (MapCard A (MapMerge A (M2 A m0 m1) m')) - (MapCard A (MapDomRestrTo A A (M2 A m0 m1) m'))). - Elim m'. Reflexivity. - Intros a y. Unfold MapMerge. Unfold MapDomRestrTo. - Elim (option_sum A (MapGet A (M2 A m0 m1) a)). Intro H1. Elim H1. Intros y0 H2. Rewrite H2. - Rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). Reflexivity. - Intro H1. Rewrite H1. Rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). Simpl. - Rewrite <- (plus_Snm_nSm (plus (MapCard A m0) (MapCard A m1)) O). Reflexivity. - Intros. Simpl. - Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) (MapCard A m2) (MapCard A m3)). - Rewrite (H m2). Rewrite (H0 m3). - Rewrite (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)). - Apply plus_permute_2_in_4. - Qed. - - Lemma MapMerge_disjoint_Card : (m,m':(Map A)) (MapDisjoint A A m m') -> - (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')). - Proof. - Intros. Rewrite (MapMerge_Restr_Card m m'). - Rewrite (MapCard_ext ? ? (MapDisjoint_imp_2 ? ? ? ? H)). Apply plus_n_O. - Qed. - - Lemma MapSplit_Card : (m:(Map A)) (m':(Map B)) - (MapCard A m)=(plus (MapCard A (MapDomRestrTo A B m m')) - (MapCard A (MapDomRestrBy A B m m'))). - Proof. - Intros. Rewrite (MapCard_ext ? ? (MapDom_Split_1 A B m m')). Apply MapMerge_disjoint_Card. - Apply MapDisjoint_2_imp. Unfold MapDisjoint_2. Apply MapDom_Split_3. - Qed. - - Lemma MapMerge_Card_ub : (m,m':(Map A)) - (le (MapCard A (MapMerge A m m')) (plus (MapCard A m) (MapCard A m'))). - Proof. - Intros. Rewrite MapMerge_Restr_Card. Apply le_plus_l. - Qed. - - Lemma MapDomRestrTo_Card_ub_l : (m:(Map A)) (m':(Map B)) - (le (MapCard A (MapDomRestrTo A B m m')) (MapCard A m)). - Proof. - Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_l. - Qed. - - Lemma MapDomRestrBy_Card_ub_l : (m:(Map A)) (m':(Map B)) - (le (MapCard A (MapDomRestrBy A B m m')) (MapCard A m)). - Proof. - Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_r. - Qed. - - Lemma MapMerge_Card_disjoint : (m,m':(Map A)) - (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')) -> - (MapDisjoint A A m m'). - Proof. - Induction m. Intros. Apply Map_M0_disjoint. - Simpl. Intros. Rewrite (MapCard_Put_behind_Put m' a a0) in H. Unfold MapDisjoint in_dom. - Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. - Rewrite (ad_eq_complete ? ? H2) in H. Rewrite (MapCard_Put_2 m' a1 a0 H) in H1. - Discriminate H1. - Intro H2. Rewrite H2 in H0. Discriminate H0. - Induction m'. Intros. Apply Map_disjoint_M0. - Intros a y H1. Rewrite <- (MapCard_ext ? ? (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1. - Unfold 3 MapCard in H1. Rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) O) in H1. - Rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. Unfold MapDisjoint in_dom. - Unfold 2 MapGet. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H4. - Rewrite <- (ad_eq_complete ? ? H4) in H2. Rewrite (MapCard_Put_2 ? ? ? H1) in H2. - Discriminate H2. - Intro H4. Rewrite H4 in H3. Discriminate H3. - Intros. Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H6. - Unfold MapDisjoint in H0. Apply H0 with m':=m3 a:=(ad_div_2 a). Apply le_antisym. - Apply MapMerge_Card_ub. - Apply simpl_le_plus_l with p:=(plus (MapCard A m0) (MapCard A m2)). - Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)). - Change (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3))) - =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3. - Rewrite <- H3. Simpl. Apply le_reg_r. Apply MapMerge_Card_ub. - Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m0 m1) in H7. - Unfold in_dom. Rewrite H7. Reflexivity. - Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m2 m3) in H7. - Unfold in_dom. Rewrite H7. Reflexivity. - Intro H6. Unfold MapDisjoint in H. Apply H with m':=m2 a:=(ad_div_2 a). Apply le_antisym. - Apply MapMerge_Card_ub. - Apply simpl_le_plus_l with p:=(plus (MapCard A m1) (MapCard A m3)). - Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (plus (MapCard A m0) (MapCard A m2))). - Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)). - Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (MapCard A (MapMerge A m0 m2))). - Change (plus (MapCard A (MapMerge A m0 m2)) (MapCard A (MapMerge A m1 m3))) - =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3. - Rewrite <- H3. Apply le_reg_l. Apply MapMerge_Card_ub. - Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m0 m1) in H7. - Unfold in_dom. Rewrite H7. Reflexivity. - Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m2 m3) in H7. - Unfold in_dom. Rewrite H7. Reflexivity. - Qed. - - Lemma MapCard_is_Sn : (m:(Map A)) (n:nat) (MapCard ? m)=(S n) -> - {a:ad | (in_dom ? a m)=true}. - Proof. - Induction m. Intros. Discriminate H. - Intros a y n H. Split with a. Unfold in_dom. Rewrite (M1_semantics_1 ? a y). Reflexivity. - Intros. Simpl in H1. Elim (O_or_S (MapCard ? m0)). Intro H2. Elim H2. Intros m2 H3. - Elim (H ? (sym_eq ? ? ? H3)). Intros a H4. Split with (ad_double a). Unfold in_dom. - Rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1). - Rewrite (ad_double_div_2 a). Elim (in_dom_some ? ? ? H4). Intros y H5. Rewrite H5. Reflexivity. - Intro H2. Rewrite <- H2 in H1. Simpl in H1. Elim (H0 ? H1). Intros a H3. - Split with (ad_double_plus_un a). Unfold in_dom. - Rewrite (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite (ad_double_plus_un_div_2 a). Elim (in_dom_some ? ? ? H3). Intros y H4. Rewrite H4. - Reflexivity. + Lemma MapCard_Remove_sum : + forall (m m':Map A) (a:ad) (n n':nat), + m' = MapRemove A m a -> + n = MapCard A m -> n' = MapCard A m' -> {n = n'} + {n = S n'}. + Proof. + simple induction m. simpl in |- *. intros. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. + simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. rewrite H2 in H. + rewrite H in H1. simpl in H1. right. rewrite H1. assumption. + intro H2. rewrite H2 in H. rewrite H in H1. simpl in H1. left. rewrite H1. assumption. + intros. simpl in H1. simpl in H2. elim (sumbool_of_bool (ad_bit_0 a)). intro H4. + rewrite H4 in H1. rewrite H1 in H3. + rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3. + elim + (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) ( + MapCard A m1) (MapCard A (MapRemove A m1 (ad_div_2 a))) + (refl_equal _) (refl_equal _) (refl_equal _)). + intro H5. rewrite H5 in H2. left. rewrite H3. exact H2. + intro H5. rewrite H5 in H2. + rewrite <- + (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) + in H2. + right. rewrite H3. exact H2. + intro H4. rewrite H4 in H1. rewrite H1 in H3. + rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3. + elim + (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) ( + MapCard A m0) (MapCard A (MapRemove A m0 (ad_div_2 a))) + (refl_equal _) (refl_equal _) (refl_equal _)). + intro H5. rewrite H5 in H2. left. rewrite H3. exact H2. + intro H5. rewrite H5 in H2. right. rewrite H3. exact H2. + Qed. + + Lemma MapCard_Remove_ub : + forall (m:Map A) (a:ad), MapCard A (MapRemove A m a) <= MapCard A m. + Proof. + intros. + elim + (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) + (MapCard A (MapRemove A m a)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n. + intro H. rewrite H. apply le_n_Sn. + Qed. + + Lemma MapCard_Remove_lb : + forall (m:Map A) (a:ad), S (MapCard A (MapRemove A m a)) >= MapCard A m. + Proof. + unfold ge in |- *. intros. + elim + (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) + (MapCard A (MapRemove A m a)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H. rewrite H. apply le_n_Sn. + intro H. rewrite H. apply le_n. + Qed. + + Lemma MapCard_Remove_1 : + forall (m:Map A) (a:ad), + MapCard A (MapRemove A m a) = MapCard A m -> MapGet A m a = NONE A. + Proof. + simple induction m. trivial. + simpl in |- *. intros a y a0 H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. + rewrite H0 in H. discriminate H. + intro H0. rewrite H0. reflexivity. + intros. simpl in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2 in H1. + rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + intro H2. rewrite H2 in H1. + rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. + rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. + rewrite + (plus_comm (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) + in H1. + rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + Qed. + + Lemma MapCard_Remove_2 : + forall (m:Map A) (a:ad), + S (MapCard A (MapRemove A m a)) = MapCard A m -> + {y : A | MapGet A m a = SOME A y}. + Proof. + simple induction m. intros. discriminate H. + intros a y a0 H. simpl in H. elim (sumbool_of_bool (ad_eq a a0)). intro H0. + rewrite (ad_eq_complete _ _ H0). split with y. exact (M1_semantics_1 A a0 y). + intro H0. rewrite H0 in H. discriminate H. + intros. simpl in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. rewrite H2 in H1. + rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). apply H0. + change + (S (MapCard A m0) + MapCard A (MapRemove A m1 (ad_div_2 a)) = + MapCard A m0 + MapCard A m1) in H1. + rewrite + (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) + in H1. + exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + intro H2. rewrite H2 in H1. rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). apply H. + rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1. + change + (S (MapCard A (MapRemove A m0 (ad_div_2 a))) + MapCard A m1 = + MapCard A m0 + MapCard A m1) in H1. + rewrite + (plus_comm (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) + in H1. + rewrite (plus_comm (MapCard A m0) (MapCard A m1)) in H1. exact ((fun n m p:nat => plus_reg_l m p n) _ _ _ H1). + Qed. + + Lemma MapCard_Remove_1_conv : + forall (m:Map A) (a:ad), + MapGet A m a = NONE A -> MapCard A (MapRemove A m a) = MapCard A m. + Proof. + intros. + elim + (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) + (MapCard A (MapRemove A m a)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H0. rewrite H0. reflexivity. + intro H0. elim (MapCard_Remove_2 m a (sym_eq H0)). intros y H1. rewrite H1 in H. + discriminate H. + Qed. + + Lemma MapCard_Remove_2_conv : + forall (m:Map A) (a:ad) (y:A), + MapGet A m a = SOME A y -> S (MapCard A (MapRemove A m a)) = MapCard A m. + Proof. + intros. + elim + (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m) + (MapCard A (MapRemove A m a)) (refl_equal _) ( + refl_equal _) (refl_equal _)). + intro H0. rewrite (MapCard_Remove_1 m a (sym_eq H0)) in H. discriminate H. + intro H0. rewrite H0. reflexivity. + Qed. + + Lemma MapMerge_Restr_Card : + forall m m':Map A, + MapCard A m + MapCard A m' = + MapCard A (MapMerge A m m') + MapCard A (MapDomRestrTo A A m m'). + Proof. + simple induction m. simpl in |- *. intro. apply plus_n_O. + simpl in |- *. intros a y m'. elim (option_sum A (MapGet A m' a)). intro H. elim H. intros y0 H0. + rewrite H0. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_1_conv m' a y0 y H0). + simpl in |- *. rewrite <- plus_Snm_nSm. apply plus_n_O. + intro H. rewrite H. rewrite MapCard_Put_behind_Put. rewrite (MapCard_Put_2_conv m' a y H). + apply plus_n_O. + intros. + change + (MapCard A m0 + MapCard A m1 + MapCard A m' = + MapCard A (MapMerge A (M2 A m0 m1) m') + + MapCard A (MapDomRestrTo A A (M2 A m0 m1) m')) + in |- *. + elim m'. reflexivity. + intros a y. unfold MapMerge in |- *. unfold MapDomRestrTo in |- *. + elim (option_sum A (MapGet A (M2 A m0 m1) a)). intro H1. elim H1. intros y0 H2. rewrite H2. + rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). reflexivity. + intro H1. rewrite H1. rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). simpl in |- *. + rewrite <- (plus_Snm_nSm (MapCard A m0 + MapCard A m1) 0). reflexivity. + intros. simpl in |- *. + rewrite + (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) ( + MapCard A m2) (MapCard A m3)). + rewrite (H m2). rewrite (H0 m3). + rewrite + (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)) + . + apply plus_permute_2_in_4. + Qed. + + Lemma MapMerge_disjoint_Card : + forall m m':Map A, + MapDisjoint A A m m' -> + MapCard A (MapMerge A m m') = MapCard A m + MapCard A m'. + Proof. + intros. rewrite (MapMerge_Restr_Card m m'). + rewrite (MapCard_ext _ _ (MapDisjoint_imp_2 _ _ _ _ H)). apply plus_n_O. + Qed. + + Lemma MapSplit_Card : + forall (m:Map A) (m':Map B), + MapCard A m = + MapCard A (MapDomRestrTo A B m m') + MapCard A (MapDomRestrBy A B m m'). + Proof. + intros. rewrite (MapCard_ext _ _ (MapDom_Split_1 A B m m')). apply MapMerge_disjoint_Card. + apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. apply MapDom_Split_3. + Qed. + + Lemma MapMerge_Card_ub : + forall m m':Map A, + MapCard A (MapMerge A m m') <= MapCard A m + MapCard A m'. + Proof. + intros. rewrite MapMerge_Restr_Card. apply le_plus_l. + Qed. + + Lemma MapDomRestrTo_Card_ub_l : + forall (m:Map A) (m':Map B), + MapCard A (MapDomRestrTo A B m m') <= MapCard A m. + Proof. + intros. rewrite (MapSplit_Card m m'). apply le_plus_l. + Qed. + + Lemma MapDomRestrBy_Card_ub_l : + forall (m:Map A) (m':Map B), + MapCard A (MapDomRestrBy A B m m') <= MapCard A m. + Proof. + intros. rewrite (MapSplit_Card m m'). apply le_plus_r. + Qed. + + Lemma MapMerge_Card_disjoint : + forall m m':Map A, + MapCard A (MapMerge A m m') = MapCard A m + MapCard A m' -> + MapDisjoint A A m m'. + Proof. + simple induction m. intros. apply Map_M0_disjoint. + simpl in |- *. intros. rewrite (MapCard_Put_behind_Put m' a a0) in H. unfold MapDisjoint, in_dom in |- *. + simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H2. + rewrite (ad_eq_complete _ _ H2) in H. rewrite (MapCard_Put_2 m' a1 a0 H) in H1. + discriminate H1. + intro H2. rewrite H2 in H0. discriminate H0. + simple induction m'. intros. apply Map_disjoint_M0. + intros a y H1. rewrite <- (MapCard_ext _ _ (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1. + unfold MapCard at 3 in H1. rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) 0) in H1. + rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. unfold MapDisjoint, in_dom in |- *. + unfold MapGet at 2 in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). intro H4. + rewrite <- (ad_eq_complete _ _ H4) in H2. rewrite (MapCard_Put_2 _ _ _ H1) in H2. + discriminate H2. + intro H4. rewrite H4 in H3. discriminate H3. + intros. unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H6. + unfold MapDisjoint in H0. apply H0 with (m' := m3) (a := ad_div_2 a). apply le_antisym. + apply MapMerge_Card_ub. + apply (fun p n m:nat => plus_le_reg_l n m p) with + (p := MapCard A m0 + MapCard A m2). + rewrite + (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) ( + MapCard A m1) (MapCard A m3)). + change + (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)) = + MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3)) + in H3. + rewrite <- H3. simpl in |- *. apply plus_le_compat_r. apply MapMerge_Card_ub. + elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m0 m1) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_1 _ a H6 m2 m3) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + intro H6. unfold MapDisjoint in H. apply H with (m' := m2) (a := ad_div_2 a). apply le_antisym. + apply MapMerge_Card_ub. + apply (fun p n m:nat => plus_le_reg_l n m p) with + (p := MapCard A m1 + MapCard A m3). + rewrite + (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A m0 + MapCard A m2)) + . + rewrite + (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) ( + MapCard A m1) (MapCard A m3)). + rewrite + (plus_comm (MapCard A m1 + MapCard A m3) (MapCard A (MapMerge A m0 m2))) + . + change + (MapCard A (MapMerge A m0 m2) + MapCard A (MapMerge A m1 m3) = + MapCard A m0 + MapCard A m1 + (MapCard A m2 + MapCard A m3)) + in H3. + rewrite <- H3. apply plus_le_compat_l. apply MapMerge_Card_ub. + elim (in_dom_some _ _ _ H4). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m0 m1) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + elim (in_dom_some _ _ _ H5). intros y H7. rewrite (MapGet_M2_bit_0_0 _ a H6 m2 m3) in H7. + unfold in_dom in |- *. rewrite H7. reflexivity. + Qed. + + Lemma MapCard_is_Sn : + forall (m:Map A) (n:nat), + MapCard _ m = S n -> {a : ad | in_dom _ a m = true}. + Proof. + simple induction m. intros. discriminate H. + intros a y n H. split with a. unfold in_dom in |- *. rewrite (M1_semantics_1 _ a y). reflexivity. + intros. simpl in H1. elim (O_or_S (MapCard _ m0)). intro H2. elim H2. intros m2 H3. + elim (H _ (sym_eq H3)). intros a H4. split with (ad_double a). unfold in_dom in |- *. + rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1). + rewrite (ad_double_div_2 a). elim (in_dom_some _ _ _ H4). intros y H5. rewrite H5. reflexivity. + intro H2. rewrite <- H2 in H1. simpl in H1. elim (H0 _ H1). intros a H3. + split with (ad_double_plus_un a). unfold in_dom in |- *. + rewrite + (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) + m0 m1). + rewrite (ad_double_plus_un_div_2 a). elim (in_dom_some _ _ _ H3). intros y H4. rewrite H4. + reflexivity. Qed. End MapCard. Section MapCard2. - Variable A, B : Set. - - Lemma MapSubset_card_eq_1 : (n:nat) (m:(Map A)) (m':(Map B)) - (MapSubset ? ? m m') -> (MapCard ? m)=n -> (MapCard ? m')=n -> - (MapSubset ? ? m' m). - Proof. - Induction n. Intros. Unfold MapSubset in_dom. Intro. Rewrite (MapCard_is_O ? m H0 a). - Rewrite (MapCard_is_O ? m' H1 a). Intro H2. Discriminate H2. - Intros. Elim (MapCard_is_Sn A m n0 H1). Intros a H3. Elim (in_dom_some ? ? ? H3). - Intros y H4. Elim (in_dom_some ? ? ? (H0 ? H3)). Intros y' H6. - Cut (eqmap ? (MapPut ? (MapRemove ? m a) a y) m). Intro. - Cut (eqmap ? (MapPut ? (MapRemove ? m' a) a y') m'). Intro. - Apply MapSubset_ext with m0:=(MapPut ? (MapRemove ? m' a) a y') - m2:=(MapPut ? (MapRemove ? m a) a y). - Assumption. - Assumption. - Apply MapSubset_Put_mono. Apply H. Apply MapSubset_Remove_mono. Assumption. - Rewrite <- (MapCard_Remove_2_conv ? m a y H4) in H1. Inversion_clear H1. Reflexivity. - Rewrite <- (MapCard_Remove_2_conv ? m' a y' H6) in H2. Inversion_clear H2. Reflexivity. - Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove B m' a) a y' a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7). - Apply sym_eq. Assumption. - Intro H7. Rewrite H7. Rewrite (MapRemove_semantics ? m' a a0). Rewrite H7. Reflexivity. - Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove A m a) a y a0). - Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7). - Apply sym_eq. Assumption. - Intro H7. Rewrite H7. Rewrite (MapRemove_semantics A m a a0). Rewrite H7. Reflexivity. - Qed. - - Lemma MapDomRestrTo_Card_ub_r : (m:(Map A)) (m':(Map B)) - (le (MapCard A (MapDomRestrTo A B m m')) (MapCard B m')). - Proof. - Induction m. Intro. Simpl. Apply le_O_n. - Intros a y m'. Simpl. Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y0 H0. - Rewrite H0. Elim (MapCard_is_not_O B m' a y0 H0). Intros n H1. Rewrite H1. Simpl. - Apply le_n_S. Apply le_O_n. - Intro H. Rewrite H. Simpl. Apply le_O_n. - Induction m'. Simpl. Apply le_O_n. - - Intros a y. Unfold MapDomRestrTo. Case (MapGet A (M2 A m0 m1) a). Simpl. Apply le_O_n. - Intro. Simpl. Apply le_n. - Intros. Simpl. Rewrite (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)). - Apply le_plus_plus. Apply H. - Apply H0. + Variables A B : Set. + + Lemma MapSubset_card_eq_1 : + forall (n:nat) (m:Map A) (m':Map B), + MapSubset _ _ m m' -> + MapCard _ m = n -> MapCard _ m' = n -> MapSubset _ _ m' m. + Proof. + simple induction n. intros. unfold MapSubset, in_dom in |- *. intro. rewrite (MapCard_is_O _ m H0 a). + rewrite (MapCard_is_O _ m' H1 a). intro H2. discriminate H2. + intros. elim (MapCard_is_Sn A m n0 H1). intros a H3. elim (in_dom_some _ _ _ H3). + intros y H4. elim (in_dom_some _ _ _ (H0 _ H3)). intros y' H6. + cut (eqmap _ (MapPut _ (MapRemove _ m a) a y) m). intro. + cut (eqmap _ (MapPut _ (MapRemove _ m' a) a y') m'). intro. + apply MapSubset_ext with + (m0 := MapPut _ (MapRemove _ m' a) a y') + (m2 := MapPut _ (MapRemove _ m a) a y). + assumption. + assumption. + apply MapSubset_Put_mono. apply H. apply MapSubset_Remove_mono. assumption. + rewrite <- (MapCard_Remove_2_conv _ m a y H4) in H1. inversion_clear H1. reflexivity. + rewrite <- (MapCard_Remove_2_conv _ m' a y' H6) in H2. inversion_clear H2. reflexivity. + unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove B m' a) a y' a0). + elim (sumbool_of_bool (ad_eq a a0)). intro H7. rewrite H7. rewrite <- (ad_eq_complete _ _ H7). + apply sym_eq. assumption. + intro H7. rewrite H7. rewrite (MapRemove_semantics _ m' a a0). rewrite H7. reflexivity. + unfold eqmap, eqm in |- *. intro. rewrite (MapPut_semantics _ (MapRemove A m a) a y a0). + elim (sumbool_of_bool (ad_eq a a0)). intro H7. rewrite H7. rewrite <- (ad_eq_complete _ _ H7). + apply sym_eq. assumption. + intro H7. rewrite H7. rewrite (MapRemove_semantics A m a a0). rewrite H7. reflexivity. + Qed. + + Lemma MapDomRestrTo_Card_ub_r : + forall (m:Map A) (m':Map B), + MapCard A (MapDomRestrTo A B m m') <= MapCard B m'. + Proof. + simple induction m. intro. simpl in |- *. apply le_O_n. + intros a y m'. simpl in |- *. elim (option_sum B (MapGet B m' a)). intro H. elim H. intros y0 H0. + rewrite H0. elim (MapCard_is_not_O B m' a y0 H0). intros n H1. rewrite H1. simpl in |- *. + apply le_n_S. apply le_O_n. + intro H. rewrite H. simpl in |- *. apply le_O_n. + simple induction m'. simpl in |- *. apply le_O_n. + + intros a y. unfold MapDomRestrTo in |- *. case (MapGet A (M2 A m0 m1) a). simpl in |- *. apply le_O_n. + intro. simpl in |- *. apply le_n. + intros. simpl in |- *. rewrite + (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)) + . + apply plus_le_compat. apply H. + apply H0. Qed. End MapCard2. Section MapCard3. - Variable A, B : Set. + Variables A B : Set. - Lemma MapMerge_Card_lb_l : (m,m':(Map A)) - (ge (MapCard A (MapMerge A m m')) (MapCard A m)). + Lemma MapMerge_Card_lb_l : + forall m m':Map A, MapCard A (MapMerge A m m') >= MapCard A m. Proof. - Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m')). - Rewrite (plus_sym (MapCard A m') (MapCard A m)). - Rewrite (plus_sym (MapCard A m') (MapCard A (MapMerge A m m'))). - Rewrite (MapMerge_Restr_Card A m m'). Apply le_reg_l. Apply MapDomRestrTo_Card_ub_r. + unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m')). + rewrite (plus_comm (MapCard A m') (MapCard A m)). + rewrite (plus_comm (MapCard A m') (MapCard A (MapMerge A m m'))). + rewrite (MapMerge_Restr_Card A m m'). apply plus_le_compat_l. apply MapDomRestrTo_Card_ub_r. Qed. - Lemma MapMerge_Card_lb_r : (m,m':(Map A)) - (ge (MapCard A (MapMerge A m m')) (MapCard A m')). + Lemma MapMerge_Card_lb_r : + forall m m':Map A, MapCard A (MapMerge A m m') >= MapCard A m'. Proof. - Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m)). Rewrite (MapMerge_Restr_Card A m m'). - Rewrite (plus_sym (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))). - Apply le_reg_r. Apply MapDomRestrTo_Card_ub_l. + unfold ge in |- *. intros. apply ((fun p n m:nat => plus_le_reg_l n m p) (MapCard A m)). rewrite (MapMerge_Restr_Card A m m'). + rewrite + (plus_comm (MapCard A (MapMerge A m m')) + (MapCard A (MapDomRestrTo A A m m'))). + apply plus_le_compat_r. apply MapDomRestrTo_Card_ub_l. Qed. - Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B)) - (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)). + Lemma MapDomRestrBy_Card_lb : + forall (m:Map A) (m':Map B), + MapCard B m' + MapCard A (MapDomRestrBy A B m m') >= MapCard A m. Proof. - Unfold ge. Intros. Rewrite (MapSplit_Card A B m m'). Apply le_reg_r. - Apply MapDomRestrTo_Card_ub_r. + unfold ge in |- *. intros. rewrite (MapSplit_Card A B m m'). apply plus_le_compat_r. + apply MapDomRestrTo_Card_ub_r. Qed. - Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B)) - (MapSubset A B m m') -> (le (MapCard A m) (MapCard B m')). + Lemma MapSubset_Card_le : + forall (m:Map A) (m':Map B), + MapSubset A B m m' -> MapCard A m <= MapCard B m'. Proof. - Intros. Apply le_trans with m:=(plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))). - Exact (MapDomRestrBy_Card_lb m m'). - Rewrite (MapCard_ext ? ? ? (MapSubset_imp_2 ? ? ? ? H)). Simpl. Rewrite <- plus_n_O. - Apply le_n. + intros. apply le_trans with (m := MapCard B m' + MapCard A (MapDomRestrBy A B m m')). + exact (MapDomRestrBy_Card_lb m m'). + rewrite (MapCard_ext _ _ _ (MapSubset_imp_2 _ _ _ _ H)). simpl in |- *. rewrite <- plus_n_O. + apply le_n. Qed. - Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B)) - (MapSubset ? ? m m') -> (le (MapCard ? m') (MapCard ? m)) -> - (eqmap ? (MapDom ? m) (MapDom ? m')). + Lemma MapSubset_card_eq : + forall (m:Map A) (m':Map B), + MapSubset _ _ m m' -> + MapCard _ m' <= MapCard _ m -> eqmap _ (MapDom _ m) (MapDom _ m'). Proof. - Intros. Apply MapSubset_antisym. Assumption. - Cut (MapCard B m')=(MapCard A m). Intro. Apply (MapSubset_card_eq_1 A B (MapCard A m)). - Assumption. - Reflexivity. - Assumption. - Apply le_antisym. Assumption. - Apply MapSubset_Card_le. Assumption. + intros. apply MapSubset_antisym. assumption. + cut (MapCard B m' = MapCard A m). intro. apply (MapSubset_card_eq_1 A B (MapCard A m)). + assumption. + reflexivity. + assumption. + apply le_antisym. assumption. + apply MapSubset_Card_le. assumption. Qed. -End MapCard3. +End MapCard3.
\ No newline at end of file diff --git a/theories/IntMap/Mapfold.v b/theories/IntMap/Mapfold.v index 1e59e42b2..f14b07261 100644 --- a/theories/IntMap/Mapfold.v +++ b/theories/IntMap/Mapfold.v @@ -7,19 +7,19 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. -Require Mapaxioms. -Require Mapiter. -Require Lsort. -Require Mapsubset. -Require PolyList. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. +Require Import Mapaxioms. +Require Import Mapiter. +Require Import Lsort. +Require Import Mapsubset. +Require Import List. Section MapFoldResults. @@ -29,218 +29,238 @@ Section MapFoldResults. Variable neutral : M. Variable op : M -> M -> M. - Variable nleft : (a:M) (op neutral a)=a. - Variable nright : (a:M) (op a neutral)=a. - Variable assoc : (a,b,c:M) (op (op a b) c)=(op a (op b c)). + Variable nleft : forall a:M, op neutral a = a. + Variable nright : forall a:M, op a neutral = a. + Variable assoc : forall a b c:M, op (op a b) c = op a (op b c). - Lemma MapFold_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> - (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op f m'). + Lemma MapFold_ext : + forall (f:ad -> A -> M) (m m':Map A), + eqmap A m m' -> MapFold _ _ neutral op f m = MapFold _ _ neutral op f m'. Proof. - Intros. Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m). - Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m'). - Cut (alist_of_Map A m)=(alist_of_Map A m'). Intro. Rewrite H0. Reflexivity. - Apply alist_canonical. Unfold eqmap in H. Apply eqm_trans with f':=(MapGet A m). - Apply eqm_sym. Apply alist_of_Map_semantics. - Apply eqm_trans with f':=(MapGet A m'). Assumption. - Apply alist_of_Map_semantics. - Apply alist_of_Map_sorts2. - Apply alist_of_Map_sorts2. + intros. rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m). + rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m'). + cut (alist_of_Map A m = alist_of_Map A m'). intro. rewrite H0. reflexivity. + apply alist_canonical. unfold eqmap in H. apply eqm_trans with (f' := MapGet A m). + apply eqm_sym. apply alist_of_Map_semantics. + apply eqm_trans with (f' := MapGet A m'). assumption. + apply alist_of_Map_semantics. + apply alist_of_Map_sorts2. + apply alist_of_Map_sorts2. Qed. - Lemma MapFold_ext_f_1 : (m:(Map A)) (f,g:ad->A->M) (pf:ad->ad) - ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f (pf a) y)=(g (pf a) y)) -> - (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op g pf m). + Lemma MapFold_ext_f_1 : + forall (m:Map A) (f g:ad -> A -> M) (pf:ad -> ad), + (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f (pf a) y = g (pf a) y) -> + MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op g pf m. Proof. - Induction m. Trivial. - Simpl. Intros. Apply H. Rewrite (ad_eq_correct a). Reflexivity. - Intros. Simpl. Rewrite (H f g [a0:ad](pf (ad_double a0))). - Rewrite (H0 f g [a0:ad](pf (ad_double_plus_un a0))). Reflexivity. - Intros. Apply H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption. - Apply ad_double_plus_un_bit_0. - Intros. Apply H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption. - Apply ad_double_bit_0. + simple induction m. trivial. + simpl in |- *. intros. apply H. rewrite (ad_eq_correct a). reflexivity. + intros. simpl in |- *. rewrite (H f g (fun a0:ad => pf (ad_double a0))). + rewrite (H0 f g (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. + intros. apply H1. rewrite MapGet_M2_bit_0_1. rewrite ad_double_plus_un_div_2. assumption. + apply ad_double_plus_un_bit_0. + intros. apply H1. rewrite MapGet_M2_bit_0_0. rewrite ad_double_div_2. assumption. + apply ad_double_bit_0. Qed. - Lemma MapFold_ext_f : (f,g:ad->A->M) (m:(Map A)) - ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f a y)=(g a y)) -> - (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op g m). + Lemma MapFold_ext_f : + forall (f g:ad -> A -> M) (m:Map A), + (forall (a:ad) (y:A), MapGet _ m a = SOME _ y -> f a y = g a y) -> + MapFold _ _ neutral op f m = MapFold _ _ neutral op g m. Proof. - Intros. Exact (MapFold_ext_f_1 m f g [a0:ad]a0 H). + intros. exact (MapFold_ext_f_1 m f g (fun a0:ad => a0) H). Qed. - Lemma MapFold1_as_Fold_1 : (m:(Map A)) (f,f':ad->A->M) (pf, pf':ad->ad) - ((a:ad) (y:A) (f (pf a) y)=(f' (pf' a) y)) -> - (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f' pf' m). + Lemma MapFold1_as_Fold_1 : + forall (m:Map A) (f f':ad -> A -> M) (pf pf':ad -> ad), + (forall (a:ad) (y:A), f (pf a) y = f' (pf' a) y) -> + MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f' pf' m. Proof. - Induction m. Trivial. - Intros. Simpl. Apply H. - Intros. Simpl. - Rewrite (H f f' [a0:ad](pf (ad_double a0)) [a0:ad](pf' (ad_double a0))). - Rewrite (H0 f f' [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](pf' (ad_double_plus_un a0))). - Reflexivity. - Intros. Apply H1. - Intros. Apply H1. + simple induction m. trivial. + intros. simpl in |- *. apply H. + intros. simpl in |- *. + rewrite + (H f f' (fun a0:ad => pf (ad_double a0)) + (fun a0:ad => pf' (ad_double a0))). + rewrite + (H0 f f' (fun a0:ad => pf (ad_double_plus_un a0)) + (fun a0:ad => pf' (ad_double_plus_un a0))). + reflexivity. + intros. apply H1. + intros. apply H1. Qed. - Lemma MapFold1_as_Fold : (f:ad->A->M) (pf:ad->ad) (m:(Map A)) - (MapFold1 ? ? neutral op f pf m)=(MapFold ? ? neutral op [a:ad][y:A] (f (pf a) y) m). + Lemma MapFold1_as_Fold : + forall (f:ad -> A -> M) (pf:ad -> ad) (m:Map A), + MapFold1 _ _ neutral op f pf m = + MapFold _ _ neutral op (fun (a:ad) (y:A) => f (pf a) y) m. Proof. - Intros. Unfold MapFold. Apply MapFold1_as_Fold_1. Trivial. + intros. unfold MapFold in |- *. apply MapFold1_as_Fold_1. trivial. Qed. - Lemma MapFold1_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> (pf:ad->ad) - (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f pf m'). + Lemma MapFold1_ext : + forall (f:ad -> A -> M) (m m':Map A), + eqmap A m m' -> + forall pf:ad -> ad, + MapFold1 _ _ neutral op f pf m = MapFold1 _ _ neutral op f pf m'. Proof. - Intros. Rewrite MapFold1_as_Fold. Rewrite MapFold1_as_Fold. Apply MapFold_ext. Assumption. + intros. rewrite MapFold1_as_Fold. rewrite MapFold1_as_Fold. apply MapFold_ext. assumption. Qed. - Variable comm : (a,b:M) (op a b)=(op b a). + Variable comm : forall a b:M, op a b = op b a. - Lemma MapFold_Put_disjoint_1 : (p:positive) - (f:ad->A->M) (pf:ad->ad) (a1,a2:ad) (y1,y2:A) - (ad_xor a1 a2)=(ad_x p) -> - (MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p))= - (op (f (pf a1) y1) (f (pf a2) y2)). + Lemma MapFold_Put_disjoint_1 : + forall (p:positive) (f:ad -> A -> M) (pf:ad -> ad) + (a1 a2:ad) (y1 y2:A), + ad_xor a1 a2 = ad_x p -> + MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p) = + op (f (pf a1) y1) (f (pf a2) y2). Proof. - Induction p. Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. - Simpl. Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double. Apply comm. - Change (ad_bit_0 a2)=(negb true). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0). - Rewrite negb_elim. Reflexivity. - Assumption. - Intro H1. Rewrite H1. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. - Reflexivity. - Change (ad_bit_0 a2)=(negb false). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0). - Rewrite negb_elim. Reflexivity. - Assumption. - Simpl. Intros. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. Simpl. - Rewrite nleft. - Rewrite (H f [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2). - Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double_plus_un. Reflexivity. - Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption. - Assumption. - Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intro H1. Rewrite H1. Simpl. Rewrite nright. - Rewrite (H f [a0:ad](pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2). - Rewrite ad_div_2_double. Rewrite ad_div_2_double. Reflexivity. - Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption. - Assumption. - Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity. - Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H0. Rewrite H0. Simpl. - Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. Apply comm. - Assumption. - Change (ad_bit_0 a2)=(negb true). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H). - Rewrite negb_elim. Reflexivity. - Intro H0. Rewrite H0. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. - Reflexivity. - Change (ad_bit_0 a2)=(negb false). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H). - Rewrite negb_elim. Reflexivity. - Assumption. + simple induction p. intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. + simpl in |- *. rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double. apply comm. + change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0). + rewrite negb_elim. reflexivity. + assumption. + intro H1. rewrite H1. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. + reflexivity. + change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H1. rewrite (ad_neg_bit_0_2 _ _ _ H0). + rewrite negb_elim. reflexivity. + assumption. + simpl in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a1)). intro H1. rewrite H1. simpl in |- *. + rewrite nleft. + rewrite + (H f (fun a0:ad => pf (ad_double_plus_un a0)) ( + ad_div_2 a1) (ad_div_2 a2) y1 y2). + rewrite ad_div_2_double_plus_un. rewrite ad_div_2_double_plus_un. reflexivity. + rewrite <- (ad_same_bit_0 _ _ _ H0). assumption. + assumption. + rewrite <- ad_xor_div_2. rewrite H0. reflexivity. + intro H1. rewrite H1. simpl in |- *. rewrite nright. + rewrite + (H f (fun a0:ad => pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2) + . + rewrite ad_div_2_double. rewrite ad_div_2_double. reflexivity. + rewrite <- (ad_same_bit_0 _ _ _ H0). assumption. + assumption. + rewrite <- ad_xor_div_2. rewrite H0. reflexivity. + intros. simpl in |- *. elim (sumbool_of_bool (ad_bit_0 a1)). intro H0. rewrite H0. simpl in |- *. + rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. apply comm. + assumption. + change (ad_bit_0 a2 = negb true) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H). + rewrite negb_elim. reflexivity. + intro H0. rewrite H0. simpl in |- *. rewrite ad_div_2_double. rewrite ad_div_2_double_plus_un. + reflexivity. + change (ad_bit_0 a2 = negb false) in |- *. rewrite <- H0. rewrite (ad_neg_bit_0_1 _ _ H). + rewrite negb_elim. reflexivity. + assumption. Qed. - Lemma MapFold_Put_disjoint_2 : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad) - (MapGet A m a)=(NONE A) -> - (MapFold1 A M neutral op f pf (MapPut A m a y))= - (op (f (pf a) y) (MapFold1 A M neutral op f pf m)). + Lemma MapFold_Put_disjoint_2 : + forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), + MapGet A m a = NONE A -> + MapFold1 A M neutral op f pf (MapPut A m a y) = + op (f (pf a) y) (MapFold1 A M neutral op f pf m). Proof. - Induction m. Intros. Simpl. Rewrite (nright (f (pf a) y)). Reflexivity. - Intros a1 y1 a2 y2 pf H. Simpl. Elim (ad_sum (ad_xor a1 a2)). Intro H0. Elim H0. - Intros p H1. Rewrite H1. Rewrite comm. Exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1). - Intro H0. Rewrite (ad_eq_complete ? ? (ad_xor_eq_true ? ? H0)) in H. - Rewrite (M1_semantics_1 A a2 y1) in H. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. - Cut (MapPut A (M2 A m0 m1) a y)=(M2 A m0 (MapPut A m1 (ad_div_2 a) y)). Intro. - Rewrite H3. Simpl. Rewrite (H0 (ad_div_2 a) y [a0:ad](pf (ad_double_plus_un a0))). - Rewrite ad_div_2_double_plus_un. Rewrite <- assoc. - Rewrite (comm (MapFold1 A M neutral op f [a0:ad](pf (ad_double a0)) m0) (f (pf a) y)). - Rewrite assoc. Reflexivity. - Assumption. - Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Assumption. - Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5. - Reflexivity. - Intros p0 H4 H5. Rewrite H5 in H2. Discriminate H2. - Intro H4. Rewrite H4. Reflexivity. - Intro H3. Rewrite H3 in H2. Discriminate H2. - Intro H2. Cut (MapPut A (M2 A m0 m1) a y)=(M2 A (MapPut A m0 (ad_div_2 a) y) m1). - Intro. Rewrite H3. Simpl. Rewrite (H (ad_div_2 a) y [a0:ad](pf (ad_double a0))). - Rewrite ad_div_2_double. Rewrite <- assoc. Reflexivity. - Assumption. - Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Assumption. - Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5 in H2. - Discriminate H2. - Intros p0 H4 H5. Rewrite H5. Reflexivity. - Intro H4. Rewrite H4 in H2. Discriminate H2. - Intro H3. Rewrite H3. Reflexivity. + simple induction m. intros. simpl in |- *. rewrite (nright (f (pf a) y)). reflexivity. + intros a1 y1 a2 y2 pf H. simpl in |- *. elim (ad_sum (ad_xor a1 a2)). intro H0. elim H0. + intros p H1. rewrite H1. rewrite comm. exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1). + intro H0. rewrite (ad_eq_complete _ _ (ad_xor_eq_true _ _ H0)) in H. + rewrite (M1_semantics_1 A a2 y1) in H. discriminate H. + intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H2. + cut (MapPut A (M2 A m0 m1) a y = M2 A m0 (MapPut A m1 (ad_div_2 a) y)). intro. + rewrite H3. simpl in |- *. rewrite (H0 (ad_div_2 a) y (fun a0:ad => pf (ad_double_plus_un a0))). + rewrite ad_div_2_double_plus_un. rewrite <- assoc. + rewrite + (comm (MapFold1 A M neutral op f (fun a0:ad => pf (ad_double a0)) m0) + (f (pf a) y)). + rewrite assoc. reflexivity. + assumption. + rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. assumption. + simpl in |- *. elim (ad_sum a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5. + reflexivity. + intros p0 H4 H5. rewrite H5 in H2. discriminate H2. + intro H4. rewrite H4. reflexivity. + intro H3. rewrite H3 in H2. discriminate H2. + intro H2. cut (MapPut A (M2 A m0 m1) a y = M2 A (MapPut A m0 (ad_div_2 a) y) m1). + intro. rewrite H3. simpl in |- *. rewrite (H (ad_div_2 a) y (fun a0:ad => pf (ad_double a0))). + rewrite ad_div_2_double. rewrite <- assoc. reflexivity. + assumption. + rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. assumption. + simpl in |- *. elim (ad_sum a). intro H3. elim H3. intro p. elim p. intros p0 H4 H5. rewrite H5 in H2. + discriminate H2. + intros p0 H4 H5. rewrite H5. reflexivity. + intro H4. rewrite H4 in H2. discriminate H2. + intro H3. rewrite H3. reflexivity. Qed. - Lemma MapFold_Put_disjoint : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(NONE A) -> - (MapFold A M neutral op f (MapPut A m a y))= - (op (f a y) (MapFold A M neutral op f m)). + Lemma MapFold_Put_disjoint : + forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A), + MapGet A m a = NONE A -> + MapFold A M neutral op f (MapPut A m a y) = + op (f a y) (MapFold A M neutral op f m). Proof. - Intros. Exact (MapFold_Put_disjoint_2 f m a y [a0:ad]a0 H). + intros. exact (MapFold_Put_disjoint_2 f m a y (fun a0:ad => a0) H). Qed. - Lemma MapFold_Put_behind_disjoint_2 : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad) - (MapGet A m a)=(NONE A) -> - (MapFold1 A M neutral op f pf (MapPut_behind A m a y))= - (op (f (pf a) y) (MapFold1 A M neutral op f pf m)). + Lemma MapFold_Put_behind_disjoint_2 : + forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A) (pf:ad -> ad), + MapGet A m a = NONE A -> + MapFold1 A M neutral op f pf (MapPut_behind A m a y) = + op (f (pf a) y) (MapFold1 A M neutral op f pf m). Proof. - Intros. Cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). Intro. - Rewrite (MapFold1_ext f ? ? H0 pf). Apply MapFold_Put_disjoint_2. Assumption. - Apply eqmap_trans with m':=(MapMerge A (M1 A a y) m). Apply MapPut_behind_as_Merge. - Apply eqmap_trans with m':=(MapMerge A m (M1 A a y)). - Apply eqmap_trans with m':=(MapDelta A (M1 A a y) m). Apply eqmap_sym. Apply MapDelta_disjoint. - Unfold MapDisjoint. Unfold in_dom. Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a0)). - Intro H2. Rewrite (ad_eq_complete ? ? H2) in H. Rewrite H in H1. Discriminate H1. - Intro H2. Rewrite H2 in H0. Discriminate H0. - Apply eqmap_trans with m':=(MapDelta A m (M1 A a y)). Apply MapDelta_sym. - Apply MapDelta_disjoint. Unfold MapDisjoint. Unfold in_dom. Simpl. Intros. - Elim (sumbool_of_bool (ad_eq a a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H. - Rewrite H in H0. Discriminate H0. - Intro H2. Rewrite H2 in H1. Discriminate H1. - Apply eqmap_sym. Apply MapPut_as_Merge. + intros. cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). intro. + rewrite (MapFold1_ext f _ _ H0 pf). apply MapFold_Put_disjoint_2. assumption. + apply eqmap_trans with (m' := MapMerge A (M1 A a y) m). apply MapPut_behind_as_Merge. + apply eqmap_trans with (m' := MapMerge A m (M1 A a y)). + apply eqmap_trans with (m' := MapDelta A (M1 A a y) m). apply eqmap_sym. apply MapDelta_disjoint. + unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a0)). + intro H2. rewrite (ad_eq_complete _ _ H2) in H. rewrite H in H1. discriminate H1. + intro H2. rewrite H2 in H0. discriminate H0. + apply eqmap_trans with (m' := MapDelta A m (M1 A a y)). apply MapDelta_sym. + apply MapDelta_disjoint. unfold MapDisjoint in |- *. unfold in_dom in |- *. simpl in |- *. intros. + elim (sumbool_of_bool (ad_eq a a0)). intro H2. rewrite (ad_eq_complete _ _ H2) in H. + rewrite H in H0. discriminate H0. + intro H2. rewrite H2 in H1. discriminate H1. + apply eqmap_sym. apply MapPut_as_Merge. Qed. - Lemma MapFold_Put_behind_disjoint : - (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(NONE A) -> - (MapFold A M neutral op f (MapPut_behind A m a y)) - =(op (f a y) (MapFold A M neutral op f m)). + Lemma MapFold_Put_behind_disjoint : + forall (f:ad -> A -> M) (m:Map A) (a:ad) (y:A), + MapGet A m a = NONE A -> + MapFold A M neutral op f (MapPut_behind A m a y) = + op (f a y) (MapFold A M neutral op f m). Proof. - Intros. Exact (MapFold_Put_behind_disjoint_2 f m a y [a0:ad]a0 H). + intros. exact (MapFold_Put_behind_disjoint_2 f m a y (fun a0:ad => a0) H). Qed. Lemma MapFold_Merge_disjoint_1 : - (f:ad->A->M) (m1,m2:(Map A)) (pf:ad->ad) - (MapDisjoint A A m1 m2) -> - (MapFold1 A M neutral op f pf (MapMerge A m1 m2))= - (op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2)). + forall (f:ad -> A -> M) (m1 m2:Map A) (pf:ad -> ad), + MapDisjoint A A m1 m2 -> + MapFold1 A M neutral op f pf (MapMerge A m1 m2) = + op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2). Proof. - Induction m1. Simpl. Intros. Rewrite nleft. Reflexivity. - Intros. Unfold MapMerge. Apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf). - Apply in_dom_none. Exact (MapDisjoint_M1_l ? ? m2 a a0 H). - Induction m2. Intros. Simpl. Rewrite nright. Reflexivity. - Intros. Unfold MapMerge. Rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). Apply comm. - Apply in_dom_none. Exact (MapDisjoint_M1_r ? ? (M2 A m m0) a a0 H1). - Intros. Simpl. Rewrite (H m3 [a0:ad](pf (ad_double a0))). - Rewrite (H0 m4 [a0:ad](pf (ad_double_plus_un a0))). - Cut (a,b,c,d:M)(op (op a b) (op c d))=(op (op a c) (op b d)). Intro. Apply H4. - Intros. Rewrite assoc. Rewrite <- (assoc b c d). Rewrite (comm b c). Rewrite (assoc c b d). - Rewrite assoc. Reflexivity. - Exact (MapDisjoint_M2_r ? ? ? ? ? ? H3). - Exact (MapDisjoint_M2_l ? ? ? ? ? ? H3). + simple induction m1. simpl in |- *. intros. rewrite nleft. reflexivity. + intros. unfold MapMerge in |- *. apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf). + apply in_dom_none. exact (MapDisjoint_M1_l _ _ m2 a a0 H). + simple induction m2. intros. simpl in |- *. rewrite nright. reflexivity. + intros. unfold MapMerge in |- *. rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). apply comm. + apply in_dom_none. exact (MapDisjoint_M1_r _ _ (M2 A m m0) a a0 H1). + intros. simpl in |- *. rewrite (H m3 (fun a0:ad => pf (ad_double a0))). + rewrite (H0 m4 (fun a0:ad => pf (ad_double_plus_un a0))). + cut (forall a b c d:M, op (op a b) (op c d) = op (op a c) (op b d)). intro. apply H4. + intros. rewrite assoc. rewrite <- (assoc b c d). rewrite (comm b c). rewrite (assoc c b d). + rewrite assoc. reflexivity. + exact (MapDisjoint_M2_r _ _ _ _ _ _ H3). + exact (MapDisjoint_M2_l _ _ _ _ _ _ H3). Qed. Lemma MapFold_Merge_disjoint : - (f:ad->A->M) (m1,m2:(Map A)) - (MapDisjoint A A m1 m2) -> - (MapFold A M neutral op f (MapMerge A m1 m2))= - (op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2)). + forall (f:ad -> A -> M) (m1 m2:Map A), + MapDisjoint A A m1 m2 -> + MapFold A M neutral op f (MapMerge A m1 m2) = + op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2). Proof. - Intros. Exact (MapFold_Merge_disjoint_1 f m1 m2 [a0:ad]a0 H). + intros. exact (MapFold_Merge_disjoint_1 f m1 m2 (fun a0:ad => a0) H). Qed. End MapFoldResults. @@ -261,23 +281,27 @@ Section MapFoldDistr. Variable times : M -> N -> M'. - Variable absorb : (c:N)(times neutral c)=neutral'. - Variable distr : (a,b:M) (c:N) (times (op a b) c) = (op' (times a c) (times b c)). + Variable absorb : forall c:N, times neutral c = neutral'. + Variable + distr : + forall (a b:M) (c:N), times (op a b) c = op' (times a c) (times b c). - Lemma MapFold_distr_r_1 : (f:ad->A->M) (m:(Map A)) (c:N) (pf:ad->ad) - (times (MapFold1 A M neutral op f pf m) c)= - (MapFold1 A M' neutral' op' [a:ad][y:A] (times (f a y) c) pf m). + Lemma MapFold_distr_r_1 : + forall (f:ad -> A -> M) (m:Map A) (c:N) (pf:ad -> ad), + times (MapFold1 A M neutral op f pf m) c = + MapFold1 A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) pf m. Proof. - Induction m. Intros. Exact (absorb c). - Trivial. - Intros. Simpl. Rewrite distr. Rewrite H. Rewrite H0. Reflexivity. + simple induction m. intros. exact (absorb c). + trivial. + intros. simpl in |- *. rewrite distr. rewrite H. rewrite H0. reflexivity. Qed. - Lemma MapFold_distr_r : (f:ad->A->M) (m:(Map A)) (c:N) - (times (MapFold A M neutral op f m) c)= - (MapFold A M' neutral' op' [a:ad][y:A] (times (f a y) c) m). + Lemma MapFold_distr_r : + forall (f:ad -> A -> M) (m:Map A) (c:N), + times (MapFold A M neutral op f m) c = + MapFold A M' neutral' op' (fun (a:ad) (y:A) => times (f a y) c) m. Proof. - Intros. Exact (MapFold_distr_r_1 f m c [a:ad]a). + intros. exact (MapFold_distr_r_1 f m c (fun a:ad => a)). Qed. End MapFoldDistr. @@ -298,14 +322,18 @@ Section MapFoldDistrL. Variable times : N -> M -> M'. - Variable absorb : (c:N)(times c neutral)=neutral'. - Variable distr : (a,b:M) (c:N) (times c (op a b)) = (op' (times c a) (times c b)). + Variable absorb : forall c:N, times c neutral = neutral'. + Variable + distr : + forall (a b:M) (c:N), times c (op a b) = op' (times c a) (times c b). - Lemma MapFold_distr_l : (f:ad->A->M) (m:(Map A)) (c:N) - (times c (MapFold A M neutral op f m))= - (MapFold A M' neutral' op' [a:ad][y:A] (times c (f a y)) m). + Lemma MapFold_distr_l : + forall (f:ad -> A -> M) (m:Map A) (c:N), + times c (MapFold A M neutral op f m) = + MapFold A M' neutral' op' (fun (a:ad) (y:A) => times c (f a y)) m. Proof. - Intros. Apply MapFold_distr_r with times:=[a:M][b:N](times b a); Assumption. + intros. apply MapFold_distr_r with (times := fun (a:M) (b:N) => times b a); + assumption. Qed. End MapFoldDistrL. @@ -314,27 +342,30 @@ Section MapFoldExists. Variable A : Set. - Lemma MapFold_orb_1 : (f:ad->A->bool) (m:(Map A)) (pf:ad->ad) - (MapFold1 A bool false orb f pf m)= - (Cases (MapSweep1 A f pf m) of - (SOME _) => true - | _ => false - end). + Lemma MapFold_orb_1 : + forall (f:ad -> A -> bool) (m:Map A) (pf:ad -> ad), + MapFold1 A bool false orb f pf m = + match MapSweep1 A f pf m with + | SOME _ => true + | _ => false + end. Proof. - Induction m. Trivial. - Intros a y pf. Simpl. Unfold MapSweep2. (Case (f (pf a) y); Reflexivity). - Intros. Simpl. Rewrite (H [a0:ad](pf (ad_double a0))). - Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). - Case (MapSweep1 A f [a0:ad](pf (ad_double a0)) m0); Reflexivity. + simple induction m. trivial. + intros a y pf. simpl in |- *. unfold MapSweep2 in |- *. case (f (pf a) y); reflexivity. + intros. simpl in |- *. rewrite (H (fun a0:ad => pf (ad_double a0))). + rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). + case (MapSweep1 A f (fun a0:ad => pf (ad_double a0)) m0); reflexivity. Qed. - Lemma MapFold_orb : (f:ad->A->bool) (m:(Map A)) (MapFold A bool false orb f m)= - (Cases (MapSweep A f m) of - (SOME _) => true - | _ => false - end). + Lemma MapFold_orb : + forall (f:ad -> A -> bool) (m:Map A), + MapFold A bool false orb f m = + match MapSweep A f m with + | SOME _ => true + | _ => false + end. Proof. - Intros. Exact (MapFold_orb_1 f m [a:ad]a). + intros. exact (MapFold_orb_1 f m (fun a:ad => a)). Qed. End MapFoldExists. @@ -343,39 +374,51 @@ Section DMergeDef. Variable A : Set. - Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m). + Definition DMerge := + MapFold (Map A) (Map A) (M0 A) (MapMerge A) (fun (_:ad) (m:Map A) => m). - Lemma in_dom_DMerge_1 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))= - (Cases (MapSweep ? [_:ad][m0:(Map A)] (in_dom A a m0) m) of - (SOME _) => true - | _ => false - end). + Lemma in_dom_DMerge_1 : + forall (m:Map (Map A)) (a:ad), + in_dom A a (DMerge m) = + match MapSweep _ (fun (_:ad) (m0:Map A) => in_dom A a m0) m with + | SOME _ => true + | _ => false + end. Proof. - Unfold DMerge. Intros. - Rewrite (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false - orb ad (in_dom A) [c:ad](refl_equal ? ?) (in_dom_merge A)). - Apply MapFold_orb. + unfold DMerge in |- *. intros. + rewrite + (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false orb ad + (in_dom A) (fun c:ad => refl_equal _) (in_dom_merge A)) + . + apply MapFold_orb. Qed. - Lemma in_dom_DMerge_2 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=true -> - {b:ad & {m0:(Map A) | (MapGet ? m b)=(SOME ? m0) /\ - (in_dom A a m0)=true}}. + Lemma in_dom_DMerge_2 : + forall (m:Map (Map A)) (a:ad), + in_dom A a (DMerge m) = true -> + {b : ad & + {m0 : Map A | MapGet _ m b = SOME _ m0 /\ in_dom A a m0 = true}}. Proof. - Intros m a. Rewrite in_dom_DMerge_1. - Elim (option_sum ? (MapSweep (Map A) [_:ad][m0:(Map A)](in_dom A a m0) m)). - Intro H. Elim H. Intro r. Elim r. Intros b m0 H0. Intro. Split with b. Split with m0. - Split. Exact (MapSweep_semantics_2 ? ? ? ? ? H0). - Exact (MapSweep_semantics_1 ? ? ? ? ? H0). - Intro H. Rewrite H. Intro. Discriminate H0. + intros m a. rewrite in_dom_DMerge_1. + elim + (option_sum _ + (MapSweep (Map A) (fun (_:ad) (m0:Map A) => in_dom A a m0) m)). + intro H. elim H. intro r. elim r. intros b m0 H0. intro. split with b. split with m0. + split. exact (MapSweep_semantics_2 _ _ _ _ _ H0). + exact (MapSweep_semantics_1 _ _ _ _ _ H0). + intro H. rewrite H. intro. discriminate H0. Qed. - Lemma in_dom_DMerge_3 : (m:(Map (Map A))) (a,b:ad) (m0:(Map A)) - (MapGet ? m a)=(SOME ? m0) -> (in_dom A b m0)=true -> - (in_dom A b (DMerge m))=true. + Lemma in_dom_DMerge_3 : + forall (m:Map (Map A)) (a b:ad) (m0:Map A), + MapGet _ m a = SOME _ m0 -> + in_dom A b m0 = true -> in_dom A b (DMerge m) = true. Proof. - Intros m a b m0 H H0. Rewrite in_dom_DMerge_1. - Elim (MapSweep_semantics_4 ? [_:ad][m'0:(Map A)](in_dom A b m'0) ? ? ? H H0). - Intros a' H1. Elim H1. Intros m'0 H2. Rewrite H2. Reflexivity. + intros m a b m0 H H0. rewrite in_dom_DMerge_1. + elim + (MapSweep_semantics_4 _ (fun (_:ad) (m'0:Map A) => in_dom A b m'0) _ _ _ + H H0). + intros a' H1. elim H1. intros m'0 H2. rewrite H2. reflexivity. Qed. -End DMergeDef. +End DMergeDef.
\ No newline at end of file diff --git a/theories/IntMap/Mapiter.v b/theories/IntMap/Mapiter.v index 216a07c63..3c0aad802 100644 --- a/theories/IntMap/Mapiter.v +++ b/theories/IntMap/Mapiter.v @@ -7,16 +7,16 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Mapaxioms. -Require Fset. -Require PolyList. +Require Import Bool. +Require Import Sumbool. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Mapaxioms. +Require Import Fset. +Require Import List. Section MapIter. @@ -24,172 +24,200 @@ Section MapIter. Section MapSweepDef. - Variable f:ad->A->bool. - - Definition MapSweep2 := [a0:ad; y:A] if (f a0 y) then (SOME ? (a0, y)) else (NONE ?). - - Fixpoint MapSweep1 [pf:ad->ad; m:(Map A)] : (option (ad * A)) := - Cases m of - M0 => (NONE ?) - | (M1 a y) => (MapSweep2 (pf a) y) - | (M2 m m') => Cases (MapSweep1 ([a:ad] (pf (ad_double a))) m) of - (SOME r) => (SOME ? r) - | NONE => (MapSweep1 ([a:ad] (pf (ad_double_plus_un a))) m') - end + Variable f : ad -> A -> bool. + + Definition MapSweep2 (a0:ad) (y:A) := + if f a0 y then SOME _ (a0, y) else NONE _. + + Fixpoint MapSweep1 (pf:ad -> ad) (m:Map A) {struct m} : + option (ad * A) := + match m with + | M0 => NONE _ + | M1 a y => MapSweep2 (pf a) y + | M2 m m' => + match MapSweep1 (fun a:ad => pf (ad_double a)) m with + | SOME r => SOME _ r + | NONE => MapSweep1 (fun a:ad => pf (ad_double_plus_un a)) m' + end end. - Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:ad] a) m). + Definition MapSweep (m:Map A) := MapSweep1 (fun a:ad => a) m. - Lemma MapSweep_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (MapSweep1 pf m)=(SOME ? (a, y)) -> (f a y)=true. + Lemma MapSweep_semantics_1_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + MapSweep1 pf m = SOME _ (a, y) -> f a y = true. Proof. - Induction m. Intros. Discriminate H. - Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (f (pf a) y)). Intro H. Unfold MapSweep2. - Rewrite H. Intro H0. Inversion H0. Rewrite <- H3. Assumption. - Intro H. Unfold MapSweep2. Rewrite H. Intro H0. Discriminate H0. - Simpl. Intros. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). - Intro H2. Elim H2. Intros r H3. Rewrite H3 in H1. Inversion H1. Rewrite H5 in H3. - Exact (H [a0:ad](pf (ad_double a0)) a y H3). - Intro H2. Rewrite H2 in H1. Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1). + simple induction m. intros. discriminate H. + simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (f (pf a) y)). intro H. unfold MapSweep2 in |- *. + rewrite H. intro H0. inversion H0. rewrite <- H3. assumption. + intro H. unfold MapSweep2 in |- *. rewrite H. intro H0. discriminate H0. + simpl in |- *. intros. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). + intro H2. elim H2. intros r H3. rewrite H3 in H1. inversion H1. rewrite H5 in H3. + exact (H (fun a0:ad => pf (ad_double a0)) a y H3). + intro H2. rewrite H2 in H1. exact (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H1). Qed. - Lemma MapSweep_semantics_1 : (m:(Map A)) (a:ad) (y:A) - (MapSweep m)=(SOME ? (a, y)) -> (f a y)=true. + Lemma MapSweep_semantics_1 : + forall (m:Map A) (a:ad) (y:A), MapSweep m = SOME _ (a, y) -> f a y = true. Proof. - Intros. Exact (MapSweep_semantics_1_1 m [a:ad]a a y H). + intros. exact (MapSweep_semantics_1_1 m (fun a:ad => a) a y H). Qed. - Lemma MapSweep_semantics_2_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (MapSweep1 pf m)=(SOME ? (a, y)) -> {a':ad | a=(pf a')}. + Lemma MapSweep_semantics_2_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + MapSweep1 pf m = SOME _ (a, y) -> {a' : ad | a = pf a'}. Proof. - Induction m. Intros. Discriminate H. - Simpl. Unfold MapSweep2. Intros a y pf a0 y0. Case (f (pf a) y). Intros. Split with a. - Inversion H. Reflexivity. - Intro. Discriminate H. - Intros m0 H m1 H0 pf a y. Simpl. - Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H1. Elim H1. - Intros r H2. Rewrite H2. Intro H3. Inversion H3. Rewrite H5 in H2. - Elim (H [a0:ad](pf (ad_double a0)) a y H2). Intros a0 H6. Split with (ad_double a0). - Assumption. - Intro H1. Rewrite H1. Intro H2. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H2). - Intros a0 H3. Split with (ad_double_plus_un a0). Assumption. + simple induction m. intros. discriminate H. + simpl in |- *. unfold MapSweep2 in |- *. intros a y pf a0 y0. case (f (pf a) y). intros. split with a. + inversion H. reflexivity. + intro. discriminate H. + intros m0 H m1 H0 pf a y. simpl in |- *. + elim + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H1. elim H1. + intros r H2. rewrite H2. intro H3. inversion H3. rewrite H5 in H2. + elim (H (fun a0:ad => pf (ad_double a0)) a y H2). intros a0 H6. split with (ad_double a0). + assumption. + intro H1. rewrite H1. intro H2. elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H2). + intros a0 H3. split with (ad_double_plus_un a0). assumption. Qed. - Lemma MapSweep_semantics_2_2 : (m:(Map A)) - (pf,fp:ad->ad) ((a0:ad) (fp (pf a0))=a0) -> (a:ad) (y:A) - (MapSweep1 pf m)=(SOME ? (a, y)) -> (MapGet A m (fp a))=(SOME ? y). + Lemma MapSweep_semantics_2_2 : + forall (m:Map A) (pf fp:ad -> ad), + (forall a0:ad, fp (pf a0) = a0) -> + forall (a:ad) (y:A), + MapSweep1 pf m = SOME _ (a, y) -> MapGet A m (fp a) = SOME _ y. Proof. - Induction m. Intros. Discriminate H0. - Simpl. Intros a y pf fp H a0 y0. Unfold MapSweep2. Elim (sumbool_of_bool (f (pf a) y)). - Intro H0. Rewrite H0. Intro H1. Inversion H1. Rewrite (H a). Rewrite (ad_eq_correct a). - Reflexivity. - Intro H0. Rewrite H0. Intro H1. Discriminate H1. - Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). Elim (sumbool_of_bool (ad_bit_0 (fp a))). - Intro H3. Rewrite H3. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). - Intro H4. Simpl in H2. Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). - Intro. Rewrite H1. Apply ad_double_plus_un_div_2. - Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H5. Elim H5. - Intros r H6. Rewrite H6 in H2. Inversion H2. Rewrite H8 in H6. - Elim (MapSweep_semantics_2_1 m0 [a0:ad](pf (ad_double a0)) a y H6). Intros a0 H9. - Rewrite H9 in H3. Rewrite (H1 (ad_double a0)) in H3. Rewrite (ad_double_bit_0 a0) in H3. - Discriminate H3. - Intro H5. Rewrite H5 in H2. Assumption. - Intro H4. Simpl in H2. Rewrite H4 in H2. - Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). Intro. - Rewrite H1. Apply ad_double_plus_un_div_2. - Assumption. - Intro H3. Rewrite H3. Simpl in H2. - Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H4. Elim H4. - Intros r H5. Rewrite H5 in H2. Inversion H2. Rewrite H7 in H5. - Apply (H [a0:ad](pf (ad_double a0)) [a0:ad](ad_div_2 (fp a0))). Intro. Rewrite H1. - Apply ad_double_div_2. - Assumption. - Intro H4. Rewrite H4 in H2. - Elim (MapSweep_semantics_2_1 m1 [a0:ad](pf (ad_double_plus_un a0)) a y H2). - Intros a0 H5. Rewrite H5 in H3. Rewrite (H1 (ad_double_plus_un a0)) in H3. - Rewrite (ad_double_plus_un_bit_0 a0) in H3. Discriminate H3. + simple induction m. intros. discriminate H0. + simpl in |- *. intros a y pf fp H a0 y0. unfold MapSweep2 in |- *. elim (sumbool_of_bool (f (pf a) y)). + intro H0. rewrite H0. intro H1. inversion H1. rewrite (H a). rewrite (ad_eq_correct a). + reflexivity. + intro H0. rewrite H0. intro H1. discriminate H1. + intros. rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). elim (sumbool_of_bool (ad_bit_0 (fp a))). + intro H3. rewrite H3. elim (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). + intro H4. simpl in H2. apply + (H0 (fun a0:ad => pf (ad_double_plus_un a0)) + (fun a0:ad => ad_div_2 (fp a0))). + intro. rewrite H1. apply ad_double_plus_un_div_2. + elim + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H5. elim H5. + intros r H6. rewrite H6 in H2. inversion H2. rewrite H8 in H6. + elim (MapSweep_semantics_2_1 m0 (fun a0:ad => pf (ad_double a0)) a y H6). intros a0 H9. + rewrite H9 in H3. rewrite (H1 (ad_double a0)) in H3. rewrite (ad_double_bit_0 a0) in H3. + discriminate H3. + intro H5. rewrite H5 in H2. assumption. + intro H4. simpl in H2. rewrite H4 in H2. + apply + (H0 (fun a0:ad => pf (ad_double_plus_un a0)) + (fun a0:ad => ad_div_2 (fp a0))). intro. + rewrite H1. apply ad_double_plus_un_div_2. + assumption. + intro H3. rewrite H3. simpl in H2. + elim + (option_sum (ad * A) (MapSweep1 (fun a0:ad => pf (ad_double a0)) m0)). intro H4. elim H4. + intros r H5. rewrite H5 in H2. inversion H2. rewrite H7 in H5. + apply + (H (fun a0:ad => pf (ad_double a0)) (fun a0:ad => ad_div_2 (fp a0))). intro. rewrite H1. + apply ad_double_div_2. + assumption. + intro H4. rewrite H4 in H2. + elim + (MapSweep_semantics_2_1 m1 (fun a0:ad => pf (ad_double_plus_un a0)) a y + H2). + intros a0 H5. rewrite H5 in H3. rewrite (H1 (ad_double_plus_un a0)) in H3. + rewrite (ad_double_plus_un_bit_0 a0) in H3. discriminate H3. Qed. - Lemma MapSweep_semantics_2 : (m:(Map A)) (a:ad) (y:A) - (MapSweep m)=(SOME ? (a, y)) -> (MapGet A m a)=(SOME ? y). + Lemma MapSweep_semantics_2 : + forall (m:Map A) (a:ad) (y:A), + MapSweep m = SOME _ (a, y) -> MapGet A m a = SOME _ y. Proof. - Intros. - Exact (MapSweep_semantics_2_2 m [a0:ad]a0 [a0:ad]a0 [a0:ad](refl_equal ad a0) a y H). + intros. + exact + (MapSweep_semantics_2_2 m (fun a0:ad => a0) (fun a0:ad => a0) + (fun a0:ad => refl_equal a0) a y H). Qed. - Lemma MapSweep_semantics_3_1 : (m:(Map A)) (pf:ad->ad) - (MapSweep1 pf m)=(NONE ?) -> - (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> (f (pf a) y)=false. + Lemma MapSweep_semantics_3_1 : + forall (m:Map A) (pf:ad -> ad), + MapSweep1 pf m = NONE _ -> + forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f (pf a) y = false. Proof. - Induction m. Intros. Discriminate H0. - Simpl. Unfold MapSweep2. Intros a y pf. Elim (sumbool_of_bool (f (pf a) y)). Intro H. - Rewrite H. Intro. Discriminate H0. - Intro H. Rewrite H. Intros H0 a0 y0. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. Rewrite H1. - Intro H2. Inversion H2. Rewrite <- H4. Rewrite <- (ad_eq_complete ? ? H1). Assumption. - Intro H1. Rewrite H1. Intro. Discriminate H2. - Intros. Simpl in H1. Elim (option_sum ad*A (MapSweep1 [a:ad](pf (ad_double a)) m0)). - Intro H3. Elim H3. Intros r H4. Rewrite H4 in H1. Discriminate H1. - Intro H3. Rewrite H3 in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4. - Rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double_plus_un a H4). - Exact (H0 [a:ad](pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2). - Intro H4. Rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double a H4). - Exact (H [a:ad](pf (ad_double a)) H3 (ad_div_2 a) y H2). + simple induction m. intros. discriminate H0. + simpl in |- *. unfold MapSweep2 in |- *. intros a y pf. elim (sumbool_of_bool (f (pf a) y)). intro H. + rewrite H. intro. discriminate H0. + intro H. rewrite H. intros H0 a0 y0. elim (sumbool_of_bool (ad_eq a a0)). intro H1. rewrite H1. + intro H2. inversion H2. rewrite <- H4. rewrite <- (ad_eq_complete _ _ H1). assumption. + intro H1. rewrite H1. intro. discriminate H2. + intros. simpl in H1. elim (option_sum (ad * A) (MapSweep1 (fun a:ad => pf (ad_double a)) m0)). + intro H3. elim H3. intros r H4. rewrite H4 in H1. discriminate H1. + intro H3. rewrite H3 in H1. elim (sumbool_of_bool (ad_bit_0 a)). intro H4. + rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. rewrite <- (ad_div_2_double_plus_un a H4). + exact (H0 (fun a:ad => pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2). + intro H4. rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. rewrite <- (ad_div_2_double a H4). + exact (H (fun a:ad => pf (ad_double a)) H3 (ad_div_2 a) y H2). Qed. - Lemma MapSweep_semantics_3 : (m:(Map A)) - (MapSweep m)=(NONE ?) -> (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> - (f a y)=false. + Lemma MapSweep_semantics_3 : + forall m:Map A, + MapSweep m = NONE _ -> + forall (a:ad) (y:A), MapGet A m a = SOME _ y -> f a y = false. Proof. - Intros. - Exact (MapSweep_semantics_3_1 m [a0:ad]a0 H a y H0). + intros. + exact (MapSweep_semantics_3_1 m (fun a0:ad => a0) H a y H0). Qed. - Lemma MapSweep_semantics_4_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (MapGet A m a)=(SOME A y) -> (f (pf a) y)=true -> - {a':ad & {y':A | (MapSweep1 pf m)=(SOME ? (a', y'))}}. + Lemma MapSweep_semantics_4_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + MapGet A m a = SOME A y -> + f (pf a) y = true -> + {a' : ad & {y' : A | MapSweep1 pf m = SOME _ (a', y')}}. Proof. - Induction m. Intros. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Split with (pf a1). Split with y. - Rewrite (ad_eq_complete ? ? H1). Unfold MapSweep1 MapSweep2. - Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 ? a1 a0) in H. - Inversion H. Rewrite H0. Reflexivity. - - Intro H1. Rewrite (M1_semantics_2 ? a a1 a0 H1) in H. Discriminate H. - - Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3. - Rewrite (MapGet_M2_bit_0_1 ? ? H3 m0 m1) in H1. - Rewrite <- (ad_div_2_double_plus_un a H3) in H2. - Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4. - Intros y'' H5. Simpl. Elim (option_sum ? (MapSweep1 [a:ad](pf (ad_double a)) m0)). - Intro H6. Elim H6. Intro r. Elim r. Intros a''' y''' H7. Rewrite H7. Split with a'''. - Split with y'''. Reflexivity. - Intro H6. Rewrite H6. Split with a''. Split with y''. Assumption. - Intro H3. Rewrite (MapGet_M2_bit_0_0 ? ? H3 m0 m1) in H1. - Rewrite <- (ad_div_2_double a H3) in H2. - Elim (H [a0:ad](pf (ad_double a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4. - Intros y'' H5. Split with a''. Split with y''. Simpl. Rewrite H5. Reflexivity. + simple induction m. intros. discriminate H. + intros. elim (sumbool_of_bool (ad_eq a a1)). intro H1. split with (pf a1). split with y. + rewrite (ad_eq_complete _ _ H1). unfold MapSweep1, MapSweep2 in |- *. + rewrite (ad_eq_complete _ _ H1) in H. rewrite (M1_semantics_1 _ a1 a0) in H. + inversion H. rewrite H0. reflexivity. + + intro H1. rewrite (M1_semantics_2 _ a a1 a0 H1) in H. discriminate H. + + intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H3. + rewrite (MapGet_M2_bit_0_1 _ _ H3 m0 m1) in H1. + rewrite <- (ad_div_2_double_plus_un a H3) in H2. + elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4. + intros y'' H5. simpl in |- *. elim (option_sum _ (MapSweep1 (fun a:ad => pf (ad_double a)) m0)). + intro H6. elim H6. intro r. elim r. intros a''' y''' H7. rewrite H7. split with a'''. + split with y'''. reflexivity. + intro H6. rewrite H6. split with a''. split with y''. assumption. + intro H3. rewrite (MapGet_M2_bit_0_0 _ _ H3 m0 m1) in H1. + rewrite <- (ad_div_2_double a H3) in H2. + elim (H (fun a0:ad => pf (ad_double a0)) (ad_div_2 a) y H1 H2). intros a'' H4. elim H4. + intros y'' H5. split with a''. split with y''. simpl in |- *. rewrite H5. reflexivity. Qed. - Lemma MapSweep_semantics_4 : (m:(Map A)) (a:ad) (y:A) - (MapGet A m a)=(SOME A y) -> (f a y)=true -> - {a':ad & {y':A | (MapSweep m)=(SOME ? (a', y'))}}. + Lemma MapSweep_semantics_4 : + forall (m:Map A) (a:ad) (y:A), + MapGet A m a = SOME A y -> + f a y = true -> {a' : ad & {y' : A | MapSweep m = SOME _ (a', y')}}. Proof. - Intros. Exact (MapSweep_semantics_4_1 m [a0:ad]a0 a y H H0). + intros. exact (MapSweep_semantics_4_1 m (fun a0:ad => a0) a y H H0). Qed. End MapSweepDef. Variable B : Set. - Fixpoint MapCollect1 [f:ad->A->(Map B); pf:ad->ad; m:(Map A)] : (Map B) := - Cases m of - M0 => (M0 B) - | (M1 a y) => (f (pf a) y) - | (M2 m1 m2) => (MapMerge B (MapCollect1 f [a0:ad] (pf (ad_double a0)) m1) - (MapCollect1 f [a0:ad] (pf (ad_double_plus_un a0)) m2)) + Fixpoint MapCollect1 (f:ad -> A -> Map B) (pf:ad -> ad) + (m:Map A) {struct m} : Map B := + match m with + | M0 => M0 B + | M1 a y => f (pf a) y + | M2 m1 m2 => + MapMerge B (MapCollect1 f (fun a0:ad => pf (ad_double a0)) m1) + (MapCollect1 f (fun a0:ad => pf (ad_double_plus_un a0)) m2) end. - Definition MapCollect := [f:ad->A->(Map B); m:(Map A)] (MapCollect1 f [a:ad]a m). + Definition MapCollect (f:ad -> A -> Map B) (m:Map A) := + MapCollect1 f (fun a:ad => a) m. Section MapFoldDef. @@ -197,331 +225,396 @@ Section MapIter. Variable neutral : M. Variable op : M -> M -> M. - Fixpoint MapFold1 [f:ad->A->M; pf:ad->ad; m:(Map A)] : M := - Cases m of - M0 => neutral - | (M1 a y) => (f (pf a) y) - | (M2 m1 m2) => (op (MapFold1 f [a0:ad] (pf (ad_double a0)) m1) - (MapFold1 f [a0:ad] (pf (ad_double_plus_un a0)) m2)) + Fixpoint MapFold1 (f:ad -> A -> M) (pf:ad -> ad) + (m:Map A) {struct m} : M := + match m with + | M0 => neutral + | M1 a y => f (pf a) y + | M2 m1 m2 => + op (MapFold1 f (fun a0:ad => pf (ad_double a0)) m1) + (MapFold1 f (fun a0:ad => pf (ad_double_plus_un a0)) m2) end. - Definition MapFold := [f:ad->A->M; m:(Map A)] (MapFold1 f [a:ad]a m). + Definition MapFold (f:ad -> A -> M) (m:Map A) := + MapFold1 f (fun a:ad => a) m. - Lemma MapFold_empty : (f:ad->A->M) (MapFold f (M0 A))=neutral. + Lemma MapFold_empty : forall f:ad -> A -> M, MapFold f (M0 A) = neutral. Proof. - Trivial. + trivial. Qed. - Lemma MapFold_M1 : (f:ad->A->M) (a:ad) (y:A) (MapFold f (M1 A a y)) = (f a y). + Lemma MapFold_M1 : + forall (f:ad -> A -> M) (a:ad) (y:A), MapFold f (M1 A a y) = f a y. Proof. - Trivial. + trivial. Qed. Variable State : Set. - Variable f:State -> ad -> A -> State * M. - - Fixpoint MapFold1_state [state:State; pf:ad->ad; m:(Map A)] - : State * M := - Cases m of - M0 => (state, neutral) - | (M1 a y) => (f state (pf a) y) - | (M2 m1 m2) => - Cases (MapFold1_state state [a0:ad] (pf (ad_double a0)) m1) of - (state1, x1) => - Cases (MapFold1_state state1 [a0:ad] (pf (ad_double_plus_un a0)) m2) of - (state2, x2) => (state2, (op x1 x2)) - end + Variable f : State -> ad -> A -> State * M. + + Fixpoint MapFold1_state (state:State) (pf:ad -> ad) + (m:Map A) {struct m} : State * M := + match m with + | M0 => (state, neutral) + | M1 a y => f state (pf a) y + | M2 m1 m2 => + match MapFold1_state state (fun a0:ad => pf (ad_double a0)) m1 with + | (state1, x1) => + match + MapFold1_state state1 + (fun a0:ad => pf (ad_double_plus_un a0)) m2 + with + | (state2, x2) => (state2, op x1 x2) + end end end. - Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a). + Definition MapFold_state (state:State) := + MapFold1_state state (fun a:ad => a). - Lemma pair_sp : (B,C:Set) (x:B*C) x=(Fst x, Snd x). + Lemma pair_sp : forall (B C:Set) (x:B * C), x = (fst x, snd x). Proof. - Induction x. Trivial. + simple induction x. trivial. Qed. - Lemma MapFold_state_stateless_1 : (m:(Map A)) (g:ad->A->M) (pf:ad->ad) - ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) -> - (state:State) - (Snd (MapFold1_state state pf m))=(MapFold1 g pf m). + Lemma MapFold_state_stateless_1 : + forall (m:Map A) (g:ad -> A -> M) (pf:ad -> ad), + (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) -> + forall state:State, snd (MapFold1_state state pf m) = MapFold1 g pf m. Proof. - Induction m. Trivial. - Intros. Simpl. Apply H. - Intros. Simpl. Rewrite (pair_sp ? ? - (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)). - Rewrite (H g [a0:ad](pf (ad_double a0)) H1 state). - Rewrite (pair_sp ? ? + simple induction m. trivial. + intros. simpl in |- *. apply H. + intros. simpl in |- *. rewrite + (pair_sp _ _ (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)) + . + rewrite (H g (fun a0:ad => pf (ad_double a0)) H1 state). + rewrite + (pair_sp _ _ (MapFold1_state - (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)) - [a0:ad](pf (ad_double_plus_un a0)) m1)). - Simpl. - Rewrite (H0 g [a0:ad](pf (ad_double_plus_un a0)) H1 - (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))). - Reflexivity. + (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0)) + (fun a0:ad => pf (ad_double_plus_un a0)) m1)) + . + simpl in |- *. + rewrite + (H0 g (fun a0:ad => pf (ad_double_plus_un a0)) H1 + (fst (MapFold1_state state (fun a0:ad => pf (ad_double a0)) m0))) + . + reflexivity. Qed. - Lemma MapFold_state_stateless : (g:ad->A->M) - ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) -> - (state:State) (m:(Map A)) - (Snd (MapFold_state state m))=(MapFold g m). + Lemma MapFold_state_stateless : + forall g:ad -> A -> M, + (forall (state:State) (a:ad) (y:A), snd (f state a y) = g a y) -> + forall (state:State) (m:Map A), + snd (MapFold_state state m) = MapFold g m. Proof. - Intros. Exact (MapFold_state_stateless_1 m g [a0:ad]a0 H state). + intros. exact (MapFold_state_stateless_1 m g (fun a0:ad => a0) H state). Qed. End MapFoldDef. - Lemma MapCollect_as_Fold : (f:ad->A->(Map B)) (m:(Map A)) - (MapCollect f m)=(MapFold (Map B) (M0 B) (MapMerge B) f m). + Lemma MapCollect_as_Fold : + forall (f:ad -> A -> Map B) (m:Map A), + MapCollect f m = MapFold (Map B) (M0 B) (MapMerge B) f m. Proof. - Induction m;Trivial. + simple induction m; trivial. Qed. - Definition alist := (list (ad*A)). - Definition anil := (nil (ad*A)). - Definition acons := (!cons (ad*A)). - Definition aapp := (!app (ad*A)). + Definition alist := list (ad * A). + Definition anil := nil (A:=(ad * A)). + Definition acons := cons (A:=(ad * A)). + Definition aapp := app (A:=(ad * A)). - Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a y) anil)). + Definition alist_of_Map := + MapFold alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil). - Fixpoint alist_semantics [l:alist] : ad -> (option A) := - Cases l of - nil => [_:ad] (NONE A) - | (cons (a, y) l') => [a0:ad] if (ad_eq a a0) then (SOME A y) else (alist_semantics l' a0) + Fixpoint alist_semantics (l:alist) : ad -> option A := + match l with + | nil => fun _:ad => NONE A + | (a, y) :: l' => + fun a0:ad => if ad_eq a a0 then SOME A y else alist_semantics l' a0 end. - Lemma alist_semantics_app : (l,l':alist) (a:ad) - (alist_semantics (aapp l l') a)= - (Cases (alist_semantics l a) of - NONE => (alist_semantics l' a) - | (SOME y) => (SOME A y) - end). + Lemma alist_semantics_app : + forall (l l':alist) (a:ad), + alist_semantics (aapp l l') a = + match alist_semantics l a with + | NONE => alist_semantics l' a + | SOME y => SOME A y + end. Proof. - Unfold aapp. Induction l. Trivial. - Intros. Elim a. Intros a1 y1. Simpl. Case (ad_eq a1 a0). Reflexivity. - Apply H. + unfold aapp in |- *. simple induction l. trivial. + intros. elim a. intros a1 y1. simpl in |- *. case (ad_eq a1 a0). reflexivity. + apply H. Qed. - Lemma alist_of_Map_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A) - (alist_semantics (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) pf m) a) - =(SOME A y) -> {a':ad | a=(pf a')}. + Lemma alist_of_Map_semantics_1_1 : + forall (m:Map A) (pf:ad -> ad) (a:ad) (y:A), + alist_semantics + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) pf + m) a = SOME A y -> {a' : ad | a = pf a'}. Proof. - Induction m. Simpl. Intros. Discriminate H. - Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (ad_eq (pf a) a0)). Intro H. Rewrite H. - Intro H0. Split with a. Rewrite (ad_eq_complete ? ? H). Reflexivity. - Intro H. Rewrite H. Intro H0. Discriminate H0. - Intros. Change (alist_semantics - (aapp - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double a0)) m0) - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double_plus_un a0)) m1)) a)=(SOME A y) in H1. - Rewrite (alist_semantics_app - (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil) - [a0:ad](pf (ad_double a0)) m0) - (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil) - [a0:ad](pf (ad_double_plus_un a0)) m1) a) in H1. - Elim (option_sum A - (alist_semantics - (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil) - [a0:ad](pf (ad_double a0)) m0) a)). - Intro H2. Elim H2. Intros y0 H3. Elim (H [a0:ad](pf (ad_double a0)) a y0 H3). Intros a0 H4. - Split with (ad_double a0). Assumption. - Intro H2. Rewrite H2 in H1. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1). - Intros a0 H3. Split with (ad_double_plus_un a0). Assumption. + simple induction m. simpl in |- *. intros. discriminate H. + simpl in |- *. intros a y pf a0 y0. elim (sumbool_of_bool (ad_eq (pf a) a0)). intro H. rewrite H. + intro H0. split with a. rewrite (ad_eq_complete _ _ H). reflexivity. + intro H. rewrite H. intro H0. discriminate H0. + intros. change + (alist_semantics + (aapp + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double a0)) m0) + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double_plus_un a0)) m1)) a = + SOME A y) in H1. + rewrite + (alist_semantics_app + (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) + (fun a0:ad => pf (ad_double a0)) m0) + (MapFold1 alist anil aapp (fun (a0:ad) (y0:A) => acons (a0, y0) anil) + (fun a0:ad => pf (ad_double_plus_un a0)) m1) a) + in H1. + elim + (option_sum A + (alist_semantics + (MapFold1 alist anil aapp + (fun (a0:ad) (y0:A) => acons (a0, y0) anil) + (fun a0:ad => pf (ad_double a0)) m0) a)). + intro H2. elim H2. intros y0 H3. elim (H (fun a0:ad => pf (ad_double a0)) a y0 H3). intros a0 H4. + split with (ad_double a0). assumption. + intro H2. rewrite H2 in H1. elim (H0 (fun a0:ad => pf (ad_double_plus_un a0)) a y H1). + intros a0 H3. split with (ad_double_plus_un a0). assumption. Qed. - Definition ad_inj := [pf:ad->ad] (a0,a1:ad) (pf a0)=(pf a1) -> a0=a1. + Definition ad_inj (pf:ad -> ad) := + forall a0 a1:ad, pf a0 = pf a1 -> a0 = a1. - Lemma ad_comp_double_inj : - (pf:ad->ad) (ad_inj pf) -> (ad_inj [a0:ad] (pf (ad_double a0))). + Lemma ad_comp_double_inj : + forall pf:ad -> ad, ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double a0)). Proof. - Unfold ad_inj. Intros. Apply ad_double_inj. Exact (H ? ? H0). + unfold ad_inj in |- *. intros. apply ad_double_inj. exact (H _ _ H0). Qed. - Lemma ad_comp_double_plus_un_inj : (pf:ad->ad) (ad_inj pf) -> - (ad_inj [a0:ad] (pf (ad_double_plus_un a0))). + Lemma ad_comp_double_plus_un_inj : + forall pf:ad -> ad, + ad_inj pf -> ad_inj (fun a0:ad => pf (ad_double_plus_un a0)). Proof. - Unfold ad_inj. Intros. Apply ad_double_plus_un_inj. Exact (H ? ? H0). + unfold ad_inj in |- *. intros. apply ad_double_plus_un_inj. exact (H _ _ H0). Qed. - Lemma alist_of_Map_semantics_1 : (m:(Map A)) (pf:ad->ad) (ad_inj pf) -> - (a:ad) (MapGet A m a)=(alist_semantics (MapFold1 alist anil aapp - [a0:ad;y:A] (acons (pair ? ? a0 y) anil) pf m) - (pf a)). + Lemma alist_of_Map_semantics_1 : + forall (m:Map A) (pf:ad -> ad), + ad_inj pf -> + forall a:ad, + MapGet A m a = + alist_semantics + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + pf m) (pf a). Proof. - Induction m. Trivial. - Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. - Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_eq_correct (pf a1)). Reflexivity. - Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). Intro H1. - Rewrite (H a a1 (ad_eq_complete ? ? H1)) in H0. Rewrite (ad_eq_correct a1) in H0. - Discriminate H0. - Intro H1. Rewrite H1. Reflexivity. - Intros. Change (MapGet A (M2 A m0 m1) a) - =(alist_semantics - (aapp - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double a0)) m0) - (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) - [a0:ad](pf (ad_double_plus_un a0)) m1)) (pf a)). - Rewrite alist_semantics_app. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). - Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. Rewrite H3. - Rewrite (ad_double_bit_0 a0). - Rewrite <- (H [a1:ad](pf (ad_double a1)) (ad_comp_double_inj pf H1) a0). - Rewrite ad_double_div_2. Case (MapGet A m0 a0). - Elim (option_sum A - (alist_semantics - (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil) - [a1:ad](pf (ad_double_plus_un a1)) m1) (pf (ad_double a0)))). - Intro H4. Elim H4. Intros y H5. - Elim (alist_of_Map_semantics_1_1 m1 [a1:ad](pf (ad_double_plus_un a1)) - (pf (ad_double a0)) y H5). - Intros a1 H6. Cut (ad_bit_0 (ad_double a0))=(ad_bit_0 (ad_double_plus_un a1)). - Intro. Rewrite (ad_double_bit_0 a0) in H7. Rewrite (ad_double_plus_un_bit_0 a1) in H7. - Discriminate H7. - Rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). Reflexivity. - Intro H4. Rewrite H4. Reflexivity. - Trivial. - Intro H2. Elim H2. Intros a0 H3. Rewrite H3. Rewrite (ad_double_plus_un_bit_0 a0). - Rewrite <- (H0 [a1:ad](pf (ad_double_plus_un a1)) (ad_comp_double_plus_un_inj pf H1) a0). - Rewrite ad_double_plus_un_div_2. - Elim (option_sum A - (alist_semantics - (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil) - [a1:ad](pf (ad_double a1)) m0) (pf (ad_double_plus_un a0)))). - Intro H4. Elim H4. Intros y H5. - Elim (alist_of_Map_semantics_1_1 m0 [a1:ad](pf (ad_double a1)) - (pf (ad_double_plus_un a0)) y H5). - Intros a1 H6. Cut (ad_bit_0 (ad_double_plus_un a0))=(ad_bit_0 (ad_double a1)). - Intro H7. Rewrite (ad_double_plus_un_bit_0 a0) in H7. Rewrite (ad_double_bit_0 a1) in H7. - Discriminate H7. - Rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). Reflexivity. - Intro H4. Rewrite H4. Reflexivity. + simple induction m. trivial. + simpl in |- *. intros. elim (sumbool_of_bool (ad_eq a a1)). intro H0. rewrite H0. + rewrite (ad_eq_complete _ _ H0). rewrite (ad_eq_correct (pf a1)). reflexivity. + intro H0. rewrite H0. elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). intro H1. + rewrite (H a a1 (ad_eq_complete _ _ H1)) in H0. rewrite (ad_eq_correct a1) in H0. + discriminate H0. + intro H1. rewrite H1. reflexivity. + intros. change + (MapGet A (M2 A m0 m1) a = + alist_semantics + (aapp + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double a0)) m0) + (MapFold1 alist anil aapp (fun (a0:ad) (y:A) => acons (a0, y) anil) + (fun a0:ad => pf (ad_double_plus_un a0)) m1)) ( + pf a)) in |- *. + rewrite alist_semantics_app. rewrite (MapGet_M2_bit_0_if A m0 m1 a). + elim (ad_double_or_double_plus_un a). intro H2. elim H2. intros a0 H3. rewrite H3. + rewrite (ad_double_bit_0 a0). + rewrite <- + (H (fun a1:ad => pf (ad_double a1)) (ad_comp_double_inj pf H1) a0) + . + rewrite ad_double_div_2. case (MapGet A m0 a0). + elim + (option_sum A + (alist_semantics + (MapFold1 alist anil aapp + (fun (a1:ad) (y:A) => acons (a1, y) anil) + (fun a1:ad => pf (ad_double_plus_un a1)) m1) + (pf (ad_double a0)))). + intro H4. elim H4. intros y H5. + elim + (alist_of_Map_semantics_1_1 m1 (fun a1:ad => pf (ad_double_plus_un a1)) + (pf (ad_double a0)) y H5). + intros a1 H6. cut (ad_bit_0 (ad_double a0) = ad_bit_0 (ad_double_plus_un a1)). + intro. rewrite (ad_double_bit_0 a0) in H7. rewrite (ad_double_plus_un_bit_0 a1) in H7. + discriminate H7. + rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). reflexivity. + intro H4. rewrite H4. reflexivity. + trivial. + intro H2. elim H2. intros a0 H3. rewrite H3. rewrite (ad_double_plus_un_bit_0 a0). + rewrite <- + (H0 (fun a1:ad => pf (ad_double_plus_un a1)) + (ad_comp_double_plus_un_inj pf H1) a0). + rewrite ad_double_plus_un_div_2. + elim + (option_sum A + (alist_semantics + (MapFold1 alist anil aapp + (fun (a1:ad) (y:A) => acons (a1, y) anil) + (fun a1:ad => pf (ad_double a1)) m0) + (pf (ad_double_plus_un a0)))). + intro H4. elim H4. intros y H5. + elim + (alist_of_Map_semantics_1_1 m0 (fun a1:ad => pf (ad_double a1)) + (pf (ad_double_plus_un a0)) y H5). + intros a1 H6. cut (ad_bit_0 (ad_double_plus_un a0) = ad_bit_0 (ad_double a1)). + intro H7. rewrite (ad_double_plus_un_bit_0 a0) in H7. rewrite (ad_double_bit_0 a1) in H7. + discriminate H7. + rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). reflexivity. + intro H4. rewrite H4. reflexivity. Qed. - Lemma alist_of_Map_semantics : (m:(Map A)) - (eqm A (MapGet A m) (alist_semantics (alist_of_Map m))). + Lemma alist_of_Map_semantics : + forall m:Map A, eqm A (MapGet A m) (alist_semantics (alist_of_Map m)). Proof. - Unfold eqm. Intros. Exact (alist_of_Map_semantics_1 m [a0:ad]a0 [a0,a1:ad][p:a0=a1]p a). + unfold eqm in |- *. intros. exact + (alist_of_Map_semantics_1 m (fun a0:ad => a0) + (fun (a0 a1:ad) (p:a0 = a1) => p) a). Qed. - Fixpoint Map_of_alist [l:alist] : (Map A) := - Cases l of - nil => (M0 A) - | (cons (a, y) l') => (MapPut A (Map_of_alist l') a y) + Fixpoint Map_of_alist (l:alist) : Map A := + match l with + | nil => M0 A + | (a, y) :: l' => MapPut A (Map_of_alist l') a y end. - Lemma Map_of_alist_semantics : (l:alist) - (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))). + Lemma Map_of_alist_semantics : + forall l:alist, eqm A (alist_semantics l) (MapGet A (Map_of_alist l)). Proof. - Unfold eqm. Induction l. Trivial. - Intros r l0 H a. Elim r. Intros a0 y0. Simpl. Elim (sumbool_of_bool (ad_eq a0 a)). - Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). - Rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). Rewrite (ad_eq_correct a). - Reflexivity. - Intro H0. Rewrite H0. Rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a). - Rewrite H0. Apply H. + unfold eqm in |- *. simple induction l. trivial. + intros r l0 H a. elim r. intros a0 y0. simpl in |- *. elim (sumbool_of_bool (ad_eq a0 a)). + intro H0. rewrite H0. rewrite (ad_eq_complete _ _ H0). + rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). rewrite (ad_eq_correct a). + reflexivity. + intro H0. rewrite H0. rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a). + rewrite H0. apply H. Qed. - Lemma Map_of_alist_of_Map : (m:(Map A)) (eqmap A (Map_of_alist (alist_of_Map m)) m). + Lemma Map_of_alist_of_Map : + forall m:Map A, eqmap A (Map_of_alist (alist_of_Map m)) m. Proof. - Unfold eqmap. Intro. Apply eqm_trans with f':=(alist_semantics (alist_of_Map m)). - Apply eqm_sym. Apply Map_of_alist_semantics. - Apply eqm_sym. Apply alist_of_Map_semantics. + unfold eqmap in |- *. intro. apply eqm_trans with (f' := alist_semantics (alist_of_Map m)). + apply eqm_sym. apply Map_of_alist_semantics. + apply eqm_sym. apply alist_of_Map_semantics. Qed. - Lemma alist_of_Map_of_alist : (l:alist) - (eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) (alist_semantics l)). + Lemma alist_of_Map_of_alist : + forall l:alist, + eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) + (alist_semantics l). Proof. - Intro. Apply eqm_trans with f':=(MapGet A (Map_of_alist l)). - Apply eqm_sym. Apply alist_of_Map_semantics. - Apply eqm_sym. Apply Map_of_alist_semantics. + intro. apply eqm_trans with (f' := MapGet A (Map_of_alist l)). + apply eqm_sym. apply alist_of_Map_semantics. + apply eqm_sym. apply Map_of_alist_semantics. Qed. - Lemma fold_right_aapp : (M:Set) (neutral:M) (op:M->M->M) - ((a,b,c:M) (op (op a b) c)=(op a (op b c))) -> - ((a:M) (op neutral a)=a) -> - (f:ad->A->M) (l,l':alist) - (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral - (aapp l l'))= - (op (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l) - (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l')) -. + Lemma fold_right_aapp : + forall (M:Set) (neutral:M) (op:M -> M -> M), + (forall a b c:M, op (op a b) c = op a (op b c)) -> + (forall a:M, op neutral a = a) -> + forall (f:ad -> A -> M) (l l':alist), + fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) + neutral (aapp l l') = + op + (fold_right + (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral + l) + (fold_right + (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) neutral + l'). Proof. - Induction l. Simpl. Intro. Rewrite H0. Reflexivity. - Intros r l0 H1 l'. Elim r. Intros a y. Simpl. Rewrite H. Rewrite (H1 l'). Reflexivity. + simple induction l. simpl in |- *. intro. rewrite H0. reflexivity. + intros r l0 H1 l'. elim r. intros a y. simpl in |- *. rewrite H. rewrite (H1 l'). reflexivity. Qed. - Lemma MapFold_as_fold_1 : (M:Set) (neutral:M) (op:M->M->M) - ((a,b,c:M) (op (op a b) c)=(op a (op b c))) -> - ((a:M) (op neutral a)=a) -> - ((a:M) (op a neutral)=a) -> - (f:ad->A->M) (m:(Map A)) (pf:ad->ad) - (MapFold1 M neutral op f pf m)= - (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral - (MapFold1 alist anil aapp [a:ad;y:A] (acons (pair ? ? -a y) anil) pf m)). + Lemma MapFold_as_fold_1 : + forall (M:Set) (neutral:M) (op:M -> M -> M), + (forall a b c:M, op (op a b) c = op a (op b c)) -> + (forall a:M, op neutral a = a) -> + (forall a:M, op a neutral = a) -> + forall (f:ad -> A -> M) (m:Map A) (pf:ad -> ad), + MapFold1 M neutral op f pf m = + fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) + neutral + (MapFold1 alist anil aapp (fun (a:ad) (y:A) => acons (a, y) anil) pf + m). Proof. - Induction m. Trivial. - Intros. Simpl. Rewrite H1. Reflexivity. - Intros. Simpl. Rewrite (fold_right_aapp M neutral op H H0 f). - Rewrite (H2 [a0:ad](pf (ad_double a0))). Rewrite (H3 [a0:ad](pf (ad_double_plus_un a0))). - Reflexivity. + simple induction m. trivial. + intros. simpl in |- *. rewrite H1. reflexivity. + intros. simpl in |- *. rewrite (fold_right_aapp M neutral op H H0 f). + rewrite (H2 (fun a0:ad => pf (ad_double a0))). rewrite (H3 (fun a0:ad => pf (ad_double_plus_un a0))). + reflexivity. Qed. - Lemma MapFold_as_fold : (M:Set) (neutral:M) (op:M->M->M) - ((a,b,c:M) (op (op a b) c)=(op a (op b c))) -> - ((a:M) (op neutral a)=a) -> - ((a:M) (op a neutral)=a) -> - (f:ad->A->M) (m:(Map A)) - (MapFold M neutral op f m)= - (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral - (alist_of_Map m)). + Lemma MapFold_as_fold : + forall (M:Set) (neutral:M) (op:M -> M -> M), + (forall a b c:M, op (op a b) c = op a (op b c)) -> + (forall a:M, op neutral a = a) -> + (forall a:M, op a neutral = a) -> + forall (f:ad -> A -> M) (m:Map A), + MapFold M neutral op f m = + fold_right (fun (r:ad * A) (m:M) => let (a, y) := r in op (f a y) m) + neutral (alist_of_Map m). Proof. - Intros. Exact (MapFold_as_fold_1 M neutral op H H0 H1 f m [a0:ad]a0). + intros. exact (MapFold_as_fold_1 M neutral op H H0 H1 f m (fun a0:ad => a0)). Qed. - Lemma alist_MapMerge_semantics : (m,m':(Map A)) - (eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m))) - (alist_semantics (alist_of_Map (MapMerge A m m')))). + Lemma alist_MapMerge_semantics : + forall m m':Map A, + eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m))) + (alist_semantics (alist_of_Map (MapMerge A m m'))). Proof. - Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a). - Rewrite <- (alist_of_Map_semantics m' a). - Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). - Rewrite (MapMerge_semantics A m m' a). Reflexivity. + unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a). + rewrite <- (alist_of_Map_semantics m' a). + rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). + rewrite (MapMerge_semantics A m m' a). reflexivity. Qed. - Lemma alist_MapMerge_semantics_disjoint : (m,m':(Map A)) - (eqmap A (MapDomRestrTo A A m m') (M0 A)) -> - (eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m'))) - (alist_semantics (alist_of_Map (MapMerge A m m')))). + Lemma alist_MapMerge_semantics_disjoint : + forall m m':Map A, + eqmap A (MapDomRestrTo A A m m') (M0 A) -> + eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m'))) + (alist_semantics (alist_of_Map (MapMerge A m m'))). Proof. - Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a). - Rewrite <- (alist_of_Map_semantics m' a). - Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). Rewrite (MapMerge_semantics A m m' a). - Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0. Intros y H1. Rewrite H1. - Elim (option_sum ? (MapGet A m' a)). Intro H2. Elim H2. Intros y' H3. - Cut (MapGet A (MapDomRestrTo A A m m') a)=(NONE A). - Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite H3. Rewrite H1. Intro. Discriminate H4. - Exact (H a). - Intro H2. Rewrite H2. Reflexivity. - Intro H0. Rewrite H0. Case (MapGet A m' a); Trivial. + unfold eqm in |- *. intros. rewrite alist_semantics_app. rewrite <- (alist_of_Map_semantics m a). + rewrite <- (alist_of_Map_semantics m' a). + rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). rewrite (MapMerge_semantics A m m' a). + elim (option_sum _ (MapGet A m a)). intro H0. elim H0. intros y H1. rewrite H1. + elim (option_sum _ (MapGet A m' a)). intro H2. elim H2. intros y' H3. + cut (MapGet A (MapDomRestrTo A A m m') a = NONE A). + rewrite (MapDomRestrTo_semantics A A m m' a). rewrite H3. rewrite H1. intro. discriminate H4. + exact (H a). + intro H2. rewrite H2. reflexivity. + intro H0. rewrite H0. case (MapGet A m' a); trivial. Qed. - Lemma alist_semantics_disjoint_comm : (l,l':alist) - (eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A)) -> - (eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l))). + Lemma alist_semantics_disjoint_comm : + forall l l':alist, + eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A) -> + eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l)). Proof. - Unfold eqm. Intros. Rewrite (alist_semantics_app l l' a). Rewrite (alist_semantics_app l' l a). - Rewrite <- (alist_of_Map_of_alist l a). Rewrite <- (alist_of_Map_of_alist l' a). - Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l)) - (alist_of_Map (Map_of_alist l')) a). - Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l')) - (alist_of_Map (Map_of_alist l)) a). - Rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a). - Rewrite (alist_MapMerge_semantics_disjoint (Map_of_alist l) (Map_of_alist l') H a). - Reflexivity. + unfold eqm in |- *. intros. rewrite (alist_semantics_app l l' a). rewrite (alist_semantics_app l' l a). + rewrite <- (alist_of_Map_of_alist l a). rewrite <- (alist_of_Map_of_alist l' a). + rewrite <- + (alist_semantics_app (alist_of_Map (Map_of_alist l)) + (alist_of_Map (Map_of_alist l')) a). + rewrite <- + (alist_semantics_app (alist_of_Map (Map_of_alist l')) + (alist_of_Map (Map_of_alist l)) a). + rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a). + rewrite + (alist_MapMerge_semantics_disjoint (Map_of_alist l) ( + Map_of_alist l') H a). + reflexivity. Qed. End MapIter. - diff --git a/theories/IntMap/Maplists.v b/theories/IntMap/Maplists.v index 6e5e40814..bcb87179c 100644 --- a/theories/IntMap/Maplists.v +++ b/theories/IntMap/Maplists.v @@ -7,304 +7,334 @@ (***********************************************************************) (*i $Id$ i*) -Require Addr. -Require Addec. -Require Map. -Require Fset. -Require Mapaxioms. -Require Mapsubset. -Require Mapcard. -Require Mapcanon. -Require Mapc. -Require Bool. -Require Sumbool. -Require PolyList. -Require Arith. -Require Mapiter. -Require Mapfold. +Require Import Addr. +Require Import Addec. +Require Import Map. +Require Import Fset. +Require Import Mapaxioms. +Require Import Mapsubset. +Require Import Mapcard. +Require Import Mapcanon. +Require Import Mapc. +Require Import Bool. +Require Import Sumbool. +Require Import List. +Require Import Arith. +Require Import Mapiter. +Require Import Mapfold. Section MapLists. - Fixpoint ad_in_list [a:ad;l:(list ad)] : bool := - Cases l of - nil => false - | (cons a' l') => (orb (ad_eq a a') (ad_in_list a l')) + Fixpoint ad_in_list (a:ad) (l:list ad) {struct l} : bool := + match l with + | nil => false + | a' :: l' => orb (ad_eq a a') (ad_in_list a l') end. - Fixpoint ad_list_stutters [l:(list ad)] : bool := - Cases l of - nil => false - | (cons a l') => (orb (ad_in_list a l') (ad_list_stutters l')) + Fixpoint ad_list_stutters (l:list ad) : bool := + match l with + | nil => false + | a :: l' => orb (ad_in_list a l') (ad_list_stutters l') end. - Lemma ad_in_list_forms_circuit : (x:ad) (l:(list ad)) (ad_in_list x l)=true -> - {l1 : (list ad) & {l2 : (list ad) | l=(app l1 (cons x l2))}}. - Proof. - Induction l. Intro. Discriminate H. - Intros. Elim (sumbool_of_bool (ad_eq x a)). Intro H1. Simpl in H0. Split with (nil ad). - Split with l0. Rewrite (ad_eq_complete ? ? H1). Reflexivity. - Intro H2. Simpl in H0. Rewrite H2 in H0. Simpl in H0. Elim (H H0). Intros l'1 H3. - Split with (cons a l'1). Elim H3. Intros l2 H4. Split with l2. Rewrite H4. Reflexivity. - Qed. - - Lemma ad_list_stutters_has_circuit : (l:(list ad)) (ad_list_stutters l)=true -> - {x:ad & {l0 : (list ad) & {l1 : (list ad) & {l2 : (list ad) | - l=(app l0 (cons x (app l1 (cons x l2))))}}}}. - Proof. - Induction l. Intro. Discriminate H. - Intros. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Split with a. - Split with (nil ad). Simpl. Elim (ad_in_list_forms_circuit a l0 H1). Intros l1 H2. - Split with l1. Elim H2. Intros l2 H3. Split with l2. Rewrite H3. Reflexivity. - Intro H1. Elim (H H1). Intros x H2. Split with x. Elim H2. Intros l1 H3. - Split with (cons a l1). Elim H3. Intros l2 H4. Split with l2. Elim H4. Intros l3 H5. - Split with l3. Rewrite H5. Reflexivity. - Qed. - - Fixpoint Elems [l:(list ad)] : FSet := - Cases l of - nil => (M0 unit) - | (cons a l') => (MapPut ? (Elems l') a tt) + Lemma ad_in_list_forms_circuit : + forall (x:ad) (l:list ad), + ad_in_list x l = true -> + {l1 : list ad & {l2 : list ad | l = l1 ++ x :: l2}}. + Proof. + simple induction l. intro. discriminate H. + intros. elim (sumbool_of_bool (ad_eq x a)). intro H1. simpl in H0. split with (nil (A:=ad)). + split with l0. rewrite (ad_eq_complete _ _ H1). reflexivity. + intro H2. simpl in H0. rewrite H2 in H0. simpl in H0. elim (H H0). intros l'1 H3. + split with (a :: l'1). elim H3. intros l2 H4. split with l2. rewrite H4. reflexivity. + Qed. + + Lemma ad_list_stutters_has_circuit : + forall l:list ad, + ad_list_stutters l = true -> + {x : ad & + {l0 : list ad & + {l1 : list ad & {l2 : list ad | l = l0 ++ x :: l1 ++ x :: l2}}}}. + Proof. + simple induction l. intro. discriminate H. + intros. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. split with a. + split with (nil (A:=ad)). simpl in |- *. elim (ad_in_list_forms_circuit a l0 H1). intros l1 H2. + split with l1. elim H2. intros l2 H3. split with l2. rewrite H3. reflexivity. + intro H1. elim (H H1). intros x H2. split with x. elim H2. intros l1 H3. + split with (a :: l1). elim H3. intros l2 H4. split with l2. elim H4. intros l3 H5. + split with l3. rewrite H5. reflexivity. + Qed. + + Fixpoint Elems (l:list ad) : FSet := + match l with + | nil => M0 unit + | a :: l' => MapPut _ (Elems l') a tt end. - Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)). + Lemma Elems_canon : forall l:list ad, mapcanon _ (Elems l). Proof. - Induction l. Exact (M0_canon unit). - Intros. Simpl. Apply MapPut_canon. Assumption. + simple induction l. exact (M0_canon unit). + intros. simpl in |- *. apply MapPut_canon. assumption. Qed. - Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')). + Lemma Elems_app : + forall l l':list ad, Elems (l ++ l') = FSetUnion (Elems l) (Elems l'). Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)). - Rewrite (MapPut_as_Merge_c unit (Elems (app l0 l'))). - Change (FSetUnion (Elems (app l0 l')) (M1 unit a tt)) - =(FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')). - Rewrite FSetUnion_comm_c. Rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)). - Rewrite FSetUnion_assoc_c. Rewrite (H l'). Reflexivity. - Apply M1_canon. - Apply Elems_canon. - Apply Elems_canon. - Apply Elems_canon. - Apply M1_canon. - Apply Elems_canon. - Apply M1_canon. - Apply Elems_canon. - Apply Elems_canon. + simple induction l. trivial. + intros. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)). + rewrite (MapPut_as_Merge_c unit (Elems (l0 ++ l'))). + change + (FSetUnion (Elems (l0 ++ l')) (M1 unit a tt) = + FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')) + in |- *. + rewrite FSetUnion_comm_c. rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)). + rewrite FSetUnion_assoc_c. rewrite (H l'). reflexivity. + apply M1_canon. + apply Elems_canon. + apply Elems_canon. + apply Elems_canon. + apply M1_canon. + apply Elems_canon. + apply M1_canon. + apply Elems_canon. + apply Elems_canon. Qed. - Lemma Elems_rev : (l:(list ad)) (Elems (rev l))=(Elems l). + Lemma Elems_rev : forall l:list ad, Elems (rev l) = Elems l. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite Elems_app. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)). - Rewrite H. Reflexivity. - Apply Elems_canon. + simple induction l. trivial. + intros. simpl in |- *. rewrite Elems_app. simpl in |- *. rewrite (MapPut_as_Merge_c unit (Elems l0)). + rewrite H. reflexivity. + apply Elems_canon. Qed. - Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l). + Lemma ad_in_elems_in_list : + forall (l:list ad) (a:ad), in_FSet a (Elems l) = ad_in_list a l. Proof. - Induction l. Trivial. - Simpl. Unfold in_FSet. Intros. Rewrite (in_dom_put ? (Elems l0) a tt a0). - Rewrite (H a0). Reflexivity. + simple induction l. trivial. + simpl in |- *. unfold in_FSet in |- *. intros. rewrite (in_dom_put _ (Elems l0) a tt a0). + rewrite (H a0). reflexivity. Qed. - Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false -> - (length l)=(MapCard ? (Elems l)). + Lemma ad_list_not_stutters_card : + forall l:list ad, + ad_list_stutters l = false -> length l = MapCard _ (Elems l). Proof. - Induction l. Trivial. - Simpl. Intros. Rewrite MapCard_Put_2_conv. Rewrite H. Reflexivity. - Elim (orb_false_elim ? ? H0). Trivial. - Elim (sumbool_of_bool (in_FSet a (Elems l0))). Rewrite ad_in_elems_in_list. - Intro H1. Rewrite H1 in H0. Discriminate H0. - Exact (in_dom_none unit (Elems l0) a). + simple induction l. trivial. + simpl in |- *. intros. rewrite MapCard_Put_2_conv. rewrite H. reflexivity. + elim (orb_false_elim _ _ H0). trivial. + elim (sumbool_of_bool (in_FSet a (Elems l0))). rewrite ad_in_elems_in_list. + intro H1. rewrite H1 in H0. discriminate H0. + exact (in_dom_none unit (Elems l0) a). Qed. - Lemma ad_list_card : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)). + Lemma ad_list_card : forall l:list ad, MapCard _ (Elems l) <= length l. Proof. - Induction l. Trivial. - Intros. Simpl. Apply le_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub. - Apply le_n_S. Assumption. + simple induction l. trivial. + intros. simpl in |- *. apply le_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub. + apply le_n_S. assumption. Qed. - Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true -> - (lt (MapCard ? (Elems l)) (length l)). + Lemma ad_list_stutters_card : + forall l:list ad, + ad_list_stutters l = true -> MapCard _ (Elems l) < length l. Proof. - Induction l. Intro. Discriminate H. - Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. - Rewrite <- (ad_in_elems_in_list l0 a) in H1. Elim (in_dom_some ? ? ? H1). Intros y H2. - Rewrite (MapCard_Put_1_conv ? ? ? ? tt H2). Apply le_lt_trans with m:=(length l0). - Apply ad_list_card. - Apply lt_n_Sn. - Intro H1. Apply le_lt_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub. - Apply lt_n_S. Apply H. Assumption. + simple induction l. intro. discriminate H. + intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. + rewrite <- (ad_in_elems_in_list l0 a) in H1. elim (in_dom_some _ _ _ H1). intros y H2. + rewrite (MapCard_Put_1_conv _ _ _ _ tt H2). apply le_lt_trans with (m := length l0). + apply ad_list_card. + apply lt_n_Sn. + intro H1. apply le_lt_trans with (m := S (MapCard _ (Elems l0))). apply MapCard_Put_ub. + apply lt_n_S. apply H. assumption. Qed. - Lemma ad_list_not_stutters_card_conv : (l:(list ad)) (length l)=(MapCard ? (Elems l)) -> - (ad_list_stutters l)=false. + Lemma ad_list_not_stutters_card_conv : + forall l:list ad, + length l = MapCard _ (Elems l) -> ad_list_stutters l = false. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0. - Cut (lt (MapCard ? (Elems l)) (length l)). Intro. Rewrite H in H1. Elim (lt_n_n ? H1). - Exact (ad_list_stutters_card ? H0). - Trivial. + intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0. + cut (MapCard _ (Elems l) < length l). intro. rewrite H in H1. elim (lt_irrefl _ H1). + exact (ad_list_stutters_card _ H0). + trivial. Qed. - Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (MapCard ? (Elems l)) (length l)) -> - (ad_list_stutters l)=true. + Lemma ad_list_stutters_card_conv : + forall l:list ad, + MapCard _ (Elems l) < length l -> ad_list_stutters l = true. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Trivial. - Intro H0. Rewrite (ad_list_not_stutters_card ? H0) in H. Elim (lt_n_n ? H). + intros. elim (sumbool_of_bool (ad_list_stutters l)). trivial. + intro H0. rewrite (ad_list_not_stutters_card _ H0) in H. elim (lt_irrefl _ H). Qed. - Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true -> - (ad_in_list a (app l l'))=true. + Lemma ad_in_list_l : + forall (l l':list ad) (a:ad), + ad_in_list a l = true -> ad_in_list a (l ++ l') = true. Proof. - Induction l. Intros. Discriminate H. - Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity. - Intro H1. Rewrite (H l' a0 H1). Apply orb_b_true. + simple induction l. intros. discriminate H. + intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. + intro H1. rewrite (H l' a0 H1). apply orb_b_true. Qed. - Lemma ad_list_stutters_app_l : (l,l':(list ad)) (ad_list_stutters l)=true -> - (ad_list_stutters (app l l'))=true. + Lemma ad_list_stutters_app_l : + forall l l':list ad, + ad_list_stutters l = true -> ad_list_stutters (l ++ l') = true. Proof. - Induction l. Intros. Discriminate H. - Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. - Rewrite (ad_in_list_l l0 l' a H1). Reflexivity. - Intro H1. Rewrite (H l' H1). Apply orb_b_true. + simple induction l. intros. discriminate H. + intros. simpl in |- *. simpl in H0. elim (orb_true_elim _ _ H0). intro H1. + rewrite (ad_in_list_l l0 l' a H1). reflexivity. + intro H1. rewrite (H l' H1). apply orb_b_true. Qed. - Lemma ad_in_list_r : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true -> - (ad_in_list a (app l l'))=true. + Lemma ad_in_list_r : + forall (l l':list ad) (a:ad), + ad_in_list a l' = true -> ad_in_list a (l ++ l') = true. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l' a0 H0). Apply orb_b_true. + simple induction l. trivial. + intros. simpl in |- *. rewrite (H l' a0 H0). apply orb_b_true. Qed. - Lemma ad_list_stutters_app_r : (l,l':(list ad)) (ad_list_stutters l')=true -> - (ad_list_stutters (app l l'))=true. + Lemma ad_list_stutters_app_r : + forall l l':list ad, + ad_list_stutters l' = true -> ad_list_stutters (l ++ l') = true. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l' H0). Apply orb_b_true. + simple induction l. trivial. + intros. simpl in |- *. rewrite (H l' H0). apply orb_b_true. Qed. - Lemma ad_list_stutters_app_conv_l : (l,l':(list ad)) (ad_list_stutters (app l l'))=false -> - (ad_list_stutters l)=false. + Lemma ad_list_stutters_app_conv_l : + forall l l':list ad, + ad_list_stutters (l ++ l') = false -> ad_list_stutters l = false. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0. - Rewrite (ad_list_stutters_app_l l l' H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H0. + rewrite (ad_list_stutters_app_l l l' H0) in H. discriminate H. + trivial. Qed. - Lemma ad_list_stutters_app_conv_r : (l,l':(list ad)) (ad_list_stutters (app l l'))=false -> - (ad_list_stutters l')=false. + Lemma ad_list_stutters_app_conv_r : + forall l l':list ad, + ad_list_stutters (l ++ l') = false -> ad_list_stutters l' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l')). Intro H0. - Rewrite (ad_list_stutters_app_r l l' H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_list_stutters l')). intro H0. + rewrite (ad_list_stutters_app_r l l' H0) in H. discriminate H. + trivial. Qed. - Lemma ad_in_list_app_1 : (l,l':(list ad)) (x:ad) (ad_in_list x (app l (cons x l')))=true. + Lemma ad_in_list_app_1 : + forall (l l':list ad) (x:ad), ad_in_list x (l ++ x :: l') = true. Proof. - Induction l. Simpl. Intros. Rewrite (ad_eq_correct x). Reflexivity. - Intros. Simpl. Rewrite (H l' x). Apply orb_b_true. + simple induction l. simpl in |- *. intros. rewrite (ad_eq_correct x). reflexivity. + intros. simpl in |- *. rewrite (H l' x). apply orb_b_true. Qed. - Lemma ad_in_list_app : (l,l':(list ad)) (x:ad) - (ad_in_list x (app l l'))=(orb (ad_in_list x l) (ad_in_list x l')). + Lemma ad_in_list_app : + forall (l l':list ad) (x:ad), + ad_in_list x (l ++ l') = orb (ad_in_list x l) (ad_in_list x l'). Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite <- orb_assoc. Rewrite (H l' x). Reflexivity. + simple induction l. trivial. + intros. simpl in |- *. rewrite <- orb_assoc. rewrite (H l' x). reflexivity. Qed. - Lemma ad_in_list_rev : (l:(list ad)) (x:ad) - (ad_in_list x (rev l))=(ad_in_list x l). + Lemma ad_in_list_rev : + forall (l:list ad) (x:ad), ad_in_list x (rev l) = ad_in_list x l. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite ad_in_list_app. Rewrite (H x). Simpl. Rewrite orb_b_false. - Apply orb_sym. + simple induction l. trivial. + intros. simpl in |- *. rewrite ad_in_list_app. rewrite (H x). simpl in |- *. rewrite orb_b_false. + apply orb_comm. Qed. - Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad) - (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true. + Lemma ad_list_has_circuit_stutters : + forall (l0 l1 l2:list ad) (x:ad), + ad_list_stutters (l0 ++ x :: l1 ++ x :: l2) = true. Proof. - Induction l0. Simpl. Intros. Rewrite (ad_in_list_app_1 l1 l2 x). Reflexivity. - Intros. Simpl. Rewrite (H l1 l2 x). Apply orb_b_true. + simple induction l0. simpl in |- *. intros. rewrite (ad_in_list_app_1 l1 l2 x). reflexivity. + intros. simpl in |- *. rewrite (H l1 l2 x). apply orb_b_true. Qed. - Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true -> - (ad_list_stutters (app l (cons x l')))=true. + Lemma ad_list_stutters_prev_l : + forall (l l':list ad) (x:ad), + ad_in_list x l = true -> ad_list_stutters (l ++ x :: l') = true. Proof. - Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1. - Rewrite H1. Rewrite app_ass. Simpl. Apply ad_list_has_circuit_stutters. + intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1. + rewrite H1. rewrite app_ass. simpl in |- *. apply ad_list_has_circuit_stutters. Qed. - Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad) - (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l)=false. + Lemma ad_list_stutters_prev_conv_l : + forall (l l':list ad) (x:ad), + ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l = false. Proof. - Intros. Elim (sumbool_of_bool (ad_in_list x l)). Intro H0. - Rewrite (ad_list_stutters_prev_l l l' x H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_in_list x l)). intro H0. + rewrite (ad_list_stutters_prev_l l l' x H0) in H. discriminate H. + trivial. Qed. - Lemma ad_list_stutters_prev_r : (l,l':(list ad)) (x:ad) (ad_in_list x l')=true -> - (ad_list_stutters (app l (cons x l')))=true. + Lemma ad_list_stutters_prev_r : + forall (l l':list ad) (x:ad), + ad_in_list x l' = true -> ad_list_stutters (l ++ x :: l') = true. Proof. - Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1. - Rewrite H1. Apply ad_list_has_circuit_stutters. + intros. elim (ad_in_list_forms_circuit _ _ H). intros l0 H0. elim H0. intros l1 H1. + rewrite H1. apply ad_list_has_circuit_stutters. Qed. - Lemma ad_list_stutters_prev_conv_r : (l,l':(list ad)) (x:ad) - (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l')=false. + Lemma ad_list_stutters_prev_conv_r : + forall (l l':list ad) (x:ad), + ad_list_stutters (l ++ x :: l') = false -> ad_in_list x l' = false. Proof. - Intros. Elim (sumbool_of_bool (ad_in_list x l')). Intro H0. - Rewrite (ad_list_stutters_prev_r l l' x H0) in H. Discriminate H. - Trivial. + intros. elim (sumbool_of_bool (ad_in_list x l')). intro H0. + rewrite (ad_list_stutters_prev_r l l' x H0) in H. discriminate H. + trivial. Qed. - Lemma ad_list_Elems : (l,l':(list ad)) (MapCard ? (Elems l))=(MapCard ? (Elems l')) -> - (length l)=(length l') -> - (ad_list_stutters l)=(ad_list_stutters l'). + Lemma ad_list_Elems : + forall l l':list ad, + MapCard _ (Elems l) = MapCard _ (Elems l') -> + length l = length l' -> ad_list_stutters l = ad_list_stutters l'. Proof. - Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H1. Rewrite H1. Apply sym_eq. - Apply ad_list_stutters_card_conv. Rewrite <- H. Rewrite <- H0. Apply ad_list_stutters_card. - Assumption. - Intro H1. Rewrite H1. Apply sym_eq. Apply ad_list_not_stutters_card_conv. Rewrite <- H. - Rewrite <- H0. Apply ad_list_not_stutters_card. Assumption. + intros. elim (sumbool_of_bool (ad_list_stutters l)). intro H1. rewrite H1. apply sym_eq. + apply ad_list_stutters_card_conv. rewrite <- H. rewrite <- H0. apply ad_list_stutters_card. + assumption. + intro H1. rewrite H1. apply sym_eq. apply ad_list_not_stutters_card_conv. rewrite <- H. + rewrite <- H0. apply ad_list_not_stutters_card. assumption. Qed. - Lemma ad_list_app_length : (l,l':(list ad)) (length (app l l'))=(plus (length l) (length l')). + Lemma ad_list_app_length : + forall l l':list ad, length (l ++ l') = length l + length l'. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (H l'). Reflexivity. + simple induction l. trivial. + intros. simpl in |- *. rewrite (H l'). reflexivity. Qed. - Lemma ad_list_stutters_permute : (l,l':(list ad)) - (ad_list_stutters (app l l'))=(ad_list_stutters (app l' l)). + Lemma ad_list_stutters_permute : + forall l l':list ad, + ad_list_stutters (l ++ l') = ad_list_stutters (l' ++ l). Proof. - Intros. Apply ad_list_Elems. Rewrite Elems_app. Rewrite Elems_app. - Rewrite (FSetUnion_comm_c ? ? (Elems_canon l) (Elems_canon l')). Reflexivity. - Rewrite ad_list_app_length. Rewrite ad_list_app_length. Apply plus_sym. + intros. apply ad_list_Elems. rewrite Elems_app. rewrite Elems_app. + rewrite (FSetUnion_comm_c _ _ (Elems_canon l) (Elems_canon l')). reflexivity. + rewrite ad_list_app_length. rewrite ad_list_app_length. apply plus_comm. Qed. - Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l). + Lemma ad_list_rev_length : forall l:list ad, length (rev l) = length l. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite ad_list_app_length. Simpl. Rewrite H. Rewrite <- plus_Snm_nSm. - Rewrite <- plus_n_O. Reflexivity. + simple induction l. trivial. + intros. simpl in |- *. rewrite ad_list_app_length. simpl in |- *. rewrite H. rewrite <- plus_Snm_nSm. + rewrite <- plus_n_O. reflexivity. Qed. - Lemma ad_list_stutters_rev : (l:(list ad)) (ad_list_stutters (rev l))=(ad_list_stutters l). + Lemma ad_list_stutters_rev : + forall l:list ad, ad_list_stutters (rev l) = ad_list_stutters l. Proof. - Intros. Apply ad_list_Elems. Rewrite Elems_rev. Reflexivity. - Apply ad_list_rev_length. + intros. apply ad_list_Elems. rewrite Elems_rev. reflexivity. + apply ad_list_rev_length. Qed. - Lemma ad_list_app_rev : (l,l':(list ad)) (x:ad) - (app (rev l) (cons x l'))=(app (rev (cons x l)) l'). + Lemma ad_list_app_rev : + forall (l l':list ad) (x:ad), rev l ++ x :: l' = rev (x :: l) ++ l'. Proof. - Induction l. Trivial. - Intros. Simpl. Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x l')). Simpl. - Rewrite (H (cons x l') a). Simpl. - Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x (nil ad))). Simpl. - Rewrite app_ass. Simpl. Rewrite app_ass. Reflexivity. + simple induction l. trivial. + intros. simpl in |- *. rewrite (app_ass (rev l0) (a :: nil) (x :: l')). simpl in |- *. + rewrite (H (x :: l') a). simpl in |- *. + rewrite (app_ass (rev l0) (a :: nil) (x :: nil)). simpl in |- *. + rewrite app_ass. simpl in |- *. rewrite app_ass. reflexivity. Qed. Section ListOfDomDef. @@ -312,88 +342,96 @@ Section MapLists. Variable A : Set. Definition ad_list_of_dom := - (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))). + MapFold A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil). - Lemma ad_in_list_of_dom_in_dom : (m:(Map A)) (a:ad) - (ad_in_list a (ad_list_of_dom m))=(in_dom A a m). + Lemma ad_in_list_of_dom_in_dom : + forall (m:Map A) (a:ad), ad_in_list a (ad_list_of_dom m) = in_dom A a m. Proof. - Unfold ad_list_of_dom. Intros. - Rewrite (MapFold_distr_l A (list ad) (nil ad) (!app ad) bool false orb - ad [a:ad][l:(list ad)](ad_in_list a l) [c:ad](refl_equal ? ?) - ad_in_list_app [a0:ad][_:A](cons a0 (nil ad)) m a). - Simpl. Rewrite (MapFold_orb A [a0:ad][_:A](orb (ad_eq a a0) false) m). - Elim (option_sum ? (MapSweep A [a0:ad][_:A](orb (ad_eq a a0) false) m)). Intro H. Elim H. - Intro r. Elim r. Intros a0 y H0. Rewrite H0. Unfold in_dom. - Elim (orb_prop ? ? (MapSweep_semantics_1 ? ? ? ? ? H0)). Intro H1. - Rewrite (ad_eq_complete ? ? H1). Rewrite (MapSweep_semantics_2 A ? ? ? ? H0). Reflexivity. - Intro H1. Discriminate H1. - Intro H. Rewrite H. Elim (sumbool_of_bool (in_dom A a m)). Intro H0. - Elim (in_dom_some A m a H0). Intros y H1. - Elim (orb_false_elim ? ? (MapSweep_semantics_3 ? ? ? H ? ? H1)). Intro H2. - Rewrite (ad_eq_correct a) in H2. Discriminate H2. - Exact (sym_eq ? ? ?). + unfold ad_list_of_dom in |- *. intros. + rewrite + (MapFold_distr_l A (list ad) nil (app (A:=ad)) bool false orb ad + (fun (a:ad) (l:list ad) => ad_in_list a l) ( + fun c:ad => refl_equal _) ad_in_list_app + (fun (a0:ad) (_:A) => a0 :: nil) m a). + simpl in |- *. rewrite (MapFold_orb A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m). + elim + (option_sum _ + (MapSweep A (fun (a0:ad) (_:A) => orb (ad_eq a a0) false) m)). intro H. elim H. + intro r. elim r. intros a0 y H0. rewrite H0. unfold in_dom in |- *. + elim (orb_prop _ _ (MapSweep_semantics_1 _ _ _ _ _ H0)). intro H1. + rewrite (ad_eq_complete _ _ H1). rewrite (MapSweep_semantics_2 A _ _ _ _ H0). reflexivity. + intro H1. discriminate H1. + intro H. rewrite H. elim (sumbool_of_bool (in_dom A a m)). intro H0. + elim (in_dom_some A m a H0). intros y H1. + elim (orb_false_elim _ _ (MapSweep_semantics_3 _ _ _ H _ _ H1)). intro H2. + rewrite (ad_eq_correct a) in H2. discriminate H2. + exact (sym_eq (y:=_)). Qed. - Lemma Elems_of_list_of_dom : - (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)). + Lemma Elems_of_list_of_dom : + forall m:Map A, eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m). Proof. - Unfold eqmap eqm. Intros. Elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))). - Intro H. Elim (in_dom_some ? ? ? H). Intro t. Elim t. Intro H0. - Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. - Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H. - Elim (in_dom_some ? ? ? H). Intro t'. Elim t'. Intro H1. Rewrite H1. Assumption. - Intro H. Rewrite (in_dom_none ? ? ? H). - Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. - Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H. - Rewrite (in_dom_none ? ? ? H). Reflexivity. + unfold eqmap, eqm in |- *. intros. elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))). + intro H. elim (in_dom_some _ _ _ H). intro t. elim t. intro H0. + rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. + rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H. + elim (in_dom_some _ _ _ H). intro t'. elim t'. intro H1. rewrite H1. assumption. + intro H. rewrite (in_dom_none _ _ _ H). + rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H. + rewrite (ad_in_list_of_dom_in_dom m a) in H. rewrite (MapDom_Dom A m a) in H. + rewrite (in_dom_none _ _ _ H). reflexivity. Qed. - Lemma Elems_of_list_of_dom_c : (m:(Map A)) (mapcanon A m) -> - (Elems (ad_list_of_dom m))=(MapDom A m). + Lemma Elems_of_list_of_dom_c : + forall m:Map A, mapcanon A m -> Elems (ad_list_of_dom m) = MapDom A m. Proof. - Intros. Apply (mapcanon_unique unit). Apply Elems_canon. - Apply MapDom_canon. Assumption. - Apply Elems_of_list_of_dom. + intros. apply (mapcanon_unique unit). apply Elems_canon. + apply MapDom_canon. assumption. + apply Elems_of_list_of_dom. Qed. - Lemma ad_list_of_dom_card_1 : (m:(Map A)) (pf:ad->ad) - (length (MapFold1 A (list ad) (nil ad) (app 1!ad) [a:ad][_:A](cons a (nil ad)) pf m))= - (MapCard A m). + Lemma ad_list_of_dom_card_1 : + forall (m:Map A) (pf:ad -> ad), + length + (MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) + pf m) = MapCard A m. Proof. - Induction m; Try Trivial. Simpl. Intros. Rewrite ad_list_app_length. - Rewrite (H [a0:ad](pf (ad_double a0))). Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). - Reflexivity. + simple induction m; try trivial. simpl in |- *. intros. rewrite ad_list_app_length. + rewrite (H (fun a0:ad => pf (ad_double a0))). rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). + reflexivity. Qed. - Lemma ad_list_of_dom_card : (m:(Map A)) (length (ad_list_of_dom m))=(MapCard A m). + Lemma ad_list_of_dom_card : + forall m:Map A, length (ad_list_of_dom m) = MapCard A m. Proof. - Exact [m:(Map A)](ad_list_of_dom_card_1 m [a:ad]a). + exact (fun m:Map A => ad_list_of_dom_card_1 m (fun a:ad => a)). Qed. - Lemma ad_list_of_dom_not_stutters : - (m:(Map A)) (ad_list_stutters (ad_list_of_dom m))=false. + Lemma ad_list_of_dom_not_stutters : + forall m:Map A, ad_list_stutters (ad_list_of_dom m) = false. Proof. - Intro. Apply ad_list_not_stutters_card_conv. Rewrite ad_list_of_dom_card. Apply sym_eq. - Rewrite (MapCard_Dom A m). Apply MapCard_ext. Exact (Elems_of_list_of_dom m). + intro. apply ad_list_not_stutters_card_conv. rewrite ad_list_of_dom_card. apply sym_eq. + rewrite (MapCard_Dom A m). apply MapCard_ext. exact (Elems_of_list_of_dom m). Qed. End ListOfDomDef. - Lemma ad_list_of_dom_Dom_1 : (A:Set) - (m:(Map A)) (pf:ad->ad) - (MapFold1 A (list ad) (nil ad) (app 1!ad) - [a:ad][_:A](cons a (nil ad)) pf m)= - (MapFold1 unit (list ad) (nil ad) (app 1!ad) - [a:ad][_:unit](cons a (nil ad)) pf (MapDom A m)). + Lemma ad_list_of_dom_Dom_1 : + forall (A:Set) (m:Map A) (pf:ad -> ad), + MapFold1 A (list ad) nil (app (A:=ad)) (fun (a:ad) (_:A) => a :: nil) pf + m = + MapFold1 unit (list ad) nil (app (A:=ad)) + (fun (a:ad) (_:unit) => a :: nil) pf (MapDom A m). Proof. - Induction m; Try Trivial. Simpl. Intros. Rewrite (H [a0:ad](pf (ad_double a0))). - Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity. + simple induction m; try trivial. simpl in |- *. intros. rewrite (H (fun a0:ad => pf (ad_double a0))). + rewrite (H0 (fun a0:ad => pf (ad_double_plus_un a0))). reflexivity. Qed. - Lemma ad_list_of_dom_Dom : (A:Set) (m:(Map A)) - (ad_list_of_dom A m)=(ad_list_of_dom unit (MapDom A m)). + Lemma ad_list_of_dom_Dom : + forall (A:Set) (m:Map A), + ad_list_of_dom A m = ad_list_of_dom unit (MapDom A m). Proof. - Intros. Exact (ad_list_of_dom_Dom_1 A m [a0:ad]a0). + intros. exact (ad_list_of_dom_Dom_1 A m (fun a0:ad => a0)). Qed. -End MapLists. +End MapLists.
\ No newline at end of file diff --git a/theories/IntMap/Mapsubset.v b/theories/IntMap/Mapsubset.v index defe49712..cff8f670b 100644 --- a/theories/IntMap/Mapsubset.v +++ b/theories/IntMap/Mapsubset.v @@ -7,548 +7,600 @@ (***********************************************************************) (*i $Id$ i*) -Require Bool. -Require Sumbool. -Require Arith. -Require ZArith. -Require Addr. -Require Adist. -Require Addec. -Require Map. -Require Fset. -Require Mapaxioms. -Require Mapiter. +Require Import Bool. +Require Import Sumbool. +Require Import Arith. +Require Import ZArith. +Require Import Addr. +Require Import Adist. +Require Import Addec. +Require Import Map. +Require Import Fset. +Require Import Mapaxioms. +Require Import Mapiter. Section MapSubsetDef. - Variable A, B : Set. + Variables A B : Set. - Definition MapSubset := [m:(Map A)] [m':(Map B)] - (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true. + Definition MapSubset (m:Map A) (m':Map B) := + forall a:ad, in_dom A a m = true -> in_dom B a m' = true. - Definition MapSubset_1 := [m:(Map A)] [m':(Map B)] - Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) m) of - NONE => true - | _ => false - end. + Definition MapSubset_1 (m:Map A) (m':Map B) := + match MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m with + | NONE => true + | _ => false + end. - Definition MapSubset_2 := [m:(Map A)] [m':(Map B)] - (eqmap A (MapDomRestrBy A B m m') (M0 A)). + Definition MapSubset_2 (m:Map A) (m':Map B) := + eqmap A (MapDomRestrBy A B m m') (M0 A). - Lemma MapSubset_imp_1 : (m:(Map A)) (m':(Map B)) - (MapSubset m m') -> (MapSubset_1 m m')=true. + Lemma MapSubset_imp_1 : + forall (m:Map A) (m':Map B), MapSubset m m' -> MapSubset_1 m m' = true. Proof. - Unfold MapSubset MapSubset_1. Intros. - Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)). - Intro H0. Elim H0. Intro r. Elim r. Intros a y H1. Cut (negb (in_dom B a m'))=true. - Intro. Cut (in_dom A a m)=false. Intro. Unfold in_dom in H3. - Rewrite (MapSweep_semantics_2 ? ? m a y H1) in H3. Discriminate H3. - Elim (sumbool_of_bool (in_dom A a m)). Intro H3. Rewrite (H a H3) in H2. Discriminate H2. - Trivial. - Exact (MapSweep_semantics_1 ? ? m a y H1). - Intro H0. Rewrite H0. Reflexivity. + unfold MapSubset, MapSubset_1 in |- *. intros. + elim + (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). + intro H0. elim H0. intro r. elim r. intros a y H1. cut (negb (in_dom B a m') = true). + intro. cut (in_dom A a m = false). intro. unfold in_dom in H3. + rewrite (MapSweep_semantics_2 _ _ m a y H1) in H3. discriminate H3. + elim (sumbool_of_bool (in_dom A a m)). intro H3. rewrite (H a H3) in H2. discriminate H2. + trivial. + exact (MapSweep_semantics_1 _ _ m a y H1). + intro H0. rewrite H0. reflexivity. Qed. - Lemma MapSubset_1_imp : (m:(Map A)) (m':(Map B)) - (MapSubset_1 m m')=true -> (MapSubset m m'). + Lemma MapSubset_1_imp : + forall (m:Map A) (m':Map B), MapSubset_1 m m' = true -> MapSubset m m'. Proof. - Unfold MapSubset MapSubset_1. Unfold 2 in_dom. Intros. Elim (option_sum ? (MapGet A m a)). - Intro H1. Elim H1. Intros y H2. - Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)). Intro H3. - Elim H3. Intro r. Elim r. Intros a' y' H4. Rewrite H4 in H. Discriminate H. - Intro H3. Cut (negb (in_dom B a m'))=false. Intro. Rewrite (negb_intro (in_dom B a m')). - Rewrite H4. Reflexivity. - Exact (MapSweep_semantics_3 ? ? m H3 a y H2). - Intro H1. Rewrite H1 in H0. Discriminate H0. + unfold MapSubset, MapSubset_1 in |- *. unfold in_dom at 2 in |- *. intros. elim (option_sum _ (MapGet A m a)). + intro H1. elim H1. intros y H2. + elim + (option_sum _ (MapSweep A (fun (a:ad) (_:A) => negb (in_dom B a m')) m)). intro H3. + elim H3. intro r. elim r. intros a' y' H4. rewrite H4 in H. discriminate H. + intro H3. cut (negb (in_dom B a m') = false). intro. rewrite (negb_intro (in_dom B a m')). + rewrite H4. reflexivity. + exact (MapSweep_semantics_3 _ _ m H3 a y H2). + intro H1. rewrite H1 in H0. discriminate H0. Qed. - Lemma map_dom_empty_1 : - (m:(Map A)) (eqmap A m (M0 A)) -> (a:ad) (in_dom ? a m)=false. + Lemma map_dom_empty_1 : + forall m:Map A, eqmap A m (M0 A) -> forall a:ad, in_dom _ a m = false. Proof. - Unfold eqmap eqm in_dom. Intros. Rewrite (H a). Reflexivity. + unfold eqmap, eqm, in_dom in |- *. intros. rewrite (H a). reflexivity. Qed. - Lemma map_dom_empty_2 : - (m:(Map A)) ((a:ad) (in_dom ? a m)=false) -> (eqmap A m (M0 A)). + Lemma map_dom_empty_2 : + forall m:Map A, (forall a:ad, in_dom _ a m = false) -> eqmap A m (M0 A). Proof. - Unfold eqmap eqm in_dom. Intros. - Cut (Cases (MapGet A m a) of NONE => false | (SOME _) => true end)=false. - Case (MapGet A m a). Trivial. - Intros. Discriminate H0. - Exact (H a). + unfold eqmap, eqm, in_dom in |- *. intros. + cut + (match MapGet A m a with + | NONE => false + | SOME _ => true + end = false). + case (MapGet A m a). trivial. + intros. discriminate H0. + exact (H a). Qed. - Lemma MapSubset_imp_2 : - (m:(Map A)) (m':(Map B)) (MapSubset m m') -> (MapSubset_2 m m'). + Lemma MapSubset_imp_2 : + forall (m:Map A) (m':Map B), MapSubset m m' -> MapSubset_2 m m'. Proof. - Unfold MapSubset MapSubset_2. Intros. Apply map_dom_empty_2. Intro. Rewrite in_dom_restrby. - Elim (sumbool_of_bool (in_dom A a m)). Intro H0. Rewrite H0. Rewrite (H a H0). Reflexivity. - Intro H0. Rewrite H0. Reflexivity. + unfold MapSubset, MapSubset_2 in |- *. intros. apply map_dom_empty_2. intro. rewrite in_dom_restrby. + elim (sumbool_of_bool (in_dom A a m)). intro H0. rewrite H0. rewrite (H a H0). reflexivity. + intro H0. rewrite H0. reflexivity. Qed. - Lemma MapSubset_2_imp : - (m:(Map A)) (m':(Map B)) (MapSubset_2 m m') -> (MapSubset m m'). + Lemma MapSubset_2_imp : + forall (m:Map A) (m':Map B), MapSubset_2 m m' -> MapSubset m m'. Proof. - Unfold MapSubset MapSubset_2. Intros. Cut (in_dom ? a (MapDomRestrBy A B m m'))=false. - Rewrite in_dom_restrby. Intro. Elim (andb_false_elim ? ? H1). Rewrite H0. - Intro H2. Discriminate H2. - Intro H2. Rewrite (negb_intro (in_dom B a m')). Rewrite H2. Reflexivity. - Exact (map_dom_empty_1 ? H a). + unfold MapSubset, MapSubset_2 in |- *. intros. cut (in_dom _ a (MapDomRestrBy A B m m') = false). + rewrite in_dom_restrby. intro. elim (andb_false_elim _ _ H1). rewrite H0. + intro H2. discriminate H2. + intro H2. rewrite (negb_intro (in_dom B a m')). rewrite H2. reflexivity. + exact (map_dom_empty_1 _ H a). Qed. End MapSubsetDef. Section MapSubsetOrder. - Variable A, B, C : Set. + Variables A B C : Set. - Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m). + Lemma MapSubset_refl : forall m:Map A, MapSubset A A m m. Proof. - Unfold MapSubset. Trivial. + unfold MapSubset in |- *. trivial. Qed. - Lemma MapSubset_antisym : (m:(Map A)) (m':(Map B)) - (MapSubset A B m m') -> (MapSubset B A m' m) -> - (eqmap unit (MapDom A m) (MapDom B m')). + Lemma MapSubset_antisym : + forall (m:Map A) (m':Map B), + MapSubset A B m m' -> + MapSubset B A m' m -> eqmap unit (MapDom A m) (MapDom B m'). Proof. - Unfold MapSubset eqmap eqm. Intros. Elim (option_sum ? (MapGet ? (MapDom A m) a)). - Intro H1. Elim H1. Intro t. Elim t. Intro H2. Elim (option_sum ? (MapGet ? (MapDom B m') a)). - Intro H3. Elim H3. Intro t'. Elim t'. Intro H4. Rewrite H4. Exact H2. - Intro H3. Cut (in_dom B a m')=true. Intro. Rewrite (MapDom_Dom B m' a) in H4. - Unfold in_FSet in_dom in H4. Rewrite H3 in H4. Discriminate H4. - Apply H. Rewrite (MapDom_Dom A m a). Unfold in_FSet in_dom. Rewrite H2. Reflexivity. - Intro H1. Elim (option_sum ? (MapGet ? (MapDom B m') a)). Intro H2. Elim H2. Intros t H3. - Cut (in_dom A a m)=true. Intro. Rewrite (MapDom_Dom A m a) in H4. Unfold in_FSet in_dom in H4. - Rewrite H1 in H4. Discriminate H4. - Apply H0. Rewrite (MapDom_Dom B m' a). Unfold in_FSet in_dom. Rewrite H3. Reflexivity. - Intro H2. Rewrite H2. Exact H1. + unfold MapSubset, eqmap, eqm in |- *. intros. elim (option_sum _ (MapGet _ (MapDom A m) a)). + intro H1. elim H1. intro t. elim t. intro H2. elim (option_sum _ (MapGet _ (MapDom B m') a)). + intro H3. elim H3. intro t'. elim t'. intro H4. rewrite H4. exact H2. + intro H3. cut (in_dom B a m' = true). intro. rewrite (MapDom_Dom B m' a) in H4. + unfold in_FSet, in_dom in H4. rewrite H3 in H4. discriminate H4. + apply H. rewrite (MapDom_Dom A m a). unfold in_FSet, in_dom in |- *. rewrite H2. reflexivity. + intro H1. elim (option_sum _ (MapGet _ (MapDom B m') a)). intro H2. elim H2. intros t H3. + cut (in_dom A a m = true). intro. rewrite (MapDom_Dom A m a) in H4. unfold in_FSet, in_dom in H4. + rewrite H1 in H4. discriminate H4. + apply H0. rewrite (MapDom_Dom B m' a). unfold in_FSet, in_dom in |- *. rewrite H3. reflexivity. + intro H2. rewrite H2. exact H1. Qed. - Lemma MapSubset_trans : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (MapSubset A B m m') -> (MapSubset B C m' m'') -> (MapSubset A C m m''). + Lemma MapSubset_trans : + forall (m:Map A) (m':Map B) (m'':Map C), + MapSubset A B m m' -> MapSubset B C m' m'' -> MapSubset A C m m''. Proof. - Unfold MapSubset. Intros. Apply H0. Apply H. Assumption. + unfold MapSubset in |- *. intros. apply H0. apply H. assumption. Qed. End MapSubsetOrder. Section FSubsetOrder. - Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s). + Lemma FSubset_refl : forall s:FSet, MapSubset _ _ s s. Proof. - Exact (MapSubset_refl unit). + exact (MapSubset_refl unit). Qed. - Lemma FSubset_antisym : (s,s':FSet) - (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> (eqmap unit s s'). + Lemma FSubset_antisym : + forall s s':FSet, + MapSubset _ _ s s' -> MapSubset _ _ s' s -> eqmap unit s s'. Proof. - Intros. Rewrite <- (FSet_Dom s). Rewrite <- (FSet_Dom s'). - Exact (MapSubset_antisym ? ? s s' H H0). + intros. rewrite <- (FSet_Dom s). rewrite <- (FSet_Dom s'). + exact (MapSubset_antisym _ _ s s' H H0). Qed. - Lemma FSubset_trans : (s,s',s'':FSet) - (MapSubset ? ? s s') -> (MapSubset ? ? s' s'') -> (MapSubset ? ? s s''). + Lemma FSubset_trans : + forall s s' s'':FSet, + MapSubset _ _ s s' -> MapSubset _ _ s' s'' -> MapSubset _ _ s s''. Proof. - Exact (MapSubset_trans unit unit unit). + exact (MapSubset_trans unit unit unit). Qed. End FSubsetOrder. Section MapSubsetExtra. - Variable A, B : Set. + Variables A B : Set. - Lemma MapSubset_Dom_1 : (m:(Map A)) (m':(Map B)) - (MapSubset A B m m') -> (MapSubset unit unit (MapDom A m) (MapDom B m')). + Lemma MapSubset_Dom_1 : + forall (m:Map A) (m':Map B), + MapSubset A B m m' -> MapSubset unit unit (MapDom A m) (MapDom B m'). Proof. - Unfold MapSubset. Intros. Elim (MapDom_semantics_2 ? m a H0). Intros y H1. - Cut (in_dom A a m)=true->(in_dom B a m')=true. Intro. Unfold in_dom in H2. - Rewrite H1 in H2. Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3. - Intros y' H4. Exact (MapDom_semantics_1 ? m' a y' H4). - Intro H3. Rewrite H3 in H2. Cut false=true. Intro. Discriminate H4. - Apply H2. Reflexivity. - Exact (H a). + unfold MapSubset in |- *. intros. elim (MapDom_semantics_2 _ m a H0). intros y H1. + cut (in_dom A a m = true -> in_dom B a m' = true). intro. unfold in_dom in H2. + rewrite H1 in H2. elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. + intros y' H4. exact (MapDom_semantics_1 _ m' a y' H4). + intro H3. rewrite H3 in H2. cut (false = true). intro. discriminate H4. + apply H2. reflexivity. + exact (H a). Qed. - Lemma MapSubset_Dom_2 : (m:(Map A)) (m':(Map B)) - (MapSubset unit unit (MapDom A m) (MapDom B m')) -> (MapSubset A B m m'). + Lemma MapSubset_Dom_2 : + forall (m:Map A) (m':Map B), + MapSubset unit unit (MapDom A m) (MapDom B m') -> MapSubset A B m m'. Proof. - Unfold MapSubset. Intros. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)). - Intro H1. Elim H1. Intros y H2. - Elim (MapDom_semantics_2 ? ? ? (H a (MapDom_semantics_1 ? ? ? ? H2))). Intros y' H3. - Unfold in_dom. Rewrite H3. Reflexivity. - Intro H1. Rewrite H1 in H0. Discriminate H0. + unfold MapSubset in |- *. intros. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). + intro H1. elim H1. intros y H2. + elim (MapDom_semantics_2 _ _ _ (H a (MapDom_semantics_1 _ _ _ _ H2))). intros y' H3. + unfold in_dom in |- *. rewrite H3. reflexivity. + intro H1. rewrite H1 in H0. discriminate H0. Qed. - Lemma MapSubset_1_Dom : (m:(Map A)) (m':(Map B)) - (MapSubset_1 A B m m')=(MapSubset_1 unit unit (MapDom A m) (MapDom B m')). + Lemma MapSubset_1_Dom : + forall (m:Map A) (m':Map B), + MapSubset_1 A B m m' = MapSubset_1 unit unit (MapDom A m) (MapDom B m'). Proof. - Intros. Elim (sumbool_of_bool (MapSubset_1 A B m m')). Intro H. Rewrite H. - Apply sym_eq. Apply MapSubset_imp_1. Apply MapSubset_Dom_1. Exact (MapSubset_1_imp ? ? ? ? H). - Intro H. Rewrite H. Elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))). - Intro H0. - Rewrite (MapSubset_imp_1 ? ? ? ? (MapSubset_Dom_2 ? ? (MapSubset_1_imp ? ? ? ? H0))) in H. - Discriminate H. - Intro. Apply sym_eq. Assumption. + intros. elim (sumbool_of_bool (MapSubset_1 A B m m')). intro H. rewrite H. + apply sym_eq. apply MapSubset_imp_1. apply MapSubset_Dom_1. exact (MapSubset_1_imp _ _ _ _ H). + intro H. rewrite H. elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))). + intro H0. + rewrite + (MapSubset_imp_1 _ _ _ _ + (MapSubset_Dom_2 _ _ (MapSubset_1_imp _ _ _ _ H0))) + in H. + discriminate H. + intro. apply sym_eq. assumption. Qed. - Lemma MapSubset_Put : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut A m a y)). + Lemma MapSubset_Put : + forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut A m a y). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite H. Apply orb_b_true. + unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite H. apply orb_b_true. Qed. - Lemma MapSubset_Put_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B) - (MapSubset A B m m') -> (MapSubset A B (MapPut A m a y) (MapPut B m' a y')). + Lemma MapSubset_Put_mono : + forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B), + MapSubset A B m m' -> MapSubset A B (MapPut A m a y) (MapPut B m' a y'). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite (in_dom_put A m a y a0) in H0. - Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity. - Intro H1. Rewrite (H ? H1). Apply orb_b_true. + unfold MapSubset in |- *. intros. rewrite in_dom_put. rewrite (in_dom_put A m a y a0) in H0. + elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. + intro H1. rewrite (H _ H1). apply orb_b_true. Qed. - Lemma MapSubset_Put_behind : - (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)). + Lemma MapSubset_Put_behind : + forall (m:Map A) (a:ad) (y:A), MapSubset A A m (MapPut_behind A m a y). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put_behind. Rewrite H. Apply orb_b_true. + unfold MapSubset in |- *. intros. rewrite in_dom_put_behind. rewrite H. apply orb_b_true. Qed. - Lemma MapSubset_Put_behind_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B) - (MapSubset A B m m') -> - (MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y')). + Lemma MapSubset_Put_behind_mono : + forall (m:Map A) (m':Map B) (a:ad) (y:A) (y':B), + MapSubset A B m m' -> + MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y'). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_put_behind. - Rewrite (in_dom_put_behind A m a y a0) in H0. - Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity. - Intro H1. Rewrite (H ? H1). Apply orb_b_true. + unfold MapSubset in |- *. intros. rewrite in_dom_put_behind. + rewrite (in_dom_put_behind A m a y a0) in H0. + elim (orb_true_elim _ _ H0). intro H1. rewrite H1. reflexivity. + intro H1. rewrite (H _ H1). apply orb_b_true. Qed. - Lemma MapSubset_Remove : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m a) m). + Lemma MapSubset_Remove : + forall (m:Map A) (a:ad), MapSubset A A (MapRemove A m a) m. Proof. - Unfold MapSubset. Intros. Unfold MapSubset. Intros. Rewrite (in_dom_remove ? m a a0) in H. - Elim (andb_prop ? ? H). Trivial. + unfold MapSubset in |- *. intros. unfold MapSubset in |- *. intros. rewrite (in_dom_remove _ m a a0) in H. + elim (andb_prop _ _ H). trivial. Qed. - Lemma MapSubset_Remove_mono : (m:(Map A)) (m':(Map B)) (a:ad) - (MapSubset A B m m') -> (MapSubset A B (MapRemove A m a) (MapRemove B m' a)). + Lemma MapSubset_Remove_mono : + forall (m:Map A) (m':Map B) (a:ad), + MapSubset A B m m' -> MapSubset A B (MapRemove A m a) (MapRemove B m' a). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_remove. Rewrite (in_dom_remove A m a a0) in H0. - Elim (andb_prop ? ? H0). Intros. Rewrite H1. Rewrite (H ? H2). Reflexivity. + unfold MapSubset in |- *. intros. rewrite in_dom_remove. rewrite (in_dom_remove A m a a0) in H0. + elim (andb_prop _ _ H0). intros. rewrite H1. rewrite (H _ H2). reflexivity. Qed. - Lemma MapSubset_Merge_l : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')). + Lemma MapSubset_Merge_l : + forall m m':Map A, MapSubset A A m (MapMerge A m m'). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Reflexivity. + unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite H. reflexivity. Qed. - Lemma MapSubset_Merge_r : (m,m':(Map A)) (MapSubset A A m' (MapMerge A m m')). + Lemma MapSubset_Merge_r : + forall m m':Map A, MapSubset A A m' (MapMerge A m m'). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Apply orb_b_true. + unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite H. apply orb_b_true. Qed. - Lemma MapSubset_Merge_mono : (m,m':(Map A)) (m'',m''':(Map B)) - (MapSubset A B m m'') -> (MapSubset A B m' m''') -> - (MapSubset A B (MapMerge A m m') (MapMerge B m'' m''')). + Lemma MapSubset_Merge_mono : + forall (m m':Map A) (m'' m''':Map B), + MapSubset A B m m'' -> + MapSubset A B m' m''' -> + MapSubset A B (MapMerge A m m') (MapMerge B m'' m'''). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite (in_dom_merge A m m' a) in H1. - Elim (orb_true_elim ? ? H1). Intro H2. Rewrite (H ? H2). Reflexivity. - Intro H2. Rewrite (H0 ? H2). Apply orb_b_true. + unfold MapSubset in |- *. intros. rewrite in_dom_merge. rewrite (in_dom_merge A m m' a) in H1. + elim (orb_true_elim _ _ H1). intro H2. rewrite (H _ H2). reflexivity. + intro H2. rewrite (H0 _ H2). apply orb_b_true. Qed. - Lemma MapSubset_DomRestrTo_l : (m:(Map A)) (m':(Map B)) - (MapSubset A A (MapDomRestrTo A B m m') m). + Lemma MapSubset_DomRestrTo_l : + forall (m:Map A) (m':Map B), MapSubset A A (MapDomRestrTo A B m m') m. Proof. - Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H). - Trivial. + unfold MapSubset in |- *. intros. rewrite (in_dom_restrto _ _ m m' a) in H. elim (andb_prop _ _ H). + trivial. Qed. - Lemma MapSubset_DomRestrTo_r: (m:(Map A)) (m':(Map B)) - (MapSubset A B (MapDomRestrTo A B m m') m'). + Lemma MapSubset_DomRestrTo_r : + forall (m:Map A) (m':Map B), MapSubset A B (MapDomRestrTo A B m m') m'. Proof. - Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H). - Trivial. + unfold MapSubset in |- *. intros. rewrite (in_dom_restrto _ _ m m' a) in H. elim (andb_prop _ _ H). + trivial. Qed. - Lemma MapSubset_ext : (m0,m1:(Map A)) (m2,m3:(Map B)) - (eqmap A m0 m1) -> (eqmap B m2 m3) -> - (MapSubset A B m0 m2) -> (MapSubset A B m1 m3). + Lemma MapSubset_ext : + forall (m0 m1:Map A) (m2 m3:Map B), + eqmap A m0 m1 -> + eqmap B m2 m3 -> MapSubset A B m0 m2 -> MapSubset A B m1 m3. Proof. - Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. - Apply eqmap_trans with m':=(MapDomRestrBy A B m0 m2). Apply MapDomRestrBy_ext. Apply eqmap_sym. - Assumption. - Apply eqmap_sym. Assumption. - Exact (MapSubset_imp_2 ? ? ? ? H1). + intros. apply MapSubset_2_imp. unfold MapSubset_2 in |- *. + apply eqmap_trans with (m' := MapDomRestrBy A B m0 m2). apply MapDomRestrBy_ext. apply eqmap_sym. + assumption. + apply eqmap_sym. assumption. + exact (MapSubset_imp_2 _ _ _ _ H1). Qed. - Variable C, D : Set. + Variables C D : Set. - Lemma MapSubset_DomRestrTo_mono : - (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D)) - (MapSubset ? ? m m'') -> (MapSubset ? ? m' m''') -> - (MapSubset ? ? (MapDomRestrTo ? ? m m') (MapDomRestrTo ? ? m'' m''')). + Lemma MapSubset_DomRestrTo_mono : + forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), + MapSubset _ _ m m'' -> + MapSubset _ _ m' m''' -> + MapSubset _ _ (MapDomRestrTo _ _ m m') (MapDomRestrTo _ _ m'' m'''). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_restrto. Rewrite (in_dom_restrto A B m m' a) in H1. - Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Rewrite (H0 ? H3). Reflexivity. + unfold MapSubset in |- *. intros. rewrite in_dom_restrto. rewrite (in_dom_restrto A B m m' a) in H1. + elim (andb_prop _ _ H1). intros. rewrite (H _ H2). rewrite (H0 _ H3). reflexivity. Qed. - Lemma MapSubset_DomRestrBy_l : (m:(Map A)) (m':(Map B)) - (MapSubset A A (MapDomRestrBy A B m m') m). + Lemma MapSubset_DomRestrBy_l : + forall (m:Map A) (m':Map B), MapSubset A A (MapDomRestrBy A B m m') m. Proof. - Unfold MapSubset. Intros. Rewrite (in_dom_restrby ? ? m m' a) in H. Elim (andb_prop ? ? H). - Trivial. + unfold MapSubset in |- *. intros. rewrite (in_dom_restrby _ _ m m' a) in H. elim (andb_prop _ _ H). + trivial. Qed. - Lemma MapSubset_DomRestrBy_mono : - (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D)) - (MapSubset ? ? m m'') -> (MapSubset ? ? m''' m') -> - (MapSubset ? ? (MapDomRestrBy ? ? m m') (MapDomRestrBy ? ? m'' m''')). + Lemma MapSubset_DomRestrBy_mono : + forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), + MapSubset _ _ m m'' -> + MapSubset _ _ m''' m' -> + MapSubset _ _ (MapDomRestrBy _ _ m m') (MapDomRestrBy _ _ m'' m'''). Proof. - Unfold MapSubset. Intros. Rewrite in_dom_restrby. Rewrite (in_dom_restrby A B m m' a) in H1. - Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Elim (sumbool_of_bool (in_dom D a m''')). - Intro H4. Rewrite (H0 ? H4) in H3. Discriminate H3. - Intro H4. Rewrite H4. Reflexivity. + unfold MapSubset in |- *. intros. rewrite in_dom_restrby. rewrite (in_dom_restrby A B m m' a) in H1. + elim (andb_prop _ _ H1). intros. rewrite (H _ H2). elim (sumbool_of_bool (in_dom D a m''')). + intro H4. rewrite (H0 _ H4) in H3. discriminate H3. + intro H4. rewrite H4. reflexivity. Qed. End MapSubsetExtra. Section MapDisjointDef. - Variable A, B : Set. + Variables A B : Set. - Definition MapDisjoint := [m:(Map A)] [m':(Map B)] - (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true -> False. + Definition MapDisjoint (m:Map A) (m':Map B) := + forall a:ad, in_dom A a m = true -> in_dom B a m' = true -> False. - Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)] - Cases (MapSweep A [a:ad][_:A] (in_dom B a m') m) of - NONE => true - | _ => false - end. + Definition MapDisjoint_1 (m:Map A) (m':Map B) := + match MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m with + | NONE => true + | _ => false + end. - Definition MapDisjoint_2 := [m:(Map A)] [m':(Map B)] - (eqmap A (MapDomRestrTo A B m m') (M0 A)). + Definition MapDisjoint_2 (m:Map A) (m':Map B) := + eqmap A (MapDomRestrTo A B m m') (M0 A). - Lemma MapDisjoint_imp_1 : (m:(Map A)) (m':(Map B)) - (MapDisjoint m m') -> (MapDisjoint_1 m m')=true. + Lemma MapDisjoint_imp_1 : + forall (m:Map A) (m':Map B), MapDisjoint m m' -> MapDisjoint_1 m m' = true. Proof. - Unfold MapDisjoint MapDisjoint_1. Intros. - Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H0. Elim H0. - Intro r. Elim r. Intros a y H1. Cut (in_dom A a m)=true->(in_dom B a m')=true->False. - Intro. Unfold 1 in_dom in H2. Rewrite (MapSweep_semantics_2 ? ? ? ? ? H1) in H2. - Rewrite (MapSweep_semantics_1 ? ? ? ? ? H1) in H2. Elim (H2 (refl_equal ? ?) (refl_equal ? ?)). - Exact (H a). - Intro H0. Rewrite H0. Reflexivity. + unfold MapDisjoint, MapDisjoint_1 in |- *. intros. + elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H0. elim H0. + intro r. elim r. intros a y H1. cut (in_dom A a m = true -> in_dom B a m' = true -> False). + intro. unfold in_dom at 1 in H2. rewrite (MapSweep_semantics_2 _ _ _ _ _ H1) in H2. + rewrite (MapSweep_semantics_1 _ _ _ _ _ H1) in H2. elim (H2 (refl_equal _) (refl_equal _)). + exact (H a). + intro H0. rewrite H0. reflexivity. Qed. - Lemma MapDisjoint_1_imp : (m:(Map A)) (m':(Map B)) - (MapDisjoint_1 m m')=true -> (MapDisjoint m m'). + Lemma MapDisjoint_1_imp : + forall (m:Map A) (m':Map B), MapDisjoint_1 m m' = true -> MapDisjoint m m'. Proof. - Unfold MapDisjoint MapDisjoint_1. Intros. - Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H2. Elim H2. - Intro r. Elim r. Intros a' y' H3. Rewrite H3 in H. Discriminate H. - Intro H2. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)). Intro H3. Elim H3. - Intros y H4. Rewrite (MapSweep_semantics_3 ? ? ? H2 a y H4) in H1. Discriminate H1. - Intro H3. Rewrite H3 in H0. Discriminate H0. + unfold MapDisjoint, MapDisjoint_1 in |- *. intros. + elim (option_sum _ (MapSweep A (fun (a:ad) (_:A) => in_dom B a m') m)). intro H2. elim H2. + intro r. elim r. intros a' y' H3. rewrite H3 in H. discriminate H. + intro H2. unfold in_dom in H0. elim (option_sum _ (MapGet A m a)). intro H3. elim H3. + intros y H4. rewrite (MapSweep_semantics_3 _ _ _ H2 a y H4) in H1. discriminate H1. + intro H3. rewrite H3 in H0. discriminate H0. Qed. - Lemma MapDisjoint_imp_2 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m') -> - (MapDisjoint_2 m m'). + Lemma MapDisjoint_imp_2 : + forall (m:Map A) (m':Map B), MapDisjoint m m' -> MapDisjoint_2 m m'. Proof. - Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros. - Rewrite (MapDomRestrTo_semantics A B m m' a). - Cut (in_dom A a m)=true->(in_dom B a m')=true->False. Intro. - Elim (option_sum ? (MapGet A m a)). Intro H1. Elim H1. Intros y H2. Unfold 1 in_dom in H0. - Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3. Intros y' H4. Unfold 1 in_dom in H0. - Rewrite H4 in H0. Rewrite H2 in H0. Elim (H0 (refl_equal ? ?) (refl_equal ? ?)). - Intro H3. Rewrite H3. Reflexivity. - Intro H1. Rewrite H1. Case (MapGet B m' a); Reflexivity. - Exact (H a). + unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. + rewrite (MapDomRestrTo_semantics A B m m' a). + cut (in_dom A a m = true -> in_dom B a m' = true -> False). intro. + elim (option_sum _ (MapGet A m a)). intro H1. elim H1. intros y H2. unfold in_dom at 1 in H0. + elim (option_sum _ (MapGet B m' a)). intro H3. elim H3. intros y' H4. unfold in_dom at 1 in H0. + rewrite H4 in H0. rewrite H2 in H0. elim (H0 (refl_equal _) (refl_equal _)). + intro H3. rewrite H3. reflexivity. + intro H1. rewrite H1. case (MapGet B m' a); reflexivity. + exact (H a). Qed. - Lemma MapDisjoint_2_imp : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m') -> - (MapDisjoint m m'). + Lemma MapDisjoint_2_imp : + forall (m:Map A) (m':Map B), MapDisjoint_2 m m' -> MapDisjoint m m'. Proof. - Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros. Elim (in_dom_some ? ? ? H0). - Intros y H2. Elim (in_dom_some ? ? ? H1). Intros y' H3. - Cut (MapGet A (MapDomRestrTo A B m m') a)=(NONE A). Intro. - Rewrite (MapDomRestrTo_semantics ? ? m m' a) in H4. Rewrite H3 in H4. Rewrite H2 in H4. - Discriminate H4. - Exact (H a). + unfold MapDisjoint, MapDisjoint_2 in |- *. unfold eqmap, eqm in |- *. intros. elim (in_dom_some _ _ _ H0). + intros y H2. elim (in_dom_some _ _ _ H1). intros y' H3. + cut (MapGet A (MapDomRestrTo A B m m') a = NONE A). intro. + rewrite (MapDomRestrTo_semantics _ _ m m' a) in H4. rewrite H3 in H4. rewrite H2 in H4. + discriminate H4. + exact (H a). Qed. - Lemma Map_M0_disjoint : (m:(Map B)) (MapDisjoint (M0 A) m). + Lemma Map_M0_disjoint : forall m:Map B, MapDisjoint (M0 A) m. Proof. - Unfold MapDisjoint in_dom. Intros. Discriminate H. + unfold MapDisjoint, in_dom in |- *. intros. discriminate H. Qed. - Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)). + Lemma Map_disjoint_M0 : forall m:Map A, MapDisjoint m (M0 B). Proof. - Unfold MapDisjoint in_dom. Intros. Discriminate H0. + unfold MapDisjoint, in_dom in |- *. intros. discriminate H0. Qed. End MapDisjointDef. Section MapDisjointExtra. - Variable A, B : Set. + Variables A B : Set. - Lemma MapDisjoint_ext : (m0,m1:(Map A)) (m2,m3:(Map B)) - (eqmap A m0 m1) -> (eqmap B m2 m3) -> - (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3). + Lemma MapDisjoint_ext : + forall (m0 m1:Map A) (m2 m3:Map B), + eqmap A m0 m1 -> + eqmap B m2 m3 -> MapDisjoint A B m0 m2 -> MapDisjoint A B m1 m3. Proof. - Intros. Apply MapDisjoint_2_imp. Unfold MapDisjoint_2. - Apply eqmap_trans with m':=(MapDomRestrTo A B m0 m2). Apply eqmap_sym. Apply MapDomRestrTo_ext. - Assumption. - Assumption. - Exact (MapDisjoint_imp_2 ? ? ? ? H1). + intros. apply MapDisjoint_2_imp. unfold MapDisjoint_2 in |- *. + apply eqmap_trans with (m' := MapDomRestrTo A B m0 m2). apply eqmap_sym. apply MapDomRestrTo_ext. + assumption. + assumption. + exact (MapDisjoint_imp_2 _ _ _ _ H1). Qed. - Lemma MapMerge_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') -> - (a:ad) (in_dom A a (MapMerge A m m'))= - (orb (andb (in_dom A a m) (negb (in_dom A a m'))) - (andb (in_dom A a m') (negb (in_dom A a m)))). + Lemma MapMerge_disjoint : + forall m m':Map A, + MapDisjoint A A m m' -> + forall a:ad, + in_dom A a (MapMerge A m m') = + orb (andb (in_dom A a m) (negb (in_dom A a m'))) + (andb (in_dom A a m') (negb (in_dom A a m))). Proof. - Unfold MapDisjoint. Intros. Rewrite in_dom_merge. Elim (sumbool_of_bool (in_dom A a m)). - Intro H0. Rewrite H0. Elim (sumbool_of_bool (in_dom A a m')). Intro H1. Elim (H a H0 H1). - Intro H1. Rewrite H1. Reflexivity. - Intro H0. Rewrite H0. Simpl. Rewrite andb_b_true. Reflexivity. + unfold MapDisjoint in |- *. intros. rewrite in_dom_merge. elim (sumbool_of_bool (in_dom A a m)). + intro H0. rewrite H0. elim (sumbool_of_bool (in_dom A a m')). intro H1. elim (H a H0 H1). + intro H1. rewrite H1. reflexivity. + intro H0. rewrite H0. simpl in |- *. rewrite andb_b_true. reflexivity. Qed. - Lemma MapDisjoint_M2_l : (m0,m1:(Map A)) (m2,m3:(Map B)) - (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m0 m2). + Lemma MapDisjoint_M2_l : + forall (m0 m1:Map A) (m2 m3:Map B), + MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m0 m2. Proof. - Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m0 a)). Intro H2. - Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m2 a)). Intro H4. Elim H4. - Intros y' H5. Apply (H (ad_double a)). - Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m0 m1). - Rewrite (ad_double_div_2 a). Rewrite H3. Reflexivity. - Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m2 m3). - Rewrite (ad_double_div_2 a). Rewrite H5. Reflexivity. - Intro H4. Rewrite H4 in H1. Discriminate H1. - Intro H2. Rewrite H2 in H0. Discriminate H0. + unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m0 a)). intro H2. + elim H2. intros y H3. elim (option_sum _ (MapGet B m2 a)). intro H4. elim H4. + intros y' H5. apply (H (ad_double a)). + rewrite (MapGet_M2_bit_0_0 _ (ad_double a) (ad_double_bit_0 a) m0 m1). + rewrite (ad_double_div_2 a). rewrite H3. reflexivity. + rewrite (MapGet_M2_bit_0_0 _ (ad_double a) (ad_double_bit_0 a) m2 m3). + rewrite (ad_double_div_2 a). rewrite H5. reflexivity. + intro H4. rewrite H4 in H1. discriminate H1. + intro H2. rewrite H2 in H0. discriminate H0. Qed. - Lemma MapDisjoint_M2_r : (m0,m1:(Map A)) (m2,m3:(Map B)) - (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m1 m3). + Lemma MapDisjoint_M2_r : + forall (m0 m1:Map A) (m2 m3:Map B), + MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3) -> MapDisjoint A B m1 m3. Proof. - Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m1 a)). Intro H2. - Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m3 a)). Intro H4. Elim H4. - Intros y' H5. Apply (H (ad_double_plus_un a)). - Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1). - Rewrite (ad_double_plus_un_div_2 a). Rewrite H3. Reflexivity. - Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m2 m3). - Rewrite (ad_double_plus_un_div_2 a). Rewrite H5. Reflexivity. - Intro H4. Rewrite H4 in H1. Discriminate H1. - Intro H2. Rewrite H2 in H0. Discriminate H0. + unfold MapDisjoint, in_dom in |- *. intros. elim (option_sum _ (MapGet A m1 a)). intro H2. + elim H2. intros y H3. elim (option_sum _ (MapGet B m3 a)). intro H4. elim H4. + intros y' H5. apply (H (ad_double_plus_un a)). + rewrite + (MapGet_M2_bit_0_1 _ (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) + m0 m1). + rewrite (ad_double_plus_un_div_2 a). rewrite H3. reflexivity. + rewrite + (MapGet_M2_bit_0_1 _ (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) + m2 m3). + rewrite (ad_double_plus_un_div_2 a). rewrite H5. reflexivity. + intro H4. rewrite H4 in H1. discriminate H1. + intro H2. rewrite H2 in H0. discriminate H0. Qed. - Lemma MapDisjoint_M2 : (m0,m1:(Map A)) (m2,m3:(Map B)) - (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3) -> - (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)). + Lemma MapDisjoint_M2 : + forall (m0 m1:Map A) (m2 m3:Map B), + MapDisjoint A B m0 m2 -> + MapDisjoint A B m1 m3 -> MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3). Proof. - Unfold MapDisjoint in_dom. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3. - Rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1. - Rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. Exact (H0 (ad_div_2 a) H1 H2). - Intro H3. Rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1. - Rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. Exact (H (ad_div_2 a) H1 H2). + unfold MapDisjoint, in_dom in |- *. intros. elim (sumbool_of_bool (ad_bit_0 a)). intro H3. + rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1. + rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. exact (H0 (ad_div_2 a) H1 H2). + intro H3. rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1. + rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. exact (H (ad_div_2 a) H1 H2). Qed. - Lemma MapDisjoint_M1_l : (m:(Map A)) (a:ad) (y:B) - (MapDisjoint B A (M1 B a y) m) -> (in_dom A a m)=false. + Lemma MapDisjoint_M1_l : + forall (m:Map A) (a:ad) (y:B), + MapDisjoint B A (M1 B a y) m -> in_dom A a m = false. Proof. - Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0. - Elim (H a (in_dom_M1_1 B a y) H0). - Trivial. + unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0. + elim (H a (in_dom_M1_1 B a y) H0). + trivial. Qed. - Lemma MapDisjoint_M1_r : (m:(Map A)) (a:ad) (y:B) - (MapDisjoint A B m (M1 B a y)) -> (in_dom A a m)=false. + Lemma MapDisjoint_M1_r : + forall (m:Map A) (a:ad) (y:B), + MapDisjoint A B m (M1 B a y) -> in_dom A a m = false. Proof. - Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0. - Elim (H a H0 (in_dom_M1_1 B a y)). - Trivial. + unfold MapDisjoint in |- *. intros. elim (sumbool_of_bool (in_dom A a m)). intro H0. + elim (H a H0 (in_dom_M1_1 B a y)). + trivial. Qed. - Lemma MapDisjoint_M1_conv_l : (m:(Map A)) (a:ad) (y:B) - (in_dom A a m)=false -> (MapDisjoint B A (M1 B a y) m). + Lemma MapDisjoint_M1_conv_l : + forall (m:Map A) (a:ad) (y:B), + in_dom A a m = false -> MapDisjoint B A (M1 B a y) m. Proof. - Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H0) in H. Rewrite H1 in H. - Discriminate H. + unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H0) in H. rewrite H1 in H. + discriminate H. Qed. - Lemma MapDisjoint_M1_conv_r : (m:(Map A)) (a:ad) (y:B) - (in_dom A a m)=false -> (MapDisjoint A B m (M1 B a y)). + Lemma MapDisjoint_M1_conv_r : + forall (m:Map A) (a:ad) (y:B), + in_dom A a m = false -> MapDisjoint A B m (M1 B a y). Proof. - Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H1) in H. Rewrite H0 in H. - Discriminate H. + unfold MapDisjoint in |- *. intros. rewrite (in_dom_M1_2 B a a0 y H1) in H. rewrite H0 in H. + discriminate H. Qed. - Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B)) - (MapDisjoint A B m m') -> (MapDisjoint B A m' m). + Lemma MapDisjoint_sym : + forall (m:Map A) (m':Map B), MapDisjoint A B m m' -> MapDisjoint B A m' m. Proof. - Unfold MapDisjoint. Intros. Exact (H ? H1 H0). + unfold MapDisjoint in |- *. intros. exact (H _ H1 H0). Qed. - Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m) -> (eqmap A m (M0 A)). + Lemma MapDisjoint_empty : + forall m:Map A, MapDisjoint A A m m -> eqmap A m (M0 A). Proof. - Unfold eqmap eqm. Intros. Rewrite <- (MapDomRestrTo_idempotent A m a). - Exact (MapDisjoint_imp_2 A A m m H a). + unfold eqmap, eqm in |- *. intros. rewrite <- (MapDomRestrTo_idempotent A m a). + exact (MapDisjoint_imp_2 A A m m H a). Qed. - Lemma MapDelta_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') -> - (eqmap A (MapDelta A m m') (MapMerge A m m')). + Lemma MapDelta_disjoint : + forall m m':Map A, + MapDisjoint A A m m' -> eqmap A (MapDelta A m m') (MapMerge A m m'). Proof. - Intros. - Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). - Apply MapDelta_as_DomRestrBy. - Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (M0 A)). - Apply MapDomRestrBy_ext. Apply eqmap_refl. - Exact (MapDisjoint_imp_2 A A m m' H). - Apply MapDomRestrBy_m_empty. + intros. + apply eqmap_trans with + (m' := MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')). + apply MapDelta_as_DomRestrBy. + apply eqmap_trans with (m' := MapDomRestrBy A A (MapMerge A m m') (M0 A)). + apply MapDomRestrBy_ext. apply eqmap_refl. + exact (MapDisjoint_imp_2 A A m m' H). + apply MapDomRestrBy_m_empty. Qed. Variable C : Set. - Lemma MapDomRestr_disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m'')). + Lemma MapDomRestr_disjoint : + forall (m:Map A) (m':Map B) (m'':Map C), + MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m''). Proof. - Unfold MapDisjoint. Intros m m' m'' a. Rewrite in_dom_restrto. Rewrite in_dom_restrby. - Intros. Elim (andb_prop ? ? H). Elim (andb_prop ? ? H0). Intros. Rewrite H4 in H2. - Discriminate H2. + unfold MapDisjoint in |- *. intros m m' m'' a. rewrite in_dom_restrto. rewrite in_dom_restrby. + intros. elim (andb_prop _ _ H). elim (andb_prop _ _ H0). intros. rewrite H4 in H2. + discriminate H2. Qed. - Lemma MapDelta_RestrTo_disjoint : (m,m':(Map A)) - (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')). + Lemma MapDelta_RestrTo_disjoint : + forall m m':Map A, + MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m'). Proof. - Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto. - Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H. + unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto. + intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H. Qed. - Lemma MapDelta_RestrTo_disjoint_2 : (m,m':(Map A)) - (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)). + Lemma MapDelta_RestrTo_disjoint_2 : + forall m m':Map A, + MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m). Proof. - Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto. - Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H. + unfold MapDisjoint in |- *. intros m m' a. rewrite in_dom_delta. rewrite in_dom_restrto. + intros. elim (andb_prop _ _ H0). intros. rewrite H1 in H. rewrite H2 in H. discriminate H. Qed. Variable D : Set. - Lemma MapSubset_Disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D)) - (MapSubset ? ? m m') -> (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m' m''') -> - (MapDisjoint ? ? m m''). + Lemma MapSubset_Disjoint : + forall (m:Map A) (m':Map B) (m'':Map C) (m''':Map D), + MapSubset _ _ m m' -> + MapSubset _ _ m'' m''' -> + MapDisjoint _ _ m' m''' -> MapDisjoint _ _ m m''. Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H1 ? (H ? H2) (H0 ? H3)). + unfold MapSubset, MapDisjoint in |- *. intros. exact (H1 _ (H _ H2) (H0 _ H3)). Qed. - Lemma MapSubset_Disjoint_l : (m:(Map A)) (m':(Map B)) (m'':(Map C)) - (MapSubset ? ? m m') -> (MapDisjoint ? ? m' m'') -> - (MapDisjoint ? ? m m''). + Lemma MapSubset_Disjoint_l : + forall (m:Map A) (m':Map B) (m'':Map C), + MapSubset _ _ m m' -> MapDisjoint _ _ m' m'' -> MapDisjoint _ _ m m''. Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? (H ? H1) H2). + unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ (H _ H1) H2). Qed. - Lemma MapSubset_Disjoint_r : (m:(Map A)) (m'':(Map C)) (m''':(Map D)) - (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m m''') -> - (MapDisjoint ? ? m m''). + Lemma MapSubset_Disjoint_r : + forall (m:Map A) (m'':Map C) (m''':Map D), + MapSubset _ _ m'' m''' -> + MapDisjoint _ _ m m''' -> MapDisjoint _ _ m m''. Proof. - Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? H1 (H ? H2)). + unfold MapSubset, MapDisjoint in |- *. intros. exact (H0 _ H1 (H _ H2)). Qed. -End MapDisjointExtra. +End MapDisjointExtra.
\ No newline at end of file diff --git a/theories/Lists/List.v b/theories/Lists/List.v index 7e6cf4c88..1eb095c14 100755 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -8,254 +8,643 @@ (*i $Id$ i*) -(* This file is a copy of file MonoList.v *) +Require Import Le. -(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***) -Require Le. +Section Lists. -Parameter List_Dom:Set. -Definition A := List_Dom. +Variable A : Set. -Inductive list : Set := nil : list | cons : A -> list -> list. +Set Implicit Arguments. -Fixpoint app [l:list] : list -> list - := [m:list]<list>Cases l of - nil => m - | (cons a l1) => (cons a (app l1 m)) - end. +Inductive list : Set := + | nil : list + | cons : A -> list -> list. +Infix "::" := cons (at level 60, right associativity) : list_scope. -Lemma app_nil_end : (l:list)(l=(app l nil)). +Open Scope list_scope. + +(*************************) +(** Discrimination *) +(*************************) + +Lemma nil_cons : forall (a:A) (m:list), nil <> a :: m. Proof. - Intro l ; Elim l ; Simpl ; Auto. - Induction 1; Auto. + intros; discriminate. Qed. -Hints Resolve app_nil_end : list v62. -Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)). +(*************************) +(** Concatenation *) +(*************************) + +Fixpoint app (l m:list) {struct l} : list := + match l with + | nil => m + | a :: l1 => a :: app l1 m + end. + +Infix "++" := app (right associativity, at level 60) : list_scope. + +Lemma app_nil_end : forall l:list, l = l ++ nil. Proof. - Intros l m n ; Elim l ; Simpl ; Auto with list. - Induction 1; Auto with list. + induction l; simpl in |- *; auto. + rewrite <- IHl; auto. Qed. -Hints Resolve app_ass : list v62. +Hint Resolve app_nil_end. + +Ltac now_show c := change c in |- *. -Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n). +Lemma app_ass : forall l m n:list, (l ++ m) ++ n = l ++ m ++ n. Proof. - Auto with list. + intros. induction l; simpl in |- *; auto. + now_show (a :: (l ++ m) ++ n = a :: l ++ m ++ n). + rewrite <- IHl; auto. Qed. -Hints Resolve ass_app : list v62. +Hint Resolve app_ass. -Definition tail := - [l:list] <list>Cases l of (cons _ m) => m | _ => nil end : list->list. - +Lemma ass_app : forall l m n:list, l ++ m ++ n = (l ++ m) ++ n. +Proof. + auto. +Qed. +Hint Resolve ass_app. -Lemma nil_cons : (a:A)(m:list)~nil=(cons a m). - Intros; Discriminate. +Lemma app_comm_cons : forall (x y:list) (a:A), a :: x ++ y = (a :: x) ++ y. +Proof. + auto. Qed. +Lemma app_eq_nil : forall x y:list, x ++ y = nil -> x = nil /\ y = nil. +Proof. + destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; + simpl in |- *; auto. + intros H; discriminate H. + intros; discriminate H. +Qed. + +Lemma app_cons_not_nil : forall (x y:list) (a:A), nil <> x ++ a :: y. +Proof. +unfold not in |- *. + destruct x as [| a l]; simpl in |- *; intros. + discriminate H. + discriminate H. +Qed. + +Lemma app_eq_unit : + forall (x y:list) (a:A), + x ++ y = a :: nil -> x = nil /\ y = a :: nil \/ x = a :: nil /\ y = nil. + +Proof. + destruct x as [| a l]; [ destruct y as [| a l] | destruct y as [| a0 l0] ]; + simpl in |- *. + intros a H; discriminate H. + left; split; auto. + right; split; auto. + generalize H. + generalize (app_nil_end l); intros E. + rewrite <- E; auto. + intros. + injection H. + intro. + cut (nil = l ++ a0 :: l0); auto. + intro. + generalize (app_cons_not_nil _ _ _ H1); intro. + elim H2. +Qed. + +Lemma app_inj_tail : + forall (x y:list) (a b:A), x ++ a :: nil = y ++ b :: nil -> x = y /\ a = b. +Proof. + induction x as [| x l IHl]; + [ destruct y as [| a l] | destruct y as [| a l0] ]; + simpl in |- *; auto. + intros a b H. + injection H. + auto. + intros a0 b H. + injection H; intros. + generalize (app_cons_not_nil _ _ _ H0); destruct 1. + intros a b H. + injection H; intros. + cut (nil = l ++ a :: nil); auto. + intro. + generalize (app_cons_not_nil _ _ _ H2); destruct 1. + intros a0 b H. + injection H; intros. + destruct (IHl l0 a0 b H0). + split; auto. + rewrite <- H1; rewrite <- H2; reflexivity. +Qed. + +(*************************) +(** Head and tail *) +(*************************) + +Definition head (l:list) := + match l with + | nil => error + | x :: _ => value x + end. + +Definition tail (l:list) : list := + match l with + | nil => nil + | a :: m => m + end. + (****************************************) -(* Length of lists *) +(** Length of lists *) (****************************************) -Fixpoint length [l:list] : nat - := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end. +Fixpoint length (l:list) : nat := + match l with + | nil => 0 + | _ :: m => S (length m) + end. (******************************) -(* Length order of lists *) +(** Length order of lists *) (******************************) Section length_order. -Definition lel := [l,m:list](le (length l) (length m)). +Definition lel (l m:list) := length l <= length m. -Hints Unfold lel : list. +Variables a b : A. +Variables l m n : list. -Variables a,b:A. -Variables l,m,n:list. - -Lemma lel_refl : (lel l l). +Lemma lel_refl : lel l l. Proof. - Unfold lel ; Auto with list. + unfold lel in |- *; auto with arith. Qed. -Lemma lel_trans : (lel l m)->(lel m n)->(lel l n). +Lemma lel_trans : lel l m -> lel m n -> lel l n. Proof. - Unfold lel ; Intros. - Apply le_trans with (length m) ; Auto with list. + unfold lel in |- *; intros. + now_show (length l <= length n). + apply le_trans with (length m); auto with arith. Qed. -Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)). +Lemma lel_cons_cons : lel l m -> lel (a :: l) (b :: m). Proof. - Unfold lel ; Simpl ; Auto with list arith. + unfold lel in |- *; simpl in |- *; auto with arith. Qed. -Lemma lel_cons : (lel l m)->(lel l (cons b m)). +Lemma lel_cons : lel l m -> lel l (b :: m). Proof. - Unfold lel ; Simpl ; Auto with list arith. + unfold lel in |- *; simpl in |- *; auto with arith. Qed. -Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m). +Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m. Proof. - Unfold lel ; Simpl ; Auto with list arith. + unfold lel in |- *; simpl in |- *; auto with arith. Qed. -Lemma lel_nil : (l':list)(lel l' nil)->(nil=l'). +Lemma lel_nil : forall l':list, lel l' nil -> nil = l'. Proof. - Intro l' ; Elim l' ; Auto with list arith. - Intros a' y H H0. - (* <list>nil=(cons a' y) - ============================ - H0 : (lel (cons a' y) nil) - H : (lel y nil)->(<list>nil=y) - y : list - a' : A - l' : list *) - Absurd (le (S (length y)) O); Auto with list arith. + intro l'; elim l'; auto with arith. + intros a' y H H0. + now_show (nil = a' :: y). + absurd (S (length y) <= 0); auto with arith. Qed. End length_order. -Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62. +Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons. + +(*********************************) +(** The [In] predicate *) +(*********************************) + +Fixpoint In (a:A) (l:list) {struct l} : Prop := + match l with + | nil => False + | b :: m => b = a \/ In a m + end. + +Lemma in_eq : forall (a:A) (l:list), In a (a :: l). +Proof. + simpl in |- *; auto. +Qed. +Hint Resolve in_eq. + +Lemma in_cons : forall (a b:A) (l:list), In b l -> In b (a :: l). +Proof. + simpl in |- *; auto. +Qed. +Hint Resolve in_cons. + +Lemma in_nil : forall a:A, ~ In a nil. +Proof. + unfold not in |- *; intros a H; inversion_clear H. +Qed. + + +Lemma in_inv : forall (a b:A) (l:list), In b (a :: l) -> a = b \/ In b l. +Proof. + intros a b l H; inversion_clear H; auto. +Qed. + +Lemma In_dec : + (forall x y:A, {x = y} + {x <> y}) -> + forall (a:A) (l:list), {In a l} + {~ In a l}. + +Proof. + induction l as [| a0 l IHl]. + right; apply in_nil. + destruct (H a0 a); simpl in |- *; auto. + destruct IHl; simpl in |- *; auto. + right; unfold not in |- *; intros [Hc1| Hc2]; auto. +Qed. + +Lemma in_app_or : forall (l m:list) (a:A), In a (l ++ m) -> In a l \/ In a m. +Proof. + intros l m a. + elim l; simpl in |- *; auto. + intros a0 y H H0. + now_show ((a0 = a \/ In a y) \/ In a m). + elim H0; auto. + intro H1. + now_show ((a0 = a \/ In a y) \/ In a m). + elim (H H1); auto. +Qed. +Hint Immediate in_app_or. + +Lemma in_or_app : forall (l m:list) (a:A), In a l \/ In a m -> In a (l ++ m). +Proof. + intros l m a. + elim l; simpl in |- *; intro H. + now_show (In a m). + elim H; auto; intro H0. + now_show (In a m). + elim H0. (* subProof completed *) + intros y H0 H1. + now_show (H = a \/ In a (y ++ m)). + elim H1; auto 4. + intro H2. + now_show (H = a \/ In a (y ++ m)). + elim H2; auto. +Qed. +Hint Resolve in_or_app. + +(***************************) +(** Set inclusion on list *) +(***************************) -Fixpoint In [a:A;l:list] : Prop := - Cases l of - nil => False - | (cons b m) => (b=a)\/(In a m) - end. +Definition incl (l m:list) := forall a:A, In a l -> In a m. +Hint Unfold incl. -Lemma in_eq : (a:A)(l:list)(In a (cons a l)). +Lemma incl_refl : forall l:list, incl l l. Proof. - Simpl ; Auto with list. + auto. Qed. -Hints Resolve in_eq : list v62. +Hint Resolve incl_refl. -Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)). +Lemma incl_tl : forall (a:A) (l m:list), incl l m -> incl l (a :: m). Proof. - Simpl ; Auto with list. + auto. Qed. -Hints Resolve in_cons : list v62. +Hint Immediate incl_tl. -Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)). +Lemma incl_tran : forall l m n:list, incl l m -> incl m n -> incl l n. Proof. - Intros l m a. - Elim l ; Simpl ; Auto with list. - Intros a0 y H H0. - (* ((<A>a0=a)\/(In a y))\/(In a m) - ============================ - H0 : (<A>a0=a)\/(In a (app y m)) - H : (In a (app y m))->((In a y)\/(In a m)) - y : list - a0 : A - a : A - m : list - l : list *) - Elim H0 ; Auto with list. - Intro H1. - (* ((<A>a0=a)\/(In a y))\/(In a m) - ============================ - H1 : (In a (app y m)) *) - Elim (H H1) ; Auto with list. -Qed. -Hints Immediate in_app_or : list v62. - -Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)). + auto. +Qed. + +Lemma incl_appl : forall l m n:list, incl l n -> incl l (n ++ m). Proof. - Intros l m a. - Elim l ; Simpl ; Intro H. - (* 1 (In a m) - ============================ - H : False\/(In a m) - a : A - m : list - l : list *) - Elim H ; Auto with list ; Intro H0. - (* (In a m) - ============================ - H0 : False *) - Elim H0. (* subProof completed *) - Intros y H0 H1. - (* 2 (<A>H=a)\/(In a (app y m)) - ============================ - H1 : ((<A>H=a)\/(In a y))\/(In a m) - H0 : ((In a y)\/(In a m))->(In a (app y m)) - y : list *) - Elim H1 ; Auto 4 with list. - Intro H2. - (* (<A>H=a)\/(In a (app y m)) - ============================ - H2 : (<A>H=a)\/(In a y) *) - Elim H2 ; Auto with list. -Qed. -Hints Resolve in_or_app : list v62. - -Definition incl := [l,m:list](a:A)(In a l)->(In a m). - -Hints Unfold incl : list v62. - -Lemma incl_refl : (l:list)(incl l l). + auto. +Qed. +Hint Immediate incl_appl. + +Lemma incl_appr : forall l m n:list, incl l n -> incl l (m ++ n). Proof. - Auto with list. + auto. Qed. -Hints Resolve incl_refl : list v62. +Hint Immediate incl_appr. -Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)). +Lemma incl_cons : + forall (a:A) (l m:list), In a m -> incl l m -> incl (a :: l) m. Proof. - Auto with list. + unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1. + now_show (In a0 m). + elim H1. + now_show (a = a0 -> In a0 m). + elim H1; auto; intro H2. + now_show (a = a0 -> In a0 m). + elim H2; auto. (* solves subgoal *) + now_show (In a0 l -> In a0 m). + auto. Qed. -Hints Immediate incl_tl : list v62. +Hint Resolve incl_cons. -Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n). +Lemma incl_app : forall l m n:list, incl l n -> incl m n -> incl (l ++ m) n. Proof. - Auto with list. + unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1. + now_show (In a n). + elim (in_app_or _ _ _ H1); auto. +Qed. +Hint Resolve incl_app. + +(**************************) +(** Nth element of a list *) +(**************************) + +Fixpoint nth (n:nat) (l:list) (default:A) {struct l} : A := + match n, l with + | O, x :: l' => x + | O, other => default + | S m, nil => default + | S m, x :: t => nth m t default + end. + +Fixpoint nth_ok (n:nat) (l:list) (default:A) {struct l} : bool := + match n, l with + | O, x :: l' => true + | O, other => false + | S m, nil => false + | S m, x :: t => nth_ok m t default + end. + +Lemma nth_in_or_default : + forall (n:nat) (l:list) (d:A), {In (nth n l d) l} + {nth n l d = d}. +(* Realizer nth_ok. Program_all. *) +Proof. + intros n l d; generalize n; induction l; intro n0. + right; case n0; trivial. + case n0; simpl in |- *. + auto. + intro n1; elim (IHl n1); auto. Qed. -Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)). +Lemma nth_S_cons : + forall (n:nat) (l:list) (d a:A), + In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l). Proof. - Auto with list. + simpl in |- *; auto. +Qed. + +Fixpoint nth_error (l:list) (n:nat) {struct n} : Exc A := + match n, l with + | O, x :: _ => value x + | S n, _ :: l => nth_error l n + | _, _ => error + end. + +Definition nth_default (default:A) (l:list) (n:nat) : A := + match nth_error l n with + | Some x => x + | None => default + end. + +Lemma nth_In : + forall (n:nat) (l:list) (d:A), n < length l -> In (nth n l d) l. + +Proof. +unfold lt in |- *; induction n as [| n hn]; simpl in |- *. +destruct l; simpl in |- *; [ inversion 2 | auto ]. +destruct l as [| a l hl]; simpl in |- *. +inversion 2. +intros d ie; right; apply hn; auto with arith. +Qed. + +(********************************) +(** Decidable equality on lists *) +(********************************) + + +Lemma list_eq_dec : + (forall x y:A, {x = y} + {x <> y}) -> forall x y:list, {x = y} + {x <> y}. +Proof. + induction x as [| a l IHl]; destruct y as [| a0 l0]; auto. + destruct (H a a0) as [e| e]. + destruct (IHl l0) as [e'| e']. + left; rewrite e; rewrite e'; trivial. + right; red in |- *; intro. + apply e'; injection H0; trivial. + right; red in |- *; intro. + apply e; injection H0; trivial. +Qed. + +(*************************) +(** Reverse *) +(*************************) + +Fixpoint rev (l:list) : list := + match l with + | nil => nil + | x :: l' => rev l' ++ x :: nil + end. + +Lemma distr_rev : forall x y:list, rev (x ++ y) = rev y ++ rev x. +Proof. + induction x as [| a l IHl]. + destruct y as [| a l]. + simpl in |- *. + auto. + + simpl in |- *. + apply app_nil_end; auto. + + intro y. + simpl in |- *. + rewrite (IHl y). + apply (app_ass (rev y) (rev l) (a :: nil)). +Qed. + +Remark rev_unit : forall (l:list) (a:A), rev (l ++ a :: nil) = a :: rev l. +Proof. + intros. + apply (distr_rev l (a :: nil)); simpl in |- *; auto. +Qed. + +Lemma rev_involutive : forall l:list, rev (rev l) = l. +Proof. + induction l as [| a l IHl]. + simpl in |- *; auto. + + simpl in |- *. + rewrite (rev_unit (rev l) a). + rewrite IHl; auto. +Qed. + +(*********************************************) +(** Reverse Induction Principle on Lists *) +(*********************************************) + +Section Reverse_Induction. + +Unset Implicit Arguments. + +Remark rev_list_ind : + forall P:list -> Prop, + P nil -> + (forall (a:A) (l:list), P (rev l) -> P (rev (a :: l))) -> + forall l:list, P (rev l). +Proof. + induction l; auto. +Qed. +Set Implicit Arguments. + +Lemma rev_ind : + forall P:list -> Prop, + P nil -> + (forall (x:A) (l:list), P l -> P (l ++ x :: nil)) -> forall l:list, P l. +Proof. + intros. + generalize (rev_involutive l). + intros E; rewrite <- E. + apply (rev_list_ind P). + auto. + + simpl in |- *. + intros. + apply (H0 a (rev l0)). + auto. Qed. -Hints Immediate incl_appl : list v62. -Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)). +End Reverse_Induction. + +End Lists. + +Implicit Arguments nil [A]. + +Hint Resolve nil_cons app_nil_end ass_app app_ass: datatypes v62. +Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62. +Hint Immediate app_eq_nil: datatypes v62. +Hint Resolve app_eq_unit app_inj_tail: datatypes v62. +Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: + datatypes v62. +Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes v62. +Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons + incl_app: datatypes v62. + +Section Functions_on_lists. + +(****************************************************************) +(** Some generic functions on lists and basic functions of them *) +(****************************************************************) + +Section Map. +Variables A B : Set. +Variable f : A -> B. +Fixpoint map (l:list A) : list B := + match l with + | nil => nil + | cons a t => cons (f a) (map t) + end. +End Map. + +Lemma in_map : + forall (A B:Set) (f:A -> B) (l:list A) (x:A), In x l -> In (f x) (map f l). Proof. - Auto with list. + induction l as [| a l IHl]; simpl in |- *; + [ auto + | destruct 1; [ left; apply f_equal with (f := f); assumption | auto ] ]. Qed. -Hints Immediate incl_appr : list v62. -Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m). +Fixpoint flat_map (A B:Set) (f:A -> list B) (l:list A) {struct l} : + list B := + match l with + | nil => nil + | cons x t => app (f x) (flat_map f t) + end. + +Fixpoint list_prod (A B:Set) (l:list A) (l':list B) {struct l} : + list (A * B) := + match l with + | nil => nil + | cons x t => app (map (fun y:B => (x, y)) l') (list_prod t l') + end. + +Lemma in_prod_aux : + forall (A B:Set) (x:A) (y:B) (l:list B), + In y l -> In (x, y) (map (fun y0:B => (x, y0)) l). Proof. - Unfold incl ; Simpl ; Intros a l m H H0 a0 H1. - (* (In a0 m) - ============================ - H1 : (<A>a=a0)\/(In a0 l) - a0 : A - H0 : (a:A)(In a l)->(In a m) - H : (In a m) - m : list - l : list - a : A *) - Elim H1. - (* 1 (<A>a=a0)->(In a0 m) *) - Elim H1 ; Auto with list ; Intro H2. - (* (<A>a=a0)->(In a0 m) - ============================ - H2 : <A>a=a0 *) - Elim H2 ; Auto with list. (* solves subgoal *) - (* 2 (In a0 l)->(In a0 m) *) - Auto with list. -Qed. -Hints Resolve incl_cons : list v62. - -Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n). + induction l; + [ simpl in |- *; auto + | simpl in |- *; destruct 1 as [H1| ]; + [ left; rewrite H1; trivial | right; auto ] ]. +Qed. + +Lemma in_prod : + forall (A B:Set) (l:list A) (l':list B) (x:A) (y:B), + In x l -> In y l' -> In (x, y) (list_prod l l'). Proof. - Unfold incl ; Simpl ; Intros l m n H H0 a H1. - (* (In a n) - ============================ - H1 : (In a (app l m)) - a : A - H0 : (a:A)(In a m)->(In a n) - H : (a:A)(In a l)->(In a n) - n : list - m : list - l : list *) - Elim (in_app_or l m a) ; Auto with list. -Qed. -Hints Resolve incl_app : list v62. + induction l; + [ simpl in |- *; tauto + | simpl in |- *; intros; apply in_or_app; destruct H; + [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ]. +Qed. + +(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y] + indexed by elts of [x], sorted in lexicographic order. *) + +Fixpoint list_power (A B:Set) (l:list A) (l':list B) {struct l} : + list (list (A * B)) := + match l with + | nil => cons nil nil + | cons x t => + flat_map (fun f:list (A * B) => map (fun y:B => cons (x, y) f) l') + (list_power t l') + end. + +(************************************) +(** Left-to-right iterator on lists *) +(************************************) + +Section Fold_Left_Recursor. +Variables A B : Set. +Variable f : A -> B -> A. +Fixpoint fold_left (l:list B) (a0:A) {struct l} : A := + match l with + | nil => a0 + | cons b t => fold_left t (f a0 b) + end. +End Fold_Left_Recursor. + +(************************************) +(** Right-to-left iterator on lists *) +(************************************) + +Section Fold_Right_Recursor. +Variables A B : Set. +Variable f : B -> A -> A. +Variable a0 : A. +Fixpoint fold_right (l:list B) : A := + match l with + | nil => a0 + | cons b t => f b (fold_right t) + end. +End Fold_Right_Recursor. + +Theorem fold_symmetric : + forall (A:Set) (f:A -> A -> A), + (forall x y z:A, f x (f y z) = f (f x y) z) -> + (forall x y:A, f x y = f y x) -> + forall (a0:A) (l:list A), fold_left f l a0 = fold_right f a0 l. +Proof. +destruct l as [| a l]. +reflexivity. +simpl in |- *. +rewrite <- H0. +generalize a0 a. +induction l as [| a3 l IHl]; simpl in |- *. +trivial. +intros. +rewrite H. +rewrite (H0 a2). +rewrite <- (H a1). +rewrite (H0 a1). +rewrite IHl. +reflexivity. +Qed. + +End Functions_on_lists. + + +(** Exporting list notations *) + +Infix "::" := cons (at level 60, right associativity) : list_scope. + +Infix "++" := app (right associativity, at level 60) : list_scope. + +Open Scope list_scope.
\ No newline at end of file diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v index 4b7083c0a..f2fb20f72 100644 --- a/theories/Lists/ListSet.v +++ b/theories/Lists/ListSet.v @@ -16,374 +16,383 @@ This allow to "hide" the definitions, functions and theorems of PolyList and to see only the ones of ListSet *) -Require PolyList. +Require Import List. Set Implicit Arguments. -V7only [Implicits nil [1].]. Section first_definitions. Variable A : Set. - Hypothesis Aeq_dec : (x,y:A){x=y}+{~x=y}. + Hypothesis Aeq_dec : forall x y:A, {x = y} + {x <> y}. - Definition set := (list A). + Definition set := list A. - Definition empty_set := (!nil ?) : set. + Definition empty_set : set := nil. - Fixpoint set_add [a:A; x:set] : set := - Cases x of - | nil => (cons a nil) - | (cons a1 x1) => Cases (Aeq_dec a a1) of - | (left _) => (cons a1 x1) - | (right _) => (cons a1 (set_add a x1)) - end + Fixpoint set_add (a:A) (x:set) {struct x} : set := + match x with + | nil => a :: nil + | a1 :: x1 => + match Aeq_dec a a1 with + | left _ => a1 :: x1 + | right _ => a1 :: set_add a x1 + end end. - Fixpoint set_mem [a:A; x:set] : bool := - Cases x of + Fixpoint set_mem (a:A) (x:set) {struct x} : bool := + match x with | nil => false - | (cons a1 x1) => Cases (Aeq_dec a a1) of - | (left _) => true - | (right _) => (set_mem a x1) - end + | a1 :: x1 => + match Aeq_dec a a1 with + | left _ => true + | right _ => set_mem a x1 + end end. (** If [a] belongs to [x], removes [a] from [x]. If not, does nothing *) - Fixpoint set_remove [a:A; x:set] : set := - Cases x of + Fixpoint set_remove (a:A) (x:set) {struct x} : set := + match x with | nil => empty_set - | (cons a1 x1) => Cases (Aeq_dec a a1) of - | (left _) => x1 - | (right _) => (cons a1 (set_remove a x1)) - end + | a1 :: x1 => + match Aeq_dec a a1 with + | left _ => x1 + | right _ => a1 :: set_remove a x1 + end end. - Fixpoint set_inter [x:set] : set -> set := - Cases x of - | nil => [y]nil - | (cons a1 x1) => [y]if (set_mem a1 y) - then (cons a1 (set_inter x1 y)) - else (set_inter x1 y) + Fixpoint set_inter (x:set) : set -> set := + match x with + | nil => fun y => nil + | a1 :: x1 => + fun y => + if set_mem a1 y then a1 :: set_inter x1 y else set_inter x1 y end. - Fixpoint set_union [x,y:set] : set := - Cases y of + Fixpoint set_union (x y:set) {struct y} : set := + match y with | nil => x - | (cons a1 y1) => (set_add a1 (set_union x y1)) + | a1 :: y1 => set_add a1 (set_union x y1) end. (** returns the set of all els of [x] that does not belong to [y] *) - Fixpoint set_diff [x:set] : set -> set := - [y]Cases x of + Fixpoint set_diff (x y:set) {struct x} : set := + match x with | nil => nil - | (cons a1 x1) => if (set_mem a1 y) - then (set_diff x1 y) - else (set_add a1 (set_diff x1 y)) + | a1 :: x1 => + if set_mem a1 y then set_diff x1 y else set_add a1 (set_diff x1 y) end. - Definition set_In : A -> set -> Prop := (In 1!A). + Definition set_In : A -> set -> Prop := In (A:=A). - Lemma set_In_dec : (a:A; x:set){(set_In a x)}+{~(set_In a x)}. + Lemma set_In_dec : forall (a:A) (x:set), {set_In a x} + {~ set_In a x}. Proof. - Unfold set_In. + unfold set_In in |- *. (*** Realizer set_mem. Program_all. ***) - Induction x. - Auto. - Intros a0 x0 Ha0. Case (Aeq_dec a a0); Intro eq. - Rewrite eq; Simpl; Auto with datatypes. - Elim Ha0. - Auto with datatypes. - Right; Simpl; Unfold not; Intros [Hc1 | Hc2 ]; Auto with datatypes. + simple induction x. + auto. + intros a0 x0 Ha0. case (Aeq_dec a a0); intro eq. + rewrite eq; simpl in |- *; auto with datatypes. + elim Ha0. + auto with datatypes. + right; simpl in |- *; unfold not in |- *; intros [Hc1| Hc2]; + auto with datatypes. Qed. - Lemma set_mem_ind : - (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set) - ((set_In a x) -> (P y)) - ->(P z) - ->(P (if (set_mem a x) then y else z)). + Lemma set_mem_ind : + forall (B:Set) (P:B -> Prop) (y z:B) (a:A) (x:set), + (set_In a x -> P y) -> P z -> P (if set_mem a x then y else z). Proof. - Induction x; Simpl; Intros. - Assumption. - Elim (Aeq_dec a a0); Auto with datatypes. + simple induction x; simpl in |- *; intros. + assumption. + elim (Aeq_dec a a0); auto with datatypes. Qed. - Lemma set_mem_ind2 : - (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set) - ((set_In a x) -> (P y)) - ->(~(set_In a x) -> (P z)) - ->(P (if (set_mem a x) then y else z)). + Lemma set_mem_ind2 : + forall (B:Set) (P:B -> Prop) (y z:B) (a:A) (x:set), + (set_In a x -> P y) -> + (~ set_In a x -> P z) -> P (if set_mem a x then y else z). Proof. - Induction x; Simpl; Intros. - Apply H0; Red; Trivial. - Case (Aeq_dec a a0); Auto with datatypes. - Intro; Apply H; Intros; Auto. - Apply H1; Red; Intro. - Case H3; Auto. + simple induction x; simpl in |- *; intros. + apply H0; red in |- *; trivial. + case (Aeq_dec a a0); auto with datatypes. + intro; apply H; intros; auto. + apply H1; red in |- *; intro. + case H3; auto. Qed. Lemma set_mem_correct1 : - (a:A)(x:set)(set_mem a x)=true -> (set_In a x). + forall (a:A) (x:set), set_mem a x = true -> set_In a x. Proof. - Induction x; Simpl. - Discriminate. - Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes. + simple induction x; simpl in |- *. + discriminate. + intros a0 l; elim (Aeq_dec a a0); auto with datatypes. Qed. Lemma set_mem_correct2 : - (a:A)(x:set)(set_In a x) -> (set_mem a x)=true. + forall (a:A) (x:set), set_In a x -> set_mem a x = true. Proof. - Induction x; Simpl. - Intro Ha; Elim Ha. - Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes. - Intros H1 H2 [H3 | H4]. - Absurd a0=a; Auto with datatypes. - Auto with datatypes. + simple induction x; simpl in |- *. + intro Ha; elim Ha. + intros a0 l; elim (Aeq_dec a a0); auto with datatypes. + intros H1 H2 [H3| H4]. + absurd (a0 = a); auto with datatypes. + auto with datatypes. Qed. Lemma set_mem_complete1 : - (a:A)(x:set)(set_mem a x)=false -> ~(set_In a x). + forall (a:A) (x:set), set_mem a x = false -> ~ set_In a x. Proof. - Induction x; Simpl. - Tauto. - Intros a0 l; Elim (Aeq_dec a a0). - Intros; Discriminate H0. - Unfold not; Intros; Elim H1; Auto with datatypes. + simple induction x; simpl in |- *. + tauto. + intros a0 l; elim (Aeq_dec a a0). + intros; discriminate H0. + unfold not in |- *; intros; elim H1; auto with datatypes. Qed. Lemma set_mem_complete2 : - (a:A)(x:set)~(set_In a x) -> (set_mem a x)=false. + forall (a:A) (x:set), ~ set_In a x -> set_mem a x = false. Proof. - Induction x; Simpl. - Tauto. - Intros a0 l; Elim (Aeq_dec a a0). - Intros; Elim H0; Auto with datatypes. - Tauto. + simple induction x; simpl in |- *. + tauto. + intros a0 l; elim (Aeq_dec a a0). + intros; elim H0; auto with datatypes. + tauto. Qed. - Lemma set_add_intro1 : (a,b:A)(x:set) - (set_In a x) -> (set_In a (set_add b x)). + Lemma set_add_intro1 : + forall (a b:A) (x:set), set_In a x -> set_In a (set_add b x). Proof. - Unfold set_In; Induction x; Simpl. - Auto with datatypes. - Intros a0 l H [ Ha0a | Hal ]. - Elim (Aeq_dec b a0); Left; Assumption. - Elim (Aeq_dec b a0); Right; [ Assumption | Auto with datatypes ]. + unfold set_In in |- *; simple induction x; simpl in |- *. + auto with datatypes. + intros a0 l H [Ha0a| Hal]. + elim (Aeq_dec b a0); left; assumption. + elim (Aeq_dec b a0); right; [ assumption | auto with datatypes ]. Qed. - Lemma set_add_intro2 : (a,b:A)(x:set) - a=b -> (set_In a (set_add b x)). + Lemma set_add_intro2 : + forall (a b:A) (x:set), a = b -> set_In a (set_add b x). Proof. - Unfold set_In; Induction x; Simpl. - Auto with datatypes. - Intros a0 l H Hab. - Elim (Aeq_dec b a0); - [ Rewrite Hab; Intro Hba0; Rewrite Hba0; Simpl; Auto with datatypes - | Auto with datatypes ]. + unfold set_In in |- *; simple induction x; simpl in |- *. + auto with datatypes. + intros a0 l H Hab. + elim (Aeq_dec b a0); + [ rewrite Hab; intro Hba0; rewrite Hba0; simpl in |- *; + auto with datatypes + | auto with datatypes ]. Qed. - Hints Resolve set_add_intro1 set_add_intro2. + Hint Resolve set_add_intro1 set_add_intro2. - Lemma set_add_intro : (a,b:A)(x:set) - a=b\/(set_In a x) -> (set_In a (set_add b x)). + Lemma set_add_intro : + forall (a b:A) (x:set), a = b \/ set_In a x -> set_In a (set_add b x). Proof. - Intros a b x [H1 | H2] ; Auto with datatypes. + intros a b x [H1| H2]; auto with datatypes. Qed. - Lemma set_add_elim : (a,b:A)(x:set) - (set_In a (set_add b x)) -> a=b\/(set_In a x). + Lemma set_add_elim : + forall (a b:A) (x:set), set_In a (set_add b x) -> a = b \/ set_In a x. Proof. - Unfold set_In. - Induction x. - Simpl; Intros [H1|H2]; Auto with datatypes. - Simpl; Do 3 Intro. - Elim (Aeq_dec b a0). - Simpl; Tauto. - Simpl; Intros; Elim H0. - Trivial with datatypes. - Tauto. - Tauto. + unfold set_In in |- *. + simple induction x. + simpl in |- *; intros [H1| H2]; auto with datatypes. + simpl in |- *; do 3 intro. + elim (Aeq_dec b a0). + simpl in |- *; tauto. + simpl in |- *; intros; elim H0. + trivial with datatypes. + tauto. + tauto. Qed. - Lemma set_add_elim2 : (a,b:A)(x:set) - (set_In a (set_add b x)) -> ~(a=b) -> (set_In a x). - Intros a b x H; Case (set_add_elim H); Intros; Trivial. - Case H1; Trivial. + Lemma set_add_elim2 : + forall (a b:A) (x:set), set_In a (set_add b x) -> a <> b -> set_In a x. + intros a b x H; case (set_add_elim _ _ _ H); intros; trivial. + case H1; trivial. Qed. - Hints Resolve set_add_intro set_add_elim set_add_elim2. + Hint Resolve set_add_intro set_add_elim set_add_elim2. - Lemma set_add_not_empty : (a:A)(x:set)~(set_add a x)=empty_set. + Lemma set_add_not_empty : forall (a:A) (x:set), set_add a x <> empty_set. Proof. - Induction x; Simpl. - Discriminate. - Intros; Elim (Aeq_dec a a0); Intros; Discriminate. + simple induction x; simpl in |- *. + discriminate. + intros; elim (Aeq_dec a a0); intros; discriminate. Qed. - Lemma set_union_intro1 : (a:A)(x,y:set) - (set_In a x) -> (set_In a (set_union x y)). + Lemma set_union_intro1 : + forall (a:A) (x y:set), set_In a x -> set_In a (set_union x y). Proof. - Induction y; Simpl; Auto with datatypes. + simple induction y; simpl in |- *; auto with datatypes. Qed. - Lemma set_union_intro2 : (a:A)(x,y:set) - (set_In a y) -> (set_In a (set_union x y)). + Lemma set_union_intro2 : + forall (a:A) (x y:set), set_In a y -> set_In a (set_union x y). Proof. - Induction y; Simpl. - Tauto. - Intros; Elim H0; Auto with datatypes. + simple induction y; simpl in |- *. + tauto. + intros; elim H0; auto with datatypes. Qed. - Hints Resolve set_union_intro2 set_union_intro1. + Hint Resolve set_union_intro2 set_union_intro1. - Lemma set_union_intro : (a:A)(x,y:set) - (set_In a x)\/(set_In a y) -> (set_In a (set_union x y)). + Lemma set_union_intro : + forall (a:A) (x y:set), + set_In a x \/ set_In a y -> set_In a (set_union x y). Proof. - Intros; Elim H; Auto with datatypes. + intros; elim H; auto with datatypes. Qed. - Lemma set_union_elim : (a:A)(x,y:set) - (set_In a (set_union x y)) -> (set_In a x)\/(set_In a y). + Lemma set_union_elim : + forall (a:A) (x y:set), + set_In a (set_union x y) -> set_In a x \/ set_In a y. Proof. - Induction y; Simpl. - Auto with datatypes. - Intros. - Generalize (set_add_elim H0). - Intros [H1 | H1]. - Auto with datatypes. - Tauto. + simple induction y; simpl in |- *. + auto with datatypes. + intros. + generalize (set_add_elim _ _ _ H0). + intros [H1| H1]. + auto with datatypes. + tauto. Qed. - Lemma set_union_emptyL : (a:A)(x:set)(set_In a (set_union empty_set x)) -> (set_In a x). - Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction. + Lemma set_union_emptyL : + forall (a:A) (x:set), set_In a (set_union empty_set x) -> set_In a x. + intros a x H; case (set_union_elim _ _ _ H); auto || contradiction. Qed. - Lemma set_union_emptyR : (a:A)(x:set)(set_In a (set_union x empty_set)) -> (set_In a x). - Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction. + Lemma set_union_emptyR : + forall (a:A) (x:set), set_In a (set_union x empty_set) -> set_In a x. + intros a x H; case (set_union_elim _ _ _ H); auto || contradiction. Qed. - Lemma set_inter_intro : (a:A)(x,y:set) - (set_In a x) -> (set_In a y) -> (set_In a (set_inter x y)). + Lemma set_inter_intro : + forall (a:A) (x y:set), + set_In a x -> set_In a y -> set_In a (set_inter x y). Proof. - Induction x. - Auto with datatypes. - 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; Intros. - Auto with datatypes. - Absurd (set_In a y); Auto with datatypes. - Elim (set_mem a0 y); [ Right; Auto with datatypes | Auto with datatypes]. + simple induction x. + auto with datatypes. + simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hy. + simpl in |- *; rewrite Ha0a. + generalize (set_mem_correct1 a y). + generalize (set_mem_complete1 a y). + elim (set_mem a y); simpl in |- *; intros. + auto with datatypes. + absurd (set_In a y); auto with datatypes. + elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ]. Qed. - Lemma set_inter_elim1 : (a:A)(x,y:set) - (set_In a (set_inter x y)) -> (set_In a x). + Lemma set_inter_elim1 : + forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a x. Proof. - Induction x. - Auto with datatypes. - Simpl; Intros a0 l Hrec y. - Generalize (!set_mem_correct1 a0 y). - Elim (set_mem a0 y); Simpl; Intros. - Elim H0; EAuto with datatypes. - EAuto with datatypes. + simple induction x. + auto with datatypes. + simpl in |- *; intros a0 l Hrec y. + generalize (set_mem_correct1 a0 y). + elim (set_mem a0 y); simpl in |- *; intros. + elim H0; eauto with datatypes. + eauto with datatypes. Qed. - Lemma set_inter_elim2 : (a:A)(x,y:set) - (set_In a (set_inter x y)) -> (set_In a y). + Lemma set_inter_elim2 : + forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a y. Proof. - Induction x. - Simpl; Tauto. - Simpl; Intros a0 l Hrec y. - Generalize (!set_mem_correct1 a0 y). - Elim (set_mem a0 y); Simpl; Intros. - Elim H0; [ Intro Hr; Rewrite <- Hr; EAuto with datatypes | EAuto with datatypes ] . - EAuto with datatypes. + simple induction x. + simpl in |- *; tauto. + simpl in |- *; intros a0 l Hrec y. + generalize (set_mem_correct1 a0 y). + elim (set_mem a0 y); simpl in |- *; intros. + elim H0; + [ intro Hr; rewrite <- Hr; eauto with datatypes | eauto with datatypes ]. + eauto with datatypes. Qed. - Hints Resolve set_inter_elim1 set_inter_elim2. + Hint Resolve set_inter_elim1 set_inter_elim2. - Lemma set_inter_elim : (a:A)(x,y:set) - (set_In a (set_inter x y)) -> (set_In a x)/\(set_In a y). + Lemma set_inter_elim : + forall (a:A) (x y:set), + set_In a (set_inter x y) -> set_In a x /\ set_In a y. Proof. - EAuto with datatypes. + eauto with datatypes. Qed. - Lemma set_diff_intro : (a:A)(x,y:set) - (set_In a x) -> ~(set_In a y) -> (set_In a (set_diff x y)). + Lemma set_diff_intro : + forall (a:A) (x y:set), + set_In a x -> ~ set_In a y -> set_In a (set_diff x y). Proof. - Induction x. - 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 ]. - Elim (set_mem a0 y); Auto with datatypes. + simple induction x. + simpl in |- *; tauto. + simpl in |- *; 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 ]. + elim (set_mem a0 y); auto with datatypes. Qed. - Lemma set_diff_elim1 : (a:A)(x,y:set) - (set_In a (set_diff x y)) -> (set_In a x). + Lemma set_diff_elim1 : + forall (a:A) (x y:set), set_In a (set_diff x y) -> set_In a x. Proof. - Induction x. - 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. + simple induction x. + simpl in |- *; tauto. + simpl in |- *; 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. Qed. - Lemma set_diff_elim2 : (a:A)(x,y:set) - (set_In a (set_diff x y)) -> ~(set_In a y). - Intros a x y; Elim x; Simpl. - Intros; Contradiction. - Intros a0 l Hrec. - Apply set_mem_ind2; Auto. - Intros H1 H2; Case (set_add_elim H2); Intros; Auto. - Rewrite H; Trivial. + 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; contradiction. + intros a0 l Hrec. + apply set_mem_ind2; auto. + intros H1 H2; case (set_add_elim _ _ _ H2); intros; auto. + rewrite H; trivial. Qed. - Lemma set_diff_trivial : (a:A)(x:set)~(set_In a (set_diff x x)). - Red; Intros a x H. - Apply (set_diff_elim2 H). - Apply (set_diff_elim1 H). + Lemma set_diff_trivial : forall (a:A) (x:set), ~ set_In a (set_diff x x). + red in |- *; intros a x H. + apply (set_diff_elim2 _ _ _ H). + apply (set_diff_elim1 _ _ _ H). Qed. -Hints Resolve set_diff_intro set_diff_trivial. +Hint Resolve set_diff_intro set_diff_trivial. End first_definitions. Section other_definitions. - Variables A,B : Set. + Variables A B : Set. - Definition set_prod : (set A) -> (set B) -> (set A*B) := (list_prod 1!A 2!B). + Definition set_prod : set A -> set B -> set (A * B) := + list_prod (A:=A) (B:=B). (** [B^A], set of applications from [A] to [B] *) - Definition set_power : (set A) -> (set B) -> (set (set A*B)) := - (list_power 1!A 2!B). + Definition set_power : set A -> set B -> set (set (A * B)) := + list_power (A:=A) (B:=B). - Definition set_map : (A->B) -> (set A) -> (set B) := (map 1!A 2!B). + Definition set_map : (A -> B) -> set A -> set B := map (A:=A) (B:=B). - Definition set_fold_left : (B -> A -> B) -> (set A) -> B -> B := - (fold_left 1!B 2!A). + Definition set_fold_left : (B -> A -> B) -> set A -> B -> B := + fold_left (A:=B) (B:=A). - Definition set_fold_right : (A -> B -> B) -> (set A) -> B -> B := - [f][x][b](fold_right f b x). + Definition set_fold_right (f:A -> B -> B) (x:set A) + (b:B) : B := fold_right f b x. End other_definitions. -V7only [Implicits nil [].]. -Unset Implicit Arguments. +Unset Implicit Arguments.
\ No newline at end of file diff --git a/theories/Lists/MonoList.v b/theories/Lists/MonoList.v index 528e61ab0..28e52a415 100755 --- a/theories/Lists/MonoList.v +++ b/theories/Lists/MonoList.v @@ -10,97 +10,105 @@ (** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***) -Require Le. +Require Import Le. -Parameter List_Dom:Set. +Parameter List_Dom : Set. Definition A := List_Dom. -Inductive list : Set := nil : list | cons : A -> list -> list. +Inductive list : Set := + | nil : list + | cons : A -> list -> list. -Fixpoint app [l:list] : list -> list - := [m:list]<list>Cases l of - nil => m - | (cons a l1) => (cons a (app l1 m)) - end. +Fixpoint app (l m:list) {struct l} : list := + match l return list with + | nil => m + | cons a l1 => cons a (app l1 m) + end. -Lemma app_nil_end : (l:list)(l=(app l nil)). +Lemma app_nil_end : forall l:list, l = app l nil. Proof. - Intro l ; Elim l ; Simpl ; Auto. - Induction 1; Auto. + intro l; elim l; simpl in |- *; auto. + simple induction 1; auto. Qed. -Hints Resolve app_nil_end : list v62. +Hint Resolve app_nil_end: list v62. -Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)). +Lemma app_ass : forall l m n:list, app (app l m) n = app l (app m n). Proof. - Intros l m n ; Elim l ; Simpl ; Auto with list. - Induction 1; Auto with list. + intros l m n; elim l; simpl in |- *; auto with list. + simple induction 1; auto with list. Qed. -Hints Resolve app_ass : list v62. +Hint Resolve app_ass: list v62. -Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n). +Lemma ass_app : forall l m n:list, app l (app m n) = app (app l m) n. Proof. - Auto with list. + auto with list. Qed. -Hints Resolve ass_app : list v62. +Hint Resolve ass_app: list v62. -Definition tail := - [l:list] <list>Cases l of (cons _ m) => m | _ => nil end : list->list. +Definition tail (l:list) : list := + match l return list with + | cons _ m => m + | _ => nil + end. -Lemma nil_cons : (a:A)(m:list)~nil=(cons a m). - Intros; Discriminate. +Lemma nil_cons : forall (a:A) (m:list), nil <> cons a m. + intros; discriminate. Qed. (****************************************) (* Length of lists *) (****************************************) -Fixpoint length [l:list] : nat - := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end. +Fixpoint length (l:list) : nat := + match l return nat with + | cons _ m => S (length m) + | _ => 0 + end. (******************************) (* Length order of lists *) (******************************) Section length_order. -Definition lel := [l,m:list](le (length l) (length m)). +Definition lel (l m:list) := length l <= length m. -Hints Unfold lel : list. +Hint Unfold lel: list. -Variables a,b:A. -Variables l,m,n:list. +Variables a b : A. +Variables l m n : list. -Lemma lel_refl : (lel l l). +Lemma lel_refl : lel l l. Proof. - Unfold lel ; Auto with list. + unfold lel in |- *; auto with list. Qed. -Lemma lel_trans : (lel l m)->(lel m n)->(lel l n). +Lemma lel_trans : lel l m -> lel m n -> lel l n. Proof. - Unfold lel ; Intros. - Apply le_trans with (length m) ; Auto with list. + unfold lel in |- *; intros. + apply le_trans with (length m); auto with list. Qed. -Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)). +Lemma lel_cons_cons : lel l m -> lel (cons a l) (cons b m). Proof. - Unfold lel ; Simpl ; Auto with list arith. + unfold lel in |- *; simpl in |- *; auto with list arith. Qed. -Lemma lel_cons : (lel l m)->(lel l (cons b m)). +Lemma lel_cons : lel l m -> lel l (cons b m). Proof. - Unfold lel ; Simpl ; Auto with list arith. + unfold lel in |- *; simpl in |- *; auto with list arith. Qed. -Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m). +Lemma lel_tail : lel (cons a l) (cons b m) -> lel l m. Proof. - Unfold lel ; Simpl ; Auto with list arith. + unfold lel in |- *; simpl in |- *; auto with list arith. Qed. -Lemma lel_nil : (l':list)(lel l' nil)->(nil=l'). +Lemma lel_nil : forall l':list, lel l' nil -> nil = l'. Proof. - Intro l' ; Elim l' ; Auto with list arith. - Intros a' y H H0. + intro l'; elim l'; auto with list arith. + intros a' y H H0. (* <list>nil=(cons a' y) ============================ H0 : (lel (cons a' y) nil) @@ -108,35 +116,36 @@ Proof. y : list a' : A l' : list *) - Absurd (le (S (length y)) O); Auto with list arith. + absurd (S (length y) <= 0); auto with list arith. Qed. End length_order. -Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62. +Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: list + v62. -Fixpoint In [a:A;l:list] : Prop := - Cases l of - nil => False - | (cons b m) => (b=a)\/(In a m) - end. +Fixpoint In (a:A) (l:list) {struct l} : Prop := + match l with + | nil => False + | cons b m => b = a \/ In a m + end. -Lemma in_eq : (a:A)(l:list)(In a (cons a l)). +Lemma in_eq : forall (a:A) (l:list), In a (cons a l). Proof. - Simpl ; Auto with list. + simpl in |- *; auto with list. Qed. -Hints Resolve in_eq : list v62. +Hint Resolve in_eq: list v62. -Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)). +Lemma in_cons : forall (a b:A) (l:list), In b l -> In b (cons a l). Proof. - Simpl ; Auto with list. + simpl in |- *; auto with list. Qed. -Hints Resolve in_cons : list v62. +Hint Resolve in_cons: list v62. -Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)). +Lemma in_app_or : forall (l m:list) (a:A), In a (app l m) -> In a l \/ In a m. Proof. - Intros l m a. - Elim l ; Simpl ; Auto with list. - Intros a0 y H H0. + intros l m a. + elim l; simpl in |- *; auto with list. + intros a0 y H H0. (* ((<A>a0=a)\/(In a y))\/(In a m) ============================ H0 : (<A>a0=a)\/(In a (app y m)) @@ -146,81 +155,82 @@ Proof. a : A m : list l : list *) - Elim H0 ; Auto with list. - Intro H1. + elim H0; auto with list. + intro H1. (* ((<A>a0=a)\/(In a y))\/(In a m) ============================ H1 : (In a (app y m)) *) - Elim (H H1) ; Auto with list. + elim (H H1); auto with list. Qed. -Hints Immediate in_app_or : list v62. +Hint Immediate in_app_or: list v62. -Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)). +Lemma in_or_app : forall (l m:list) (a:A), In a l \/ In a m -> In a (app l m). Proof. - Intros l m a. - Elim l ; Simpl ; Intro H. + intros l m a. + elim l; simpl in |- *; intro H. (* 1 (In a m) ============================ H : False\/(In a m) a : A m : list l : list *) - Elim H ; Auto with list ; Intro H0. + elim H; auto with list; intro H0. (* (In a m) ============================ H0 : False *) - Elim H0. (* subProof completed *) - Intros y H0 H1. + elim H0. (* subProof completed *) + intros y H0 H1. (* 2 (<A>H=a)\/(In a (app y m)) ============================ H1 : ((<A>H=a)\/(In a y))\/(In a m) H0 : ((In a y)\/(In a m))->(In a (app y m)) y : list *) - Elim H1 ; Auto 4 with list. - Intro H2. + elim H1; auto 4 with list. + intro H2. (* (<A>H=a)\/(In a (app y m)) ============================ H2 : (<A>H=a)\/(In a y) *) - Elim H2 ; Auto with list. + elim H2; auto with list. Qed. -Hints Resolve in_or_app : list v62. +Hint Resolve in_or_app: list v62. -Definition incl := [l,m:list](a:A)(In a l)->(In a m). +Definition incl (l m:list) := forall a:A, In a l -> In a m. -Hints Unfold incl : list v62. +Hint Unfold incl: list v62. -Lemma incl_refl : (l:list)(incl l l). +Lemma incl_refl : forall l:list, incl l l. Proof. - Auto with list. + auto with list. Qed. -Hints Resolve incl_refl : list v62. +Hint Resolve incl_refl: list v62. -Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)). +Lemma incl_tl : forall (a:A) (l m:list), incl l m -> incl l (cons a m). Proof. - Auto with list. + auto with list. Qed. -Hints Immediate incl_tl : list v62. +Hint Immediate incl_tl: list v62. -Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n). +Lemma incl_tran : forall l m n:list, incl l m -> incl m n -> incl l n. Proof. - Auto with list. + auto with list. Qed. -Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)). +Lemma incl_appl : forall l m n:list, incl l n -> incl l (app n m). Proof. - Auto with list. + auto with list. Qed. -Hints Immediate incl_appl : list v62. +Hint Immediate incl_appl: list v62. -Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)). +Lemma incl_appr : forall l m n:list, incl l n -> incl l (app m n). Proof. - Auto with list. + auto with list. Qed. -Hints Immediate incl_appr : list v62. +Hint Immediate incl_appr: list v62. -Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m). +Lemma incl_cons : + forall (a:A) (l m:list), In a m -> incl l m -> incl (cons a l) m. Proof. - Unfold incl ; Simpl ; Intros a l m H H0 a0 H1. + unfold incl in |- *; simpl in |- *; intros a l m H H0 a0 H1. (* (In a0 m) ============================ H1 : (<A>a=a0)\/(In a0 l) @@ -230,21 +240,21 @@ Proof. m : list l : list a : A *) - Elim H1. + elim H1. (* 1 (<A>a=a0)->(In a0 m) *) - Elim H1 ; Auto with list ; Intro H2. + elim H1; auto with list; intro H2. (* (<A>a=a0)->(In a0 m) ============================ H2 : <A>a=a0 *) - Elim H2 ; Auto with list. (* solves subgoal *) + elim H2; auto with list. (* solves subgoal *) (* 2 (In a0 l)->(In a0 m) *) - Auto with list. + auto with list. Qed. -Hints Resolve incl_cons : list v62. +Hint Resolve incl_cons: list v62. -Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n). +Lemma incl_app : forall l m n:list, incl l n -> incl m n -> incl (app l m) n. Proof. - Unfold incl ; Simpl ; Intros l m n H H0 a H1. + unfold incl in |- *; simpl in |- *; intros l m n H H0 a H1. (* (In a n) ============================ H1 : (In a (app l m)) @@ -254,6 +264,6 @@ Proof. n : list m : list l : list *) - Elim (in_app_or l m a) ; Auto with list. + elim (in_app_or l m a); auto with list. Qed. -Hints Resolve incl_app : list v62. +Hint Resolve incl_app: list v62.
\ No newline at end of file diff --git a/theories/Lists/PolyList.v b/theories/Lists/PolyList.v deleted file mode 100644 index 50b203d4e..000000000 --- a/theories/Lists/PolyList.v +++ /dev/null @@ -1,642 +0,0 @@ -(***********************************************************************) -(* 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 *) -(***********************************************************************) - -(*i $Id$ i*) - -Require Le. - - -Section Lists. - -Variable A : Set. - -Set Implicit Arguments. - -Inductive list : Set := nil : list | cons : A -> list -> list. - -Infix "::" cons (at level 7, right associativity) : list_scope - V8only (at level 60, right associativity). - -Open Scope list_scope. - -(*************************) -(** Discrimination *) -(*************************) - -Lemma nil_cons : (a:A)(m:list)~(nil=(cons a m)). -Proof. - Intros; Discriminate. -Qed. - -(*************************) -(** Concatenation *) -(*************************) - -Fixpoint app [l:list] : list -> list - := [m:list]Cases l of - nil => m - | (cons a l1) => (cons a (app l1 m)) - end. - -Infix RIGHTA 7 "^" app : list_scope - V8only RIGHTA 60 "++". - -Lemma app_nil_end : (l:list)l=(l^nil). -Proof. - NewInduction l ; Simpl ; Auto. - Rewrite <- IHl; Auto. -Qed. -Hints Resolve app_nil_end. - -Tactic Definition now_show c := Change c. -V7only [Tactic Definition NowShow := now_show.]. - -Lemma app_ass : (l,m,n : list)((l^m)^ n)=(l^(m^n)). -Proof. - Intros. NewInduction l ; Simpl ; Auto. - NowShow '(cons a (app (app l m) n))=(cons a (app l (app m n))). - Rewrite <- IHl; Auto. -Qed. -Hints Resolve app_ass. - -Lemma ass_app : (l,m,n : list)(l^(m^n))=((l^m)^n). -Proof. - Auto. -Qed. -Hints Resolve ass_app. - -Lemma app_comm_cons : (x,y:list)(a:A) (cons a (x^y))=((cons a x)^y). -Proof. - Auto. -Qed. - -Lemma app_eq_nil: (x,y:list) (x^y)=nil -> x=nil /\ y=nil. -Proof. - NewDestruct x;NewDestruct y;Simpl;Auto. - Intros H;Discriminate H. - Intros;Discriminate H. -Qed. - -Lemma app_cons_not_nil: (x,y:list)(a:A)~nil=(x^(cons a y)). -Proof. -Unfold not . - NewDestruct x;Simpl;Intros. - Discriminate H. - Discriminate H. -Qed. - -Lemma app_eq_unit:(x,y:list)(a:A) - (x^y)=(cons a nil)-> (x=nil)/\ y=(cons a nil) \/ x=(cons a nil)/\ y=nil. - -Proof. - NewDestruct x;NewDestruct y;Simpl. - Intros a H;Discriminate H. - Left;Split;Auto. - Right;Split;Auto. - Generalize H . - Generalize (app_nil_end l) ;Intros E. - Rewrite <- E;Auto. - Intros. - Injection H. - Intro. - Cut nil=(l^(cons a0 l0));Auto. - Intro. - Generalize (app_cons_not_nil H1); Intro. - Elim H2. -Qed. - -Lemma app_inj_tail : (x,y:list)(a,b:A) - (x^(cons a nil))=(y^(cons b nil)) -> x=y /\ a=b. -Proof. - NewInduction x as [|x l IHl];NewDestruct y;Simpl;Auto. - Intros a b H. - Injection H. - Auto. - Intros a0 b H. - Injection H;Intros. - Generalize (app_cons_not_nil H0) ;NewDestruct 1. - Intros a b H. - Injection H;Intros. - Cut nil=(l^(cons a nil));Auto. - Intro. - Generalize (app_cons_not_nil H2) ;NewDestruct 1. - Intros a0 b H. - Injection H;Intros. - NewDestruct (IHl l0 a0 b H0). - Split;Auto. - Rewrite <- H1;Rewrite <- H2;Reflexivity. -Qed. - -(*************************) -(** Head and tail *) -(*************************) - -Definition head := - [l:list]Cases l of - | nil => Error - | (cons x _) => (Value x) - end. - -Definition tail : list -> list := - [l:list]Cases l of - | nil => nil - | (cons a m) => m - end. - -(****************************************) -(** Length of lists *) -(****************************************) - -Fixpoint length [l:list] : nat - := Cases l of nil => O | (cons _ m) => (S (length m)) end. - -(******************************) -(** Length order of lists *) -(******************************) - -Section length_order. -Definition lel := [l,m:list](le (length l) (length m)). - -Variables a,b:A. -Variables l,m,n:list. - -Lemma lel_refl : (lel l l). -Proof. - Unfold lel ; Auto with arith. -Qed. - -Lemma lel_trans : (lel l m)->(lel m n)->(lel l n). -Proof. - Unfold lel ; Intros. - NowShow '(le (length l) (length n)). - Apply le_trans with (length m) ; Auto with arith. -Qed. - -Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)). -Proof. - Unfold lel ; Simpl ; Auto with arith. -Qed. - -Lemma lel_cons : (lel l m)->(lel l (cons b m)). -Proof. - Unfold lel ; Simpl ; Auto with arith. -Qed. - -Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m). -Proof. - Unfold lel ; Simpl ; Auto with arith. -Qed. - -Lemma lel_nil : (l':list)(lel l' nil)->(nil=l'). -Proof. - Intro l' ; Elim l' ; Auto with arith. - Intros a' y H H0. - NowShow 'nil=(cons a' y). - Absurd (le (S (length y)) O); Auto with arith. -Qed. -End length_order. - -Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons. - -(*********************************) -(** The [In] predicate *) -(*********************************) - -Fixpoint In [a:A;l:list] : Prop := - Cases l of nil => False | (cons b m) => (b=a)\/(In a m) end. - -Lemma in_eq : (a:A)(l:list)(In a (cons a l)). -Proof. - Simpl ; Auto. -Qed. -Hints Resolve in_eq. - -Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)). -Proof. - Simpl ; Auto. -Qed. -Hints Resolve in_cons. - -Lemma in_nil : (a:A)~(In a nil). -Proof. - Unfold not; Intros a H; Inversion_clear H. -Qed. - - -Lemma in_inv : (a,b:A)(l:list) - (In b (cons a l)) -> a=b \/ (In b l). -Proof. - Intros a b l H ; Inversion_clear H ; Auto. -Qed. - -Lemma In_dec : ((x,y:A){x=y}+{~x=y}) -> (a:A)(l:list){(In a l)}+{~(In a l)}. - -Proof. - NewInduction l as [|a0 l IHl]. - Right; Apply in_nil. - NewDestruct (H a0 a); Simpl; Auto. - NewDestruct IHl; Simpl; Auto. - Right; Unfold not; Intros [Hc1 | Hc2]; Auto. -Qed. - -Lemma in_app_or : (l,m:list)(a:A)(In a (l^m))->((In a l)\/(In a m)). -Proof. - Intros l m a. - Elim l ; Simpl ; Auto. - Intros a0 y H H0. - NowShow '(a0=a\/(In a y))\/(In a m). - Elim H0 ; Auto. - Intro H1. - NowShow '(a0=a\/(In a y))\/(In a m). - Elim (H H1) ; Auto. -Qed. -Hints Immediate in_app_or. - -Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (l^m)). -Proof. - Intros l m a. - Elim l ; Simpl ; Intro H. - NowShow '(In a m). - Elim H ; Auto ; Intro H0. - NowShow '(In a m). - Elim H0. (* subProof completed *) - Intros y H0 H1. - NowShow 'H=a\/(In a (app y m)). - Elim H1 ; Auto 4. - Intro H2. - NowShow 'H=a\/(In a (app y m)). - Elim H2 ; Auto. -Qed. -Hints Resolve in_or_app. - -(***************************) -(** Set inclusion on list *) -(***************************) - -Definition incl := [l,m:list](a:A)(In a l)->(In a m). -Hints Unfold incl. - -Lemma incl_refl : (l:list)(incl l l). -Proof. - Auto. -Qed. -Hints Resolve incl_refl. - -Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)). -Proof. - Auto. -Qed. -Hints Immediate incl_tl. - -Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n). -Proof. - Auto. -Qed. - -Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (n^m)). -Proof. - Auto. -Qed. -Hints Immediate incl_appl. - -Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (m^n)). -Proof. - Auto. -Qed. -Hints Immediate incl_appr. - -Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m). -Proof. - Unfold incl ; Simpl ; Intros a l m H H0 a0 H1. - NowShow '(In a0 m). - Elim H1. - NowShow 'a=a0->(In a0 m). - Elim H1 ; Auto ; Intro H2. - NowShow 'a=a0->(In a0 m). - Elim H2 ; Auto. (* solves subgoal *) - NowShow '(In a0 l)->(In a0 m). - Auto. -Qed. -Hints Resolve incl_cons. - -Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (l^m) n). -Proof. - Unfold incl ; Simpl ; Intros l m n H H0 a H1. - NowShow '(In a n). - Elim (in_app_or H1); Auto. -Qed. -Hints Resolve incl_app. - -(**************************) -(** Nth element of a list *) -(**************************) - -Fixpoint nth [n:nat; l:list] : A->A := - [default]Cases n l of - O (cons x l') => x - | O other => default - | (S m) nil => default - | (S m) (cons x t) => (nth m t default) - end. - -Fixpoint nth_ok [n:nat; l:list] : A->bool := - [default]Cases n l of - O (cons x l') => true - | O other => false - | (S m) nil => false - | (S m) (cons x t) => (nth_ok m t default) - end. - -Lemma nth_in_or_default : - (n:nat)(l:list)(d:A){(In (nth n l d) l)}+{(nth n l d)=d}. -(* Realizer nth_ok. Program_all. *) -Proof. - Intros n l d; Generalize n; NewInduction l; Intro n0. - Right; Case n0; Trivial. - Case n0; Simpl. - Auto. - Intro n1; Elim (IHl n1); Auto. -Qed. - -Lemma nth_S_cons : - (n:nat)(l:list)(d:A)(a:A)(In (nth n l d) l) - ->(In (nth (S n) (cons a l) d) (cons a l)). -Proof. - Simpl; Auto. -Qed. - -Fixpoint nth_error [l:list;n:nat] : (Exc A) := - Cases n l of - | O (cons x _) => (Value x) - | (S n) (cons _ l) => (nth_error l n) - | _ _ => Error - end. - -Definition nth_default : A -> list -> nat -> A := - [default,l,n]Cases (nth_error l n) of - | (Some x) => x - | None => default - end. - -Lemma nth_In : - (n:nat)(l:list)(d:A)(lt n (length l))->(In (nth n l d) l). - -Proof. -Unfold lt; NewInduction n as [|n hn]; Simpl. -NewDestruct l ; Simpl ; [ Inversion 2 | Auto]. -NewDestruct l as [|a l hl] ; Simpl. -Inversion 2. -Intros d ie ; Right ; Apply hn ; Auto with arith. -Qed. - -(********************************) -(** Decidable equality on lists *) -(********************************) - - -Lemma list_eq_dec : ((x,y:A){x=y}+{~x=y})->(x,y:list){x=y}+{~x=y}. -Proof. - NewInduction x as [|a l IHl]; NewDestruct y as [|a0 l0]; Auto. - NewDestruct (H a a0) as [e|e]. - NewDestruct (IHl l0) as [e'|e']. - Left; Rewrite e; Rewrite e'; Trivial. - Right; Red; Intro. - Apply e'; Injection H0; Trivial. - Right; Red; Intro. - Apply e; Injection H0; Trivial. -Qed. - -(*************************) -(** Reverse *) -(*************************) - -Fixpoint rev [l:list] : list := - Cases l of - nil => nil - | (cons x l') => (rev l')^(cons x nil) - end. - -Lemma distr_rev : - (x,y:list) (rev (x^y))=((rev y)^(rev x)). -Proof. - NewInduction x as [|a l IHl]. - NewDestruct y. - Simpl. - Auto. - - Simpl. - Apply app_nil_end;Auto. - - Intro y. - Simpl. - Rewrite (IHl y). - Apply (app_ass (rev y) (rev l) (cons a nil)). -Qed. - -Remark rev_unit : (l:list)(a:A) (rev l^(cons a nil))= (cons a (rev l)). -Proof. - Intros. - Apply (distr_rev l (cons a nil));Simpl;Auto. -Qed. - -Lemma idempot_rev : (l:list)(rev (rev l))=l. -Proof. - NewInduction l as [|a l IHl]. - Simpl;Auto. - - Simpl. - Rewrite (rev_unit (rev l) a). - Rewrite -> IHl;Auto. -Qed. - -(*********************************************) -(** Reverse Induction Principle on Lists *) -(*********************************************) - -Section Reverse_Induction. - -Unset Implicit Arguments. - -Remark rev_list_ind: (P:list->Prop) - (P nil) - ->((a:A)(l:list)(P (rev l))->(P (rev (cons a l)))) - ->(l:list) (P (rev l)). -Proof. - NewInduction l; Auto. -Qed. -Set Implicit Arguments. - -Lemma rev_ind : - (P:list->Prop) - (P nil)-> - ((x:A)(l:list)(P l)->(P l^(cons x nil))) - ->(l:list)(P l). -Proof. - Intros. - Generalize (idempot_rev l) . - Intros E;Rewrite <- E. - Apply (rev_list_ind P). - Auto. - - Simpl. - Intros. - Apply (H0 a (rev l0)). - Auto. -Qed. - -End Reverse_Induction. - -End Lists. - -Implicits nil [1]. - -Hints Resolve nil_cons app_nil_end ass_app app_ass : datatypes v62. -Hints Resolve app_comm_cons app_cons_not_nil : datatypes v62. -Hints Immediate app_eq_nil : datatypes v62. -Hints Resolve app_eq_unit app_inj_tail : datatypes v62. -Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons - : datatypes v62. -Hints Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app : datatypes v62. -Hints Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons incl_app - : datatypes v62. - -Section Functions_on_lists. - -(****************************************************************) -(** Some generic functions on lists and basic functions of them *) -(****************************************************************) - -Section Map. -Variables A,B:Set. -Variable f:A->B. -Fixpoint map [l:(list A)] : (list B) := - Cases l of - nil => nil - | (cons a t) => (cons (f a) (map t)) - end. -End Map. - -Lemma in_map : (A,B:Set)(f:A->B)(l:(list A))(x:A) - (In x l) -> (In (f x) (map f l)). -Proof. - NewInduction l as [|a l IHl]; Simpl; - [ Auto - | NewDestruct 1; - [ Left; Apply f_equal with f:=f; Assumption - | Auto] - ]. -Qed. - -Fixpoint flat_map [A,B:Set; f:A->(list B); l:(list A)] : (list B) := - Cases l of - nil => nil - | (cons x t) => (app (f x) (flat_map f t)) - end. - -Fixpoint list_prod [A:Set; B:Set; l:(list A)] : (list B)->(list A*B) := - [l']Cases l of - nil => nil - | (cons x t) => (app (map [y:B](x,y) l') - (list_prod t l')) - end. - -Lemma in_prod_aux : - (A:Set)(B:Set)(x:A)(y:B)(l:(list B)) - (In y l) -> (In (x,y) (map [y0:B](x,y0) l)). -Proof. - NewInduction l; - [ Simpl; Auto - | Simpl; NewDestruct 1 as [H1|]; - [ Left; Rewrite H1; Trivial - | Right; Auto] - ]. -Qed. - -Lemma in_prod : (A:Set)(B:Set)(l:(list A))(l':(list B)) - (x:A)(y:B)(In x l)->(In y l')->(In (x,y) (list_prod l l')). -Proof. - NewInduction l; - [ Simpl; Tauto - | Simpl; Intros; Apply in_or_app; NewDestruct H; - [ Left; Rewrite H; Apply in_prod_aux; Assumption - | Right; Auto] - ]. -Qed. - -(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y] - indexed by elts of [x], sorted in lexicographic order. *) - -Fixpoint list_power [A,B:Set; l:(list A)] : (list B)->(list (list A*B)) := - [l']Cases l of - nil => (cons nil nil) - | (cons x t) => (flat_map [f:(list A*B)](map [y:B](cons (x,y) f) l') - (list_power t l')) - end. - -(************************************) -(** Left-to-right iterator on lists *) -(************************************) - -Section Fold_Left_Recursor. -Variables A,B:Set. -Variable f:A->B->A. -Fixpoint fold_left[l:(list B)] : A -> A := -[a0]Cases l of - nil => a0 - | (cons b t) => (fold_left t (f a0 b)) - end. -End Fold_Left_Recursor. - -(************************************) -(** Right-to-left iterator on lists *) -(************************************) - -Section Fold_Right_Recursor. -Variables A,B:Set. -Variable f:B->A->A. -Variable a0:A. -Fixpoint fold_right [l:(list B)] : A := - Cases l of - nil => a0 - | (cons b t) => (f b (fold_right t)) - end. -End Fold_Right_Recursor. - -Theorem fold_symmetric : - (A:Set)(f:A->A->A) - ((x,y,z:A)(f x (f y z))=(f (f x y) z)) - ->((x,y:A)(f x y)=(f y x)) - ->(a0:A)(l:(list A))(fold_left f l a0)=(fold_right f a0 l). -Proof. -NewDestruct l as [|a l]. -Reflexivity. -Simpl. -Rewrite <- H0. -Generalize a0 a. -NewInduction l as [|a3 l IHl]; Simpl. -Trivial. -Intros. -Rewrite H. -Rewrite (H0 a2). -Rewrite <- (H a1). -Rewrite (H0 a1). -Rewrite IHl. -Reflexivity. -Qed. - -End Functions_on_lists. - -V7only [Implicits nil [].]. - -(** Exporting list notations *) - -V8Infix "::" cons (at level 60, right associativity) : list_scope. - -Infix RIGHTA 7 "^" app : list_scope V8only RIGHTA 60 "++". - -Open Scope list_scope. diff --git a/theories/Lists/PolyListSyntax.v b/theories/Lists/PolyListSyntax.v deleted file mode 100644 index a4b6a57aa..000000000 --- a/theories/Lists/PolyListSyntax.v +++ /dev/null @@ -1,10 +0,0 @@ -(***********************************************************************) -(* 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 *) -(***********************************************************************) - -(*i $Id$ i*) - diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v index 9bbbe0e46..19c564eb9 100755 --- a/theories/Lists/Streams.v +++ b/theories/Lists/Streams.v @@ -16,115 +16,123 @@ Section Streams. Variable A : Set. -CoInductive Set Stream := Cons : A->Stream->Stream. +CoInductive Stream : Set := + Cons : A -> Stream -> Stream. -Definition hd := - [x:Stream] Cases x of (Cons a _) => a end. +Definition hd (x:Stream) := match x with + | Cons a _ => a + end. -Definition tl := - [x:Stream] Cases x of (Cons _ s) => s end. +Definition tl (x:Stream) := match x with + | Cons _ s => s + end. -Fixpoint Str_nth_tl [n:nat] : Stream->Stream := - [s:Stream] Cases n of - O => s - |(S m) => (Str_nth_tl m (tl s)) - end. +Fixpoint Str_nth_tl (n:nat) (s:Stream) {struct n} : Stream := + match n with + | O => s + | S m => Str_nth_tl m (tl s) + end. -Definition Str_nth : nat->Stream->A := [n:nat][s:Stream](hd (Str_nth_tl n s)). +Definition Str_nth (n:nat) (s:Stream) : A := hd (Str_nth_tl n s). -Lemma unfold_Stream :(x:Stream)x=(Cases x of (Cons a s) => (Cons a s) end). +Lemma unfold_Stream : + forall x:Stream, x = match x with + | Cons a s => Cons a s + end. Proof. - Intro x. - Case x. - Trivial. + intro x. + case x. + trivial. Qed. -Lemma tl_nth_tl : (n:nat)(s:Stream)(tl (Str_nth_tl n s))=(Str_nth_tl n (tl s)). +Lemma tl_nth_tl : + forall (n:nat) (s:Stream), tl (Str_nth_tl n s) = Str_nth_tl n (tl s). Proof. - Induction n; Simpl; Auto. + simple induction n; simpl in |- *; auto. Qed. -Hints Resolve tl_nth_tl : datatypes v62. - -Lemma Str_nth_tl_plus -: (n,m:nat)(s:Stream)(Str_nth_tl n (Str_nth_tl m s))=(Str_nth_tl (plus n m) s). -Induction n; Simpl; Intros; Auto with datatypes. -Rewrite <- H. -Rewrite tl_nth_tl; Trivial with datatypes. +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. +rewrite <- H. +rewrite tl_nth_tl; trivial with datatypes. Qed. -Lemma Str_nth_plus - : (n,m:nat)(s:Stream)(Str_nth n (Str_nth_tl m s))=(Str_nth (plus n m) s). -Intros; Unfold Str_nth; Rewrite Str_nth_tl_plus; Trivial with datatypes. +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; + trivial with datatypes. Qed. (** Extensional Equality between two streams *) -CoInductive EqSt : Stream->Stream->Prop := - eqst : (s1,s2:Stream) - ((hd s1)=(hd s2))-> - (EqSt (tl s1) (tl s2)) - ->(EqSt s1 s2). +CoInductive EqSt : Stream -> Stream -> Prop := + eqst : + forall s1 s2:Stream, + hd s1 = hd s2 -> EqSt (tl s1) (tl s2) -> EqSt s1 s2. (** A coinduction principle *) -Tactic Definition CoInduction proof := - Cofix proof; Intros; Constructor; - [Clear proof | Try (Apply proof;Clear proof)]. +Ltac coinduction proof := + cofix proof; intros; constructor; + [ clear proof | try (apply proof; clear proof) ]. (** Extensional equality is an equivalence relation *) -Theorem EqSt_reflex : (s:Stream)(EqSt s s). -CoInduction EqSt_reflex. -Reflexivity. +Theorem EqSt_reflex : forall s:Stream, EqSt s s. +coinduction EqSt_reflex. +reflexivity. Qed. -Theorem sym_EqSt : - (s1:Stream)(s2:Stream)(EqSt s1 s2)->(EqSt s2 s1). -(CoInduction Eq_sym). -Case H;Intros;Symmetry;Assumption. -Case H;Intros;Assumption. +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; assumption. Qed. -Theorem trans_EqSt : - (s1,s2,s3:Stream)(EqSt s1 s2)->(EqSt s2 s3)->(EqSt s1 s3). -(CoInduction Eq_trans). -Transitivity (hd s2). -Case H; Intros; Assumption. -Case H0; Intros; Assumption. -Apply (Eq_trans (tl s1) (tl s2) (tl s3)). -Case H; Trivial with datatypes. -Case H0; Trivial with datatypes. +Theorem trans_EqSt : + forall s1 s2 s3:Stream, EqSt s1 s2 -> EqSt s2 s3 -> EqSt s1 s3. +coinduction Eq_trans. +transitivity (hd s2). +case H; intros; assumption. +case H0; intros; assumption. +apply (Eq_trans (tl s1) (tl s2) (tl s3)). +case H; trivial with datatypes. +case H0; trivial with datatypes. Qed. (** The definition given is equivalent to require the elements at each position to be equal *) Theorem eqst_ntheq : - (n:nat)(s1,s2:Stream)(EqSt s1 s2)->(Str_nth n s1)=(Str_nth n s2). -Unfold Str_nth; Induction n. -Intros s1 s2 H; Case H; Trivial with datatypes. -Intros m hypind. -Simpl. -Intros s1 s2 H. -Apply hypind. -Case H; Trivial with datatypes. + forall (n:nat) (s1 s2:Stream), EqSt s1 s2 -> Str_nth n s1 = Str_nth n s2. +unfold Str_nth in |- *; simple induction n. +intros s1 s2 H; case H; trivial with datatypes. +intros m hypind. +simpl in |- *. +intros s1 s2 H. +apply hypind. +case H; trivial with datatypes. Qed. -Theorem ntheq_eqst : - (s1,s2:Stream)((n:nat)(Str_nth n s1)=(Str_nth n s2))->(EqSt s1 s2). -(CoInduction Equiv2). -Apply (H O). -Intros n; Apply (H (S n)). +Theorem ntheq_eqst : + forall s1 s2:Stream, + (forall n:nat, Str_nth n s1 = Str_nth n s2) -> EqSt s1 s2. +coinduction Equiv2. +apply (H 0). +intros n; apply (H (S n)). Qed. Section Stream_Properties. -Variable P : Stream->Prop. +Variable P : Stream -> Prop. (*i Inductive Exists : Stream -> Prop := @@ -132,21 +140,21 @@ Inductive Exists : Stream -> Prop := | Further : forall x:Stream, ~ P x -> Exists (tl x) -> Exists x. i*) -Inductive Exists : Stream -> Prop := - Here : (x:Stream)(P x) ->(Exists x) | - Further : (x:Stream)(Exists (tl x))->(Exists x). +Inductive Exists : Stream -> Prop := + | Here : forall x:Stream, P x -> Exists x + | Further : forall x:Stream, Exists (tl x) -> Exists x. -CoInductive ForAll : Stream -> Prop := - forall : (x:Stream)(P x)->(ForAll (tl x))->(ForAll x). +CoInductive ForAll : Stream -> Prop := + HereAndFurther : forall x:Stream, P x -> ForAll (tl x) -> ForAll x. Section Co_Induction_ForAll. -Variable Inv : Stream -> Prop. -Hypothesis InvThenP : (x:Stream)(Inv x)->(P x). -Hypothesis InvIsStable: (x:Stream)(Inv x)->(Inv (tl x)). +Variable Inv : Stream -> Prop. +Hypothesis InvThenP : forall x:Stream, Inv x -> P x. +Hypothesis InvIsStable : forall x:Stream, Inv x -> Inv (tl x). -Theorem ForAll_coind : (x:Stream)(Inv x)->(ForAll x). -(CoInduction ForAll_coind);Auto. +Theorem ForAll_coind : forall x:Stream, Inv x -> ForAll x. +coinduction ForAll_coind; auto. Qed. End Co_Induction_ForAll. @@ -155,16 +163,15 @@ End Stream_Properties. End Streams. Section Map. -Variables A,B : Set. -Variable f : A->B. -CoFixpoint map : (Stream A)->(Stream B) := - [s:(Stream A)](Cons (f (hd s)) (map (tl s))). +Variables A B : Set. +Variable f : A -> B. +CoFixpoint map (s:Stream A) : Stream B := Cons (f (hd s)) (map (tl s)). End Map. Section Constant_Stream. Variable A : Set. Variable a : A. -CoFixpoint const : (Stream A) := (Cons a const). +CoFixpoint const : Stream A := Cons a const. End Constant_Stream. -Unset Implicit Arguments. +Unset Implicit Arguments.
\ No newline at end of file diff --git a/theories/Lists/TheoryList.v b/theories/Lists/TheoryList.v index c7abe31da..da23394c0 100755 --- a/theories/Lists/TheoryList.v +++ b/theories/Lists/TheoryList.v @@ -10,32 +10,32 @@ (** Some programs and results about lists following CAML Manual *) -Require Export PolyList. +Require Export List. Set Implicit Arguments. -Chapter Lists. +Section Lists. -Variable A : Set. +Variable A : Set. (**********************) (** The null function *) (**********************) -Definition Isnil : (list A) -> Prop := [l:(list A)](nil A)=l. +Definition Isnil (l:list A) : Prop := nil = l. -Lemma Isnil_nil : (Isnil (nil A)). -Red; Auto. +Lemma Isnil_nil : Isnil nil. +red in |- *; auto. Qed. -Hints Resolve Isnil_nil. +Hint Resolve Isnil_nil. -Lemma not_Isnil_cons : (a:A)(l:(list A))~(Isnil (cons a l)). -Unfold Isnil. -Intros; Discriminate. +Lemma not_Isnil_cons : forall (a:A) (l:list A), ~ Isnil (a :: l). +unfold Isnil in |- *. +intros; discriminate. Qed. -Hints Resolve Isnil_nil not_Isnil_cons. +Hint Resolve Isnil_nil not_Isnil_cons. -Lemma Isnil_dec : (l:(list A)){(Isnil l)}+{~(Isnil l)}. -Intro l; Case l;Auto. +Lemma Isnil_dec : forall l:list A, {Isnil l} + {~ Isnil l}. +intro l; case l; auto. (* Realizer (fun l => match l with | nil => true @@ -48,10 +48,11 @@ Qed. (** The Uncons function *) (************************) -Lemma Uncons : (l:(list A)){a : A & { m: (list A) | (cons a m)=l}}+{Isnil l}. -Intro l; Case l. -Auto. -Intros a m; Intros; Left; Exists a; Exists m; Reflexivity. +Lemma Uncons : + forall l:list A, {a : A & {m : list A | a :: m = l}} + {Isnil l}. +intro l; case l. +auto. +intros a m; intros; left; exists a; exists m; reflexivity. (* Realizer (fun l => match l with | nil => error @@ -64,10 +65,11 @@ Qed. (** The head function *) (********************************) -Lemma Hd : (l:(list A)){a : A | (EX m:(list A) |(cons a m)=l)}+{Isnil l}. -Intro l; Case l. -Auto. -Intros a m; Intros; Left; Exists a; Exists m; Reflexivity. +Lemma Hd : + forall l:list A, {a : A | exists m : list A | a :: m = l} + {Isnil l}. +intro l; case l. +auto. +intros a m; intros; left; exists a; exists m; reflexivity. (* Realizer (fun l => match l with | nil => error @@ -76,11 +78,12 @@ Realizer (fun l => match l with *) Qed. -Lemma Tl : (l:(list A)){m:(list A)| (EX a:A |(cons a m)=l) - \/ ((Isnil l) /\ (Isnil m)) }. -Intro l; Case l. -Exists (nil A); Auto. -Intros a m; Intros; Exists m; Left; Exists a; Reflexivity. +Lemma Tl : + forall l:list A, + {m : list A | ( exists a : A | a :: m = l) \/ Isnil l /\ Isnil m}. +intro l; case l. +exists (nil (A:=A)); auto. +intros a m; intros; exists m; left; exists a; reflexivity. (* Realizer (fun l => match l with | nil => nil @@ -94,25 +97,25 @@ Qed. (****************************************) (* length is defined in List *) -Fixpoint Length_l [l:(list A)] : nat -> nat - := [n:nat] Cases l of - nil => n - | (cons _ m) => (Length_l m (S n)) - end. +Fixpoint Length_l (l:list A) (n:nat) {struct l} : nat := + match l with + | nil => n + | _ :: m => Length_l m (S n) + end. (* A tail recursive version *) -Lemma Length_l_pf : (l:(list A))(n:nat){m:nat|(plus n (length l))=m}. -NewInduction l as [|a m lrec]. -Intro n; Exists n; Simpl; Auto. -Intro n; Elim (lrec (S n)); Simpl; Intros. -Exists x; Transitivity (S (plus n (length m))); Auto. +Lemma Length_l_pf : forall (l:list A) (n:nat), {m : nat | n + length l = m}. +induction l as [| a m lrec]. +intro n; exists n; simpl in |- *; auto. +intro n; elim (lrec (S n)); simpl in |- *; intros. +exists x; transitivity (S (n + length m)); auto. (* Realizer Length_l. *) Qed. -Lemma Length : (l:(list A)){m:nat|(length l)=m}. -Intro l. Apply (Length_l_pf l O). +Lemma Length : forall l:list A, {m : nat | length l = m}. +intro l. apply (Length_l_pf l 0). (* Realizer (fun l -> Length_l_pf l O). *) @@ -121,43 +124,42 @@ Qed. (*******************************) (** Members of lists *) (*******************************) -Inductive In_spec [a:A] : (list A) -> Prop := - | in_hd : (l:(list A))(In_spec a (cons a l)) - | in_tl : (l:(list A))(b:A)(In a l)->(In_spec a (cons b l)). -Hints Resolve in_hd in_tl. -Hints Unfold In. -Hints Resolve in_cons. - -Theorem In_In_spec : (a:A)(l:(list A))(In a l) <-> (In_spec a l). -Split. -Elim l; [ Intros; Contradiction - | Intros; Elim H0; - [ Intros; Rewrite H1; Auto - | Auto ]]. -Intros; Elim H; Auto. +Inductive In_spec (a:A) : list A -> Prop := + | in_hd : forall l:list A, In_spec a (a :: l) + | in_tl : forall (l:list A) (b:A), In a l -> In_spec a (b :: l). +Hint Resolve in_hd in_tl. +Hint Unfold In. +Hint Resolve in_cons. + +Theorem In_In_spec : forall (a:A) (l:list A), In a l <-> In_spec a l. +split. +elim l; + [ intros; contradiction + | intros; elim H0; [ intros; rewrite H1; auto | auto ] ]. +intros; elim H; auto. Qed. -Inductive AllS [P:A->Prop] : (list A) -> Prop - := allS_nil : (AllS P (nil A)) - | allS_cons : (a:A)(l:(list A))(P a)->(AllS P l)->(AllS P (cons a l)). -Hints Resolve allS_nil allS_cons. +Inductive AllS (P:A -> Prop) : list A -> Prop := + | allS_nil : AllS P nil + | allS_cons : forall (a:A) (l:list A), P a -> AllS P l -> AllS P (a :: l). +Hint Resolve allS_nil allS_cons. -Hypothesis eqA_dec : (a,b:A){a=b}+{~a=b}. +Hypothesis eqA_dec : forall a b:A, {a = b} + {a <> b}. -Fixpoint mem [a:A; l:(list A)] : bool := - Cases l of - nil => false - | (cons b m) => if (eqA_dec a b) then [H]true else [H](mem a m) +Fixpoint mem (a:A) (l:list A) {struct l} : bool := + match l with + | nil => false + | b :: m => if eqA_dec a b then fun H => true else fun H => mem a m end. -Hints Unfold In. -Lemma Mem : (a:A)(l:(list A)){(In a l)}+{(AllS [b:A]~b=a l)}. -Intros a l. -NewInduction l. -Auto. -Elim (eqA_dec a a0). -Auto. -Simpl. Elim IHl; Auto. +Hint Unfold In. +Lemma Mem : forall (a:A) (l:list A), {In a l} + {AllS (fun b:A => b <> a) l}. +intros a l. +induction l. +auto. +elim (eqA_dec a a0). +auto. +simpl in |- *. elim IHl; auto. (* Realizer mem. *) @@ -167,146 +169,157 @@ Qed. (** Index of elements *) (*********************************) -Require Le. -Require Lt. - -Inductive nth_spec : (list A)->nat->A->Prop := - nth_spec_O : (a:A)(l:(list A))(nth_spec (cons a l) (S O) a) -| nth_spec_S : (n:nat)(a,b:A)(l:(list A)) - (nth_spec l n a)->(nth_spec (cons b l) (S n) a). -Hints Resolve nth_spec_O nth_spec_S. - -Inductive fst_nth_spec : (list A)->nat->A->Prop := - fst_nth_O : (a:A)(l:(list A))(fst_nth_spec (cons a l) (S O) a) -| fst_nth_S : (n:nat)(a,b:A)(l:(list A))(~a=b)-> - (fst_nth_spec l n a)->(fst_nth_spec (cons b l) (S n) a). -Hints Resolve fst_nth_O fst_nth_S. - -Lemma fst_nth_nth : (l:(list A))(n:nat)(a:A)(fst_nth_spec l n a)->(nth_spec l n a). -NewInduction 1; Auto. +Require Import Le. +Require Import Lt. + +Inductive nth_spec : list A -> nat -> A -> Prop := + | nth_spec_O : forall (a:A) (l:list A), nth_spec (a :: l) 1 a + | nth_spec_S : + forall (n:nat) (a b:A) (l:list A), + nth_spec l n a -> nth_spec (b :: l) (S n) a. +Hint Resolve nth_spec_O nth_spec_S. + +Inductive fst_nth_spec : list A -> nat -> A -> Prop := + | fst_nth_O : forall (a:A) (l:list A), fst_nth_spec (a :: l) 1 a + | fst_nth_S : + forall (n:nat) (a b:A) (l:list A), + a <> b -> fst_nth_spec l n a -> fst_nth_spec (b :: l) (S n) a. +Hint Resolve fst_nth_O fst_nth_S. + +Lemma fst_nth_nth : + forall (l:list A) (n:nat) (a:A), fst_nth_spec l n a -> nth_spec l n a. +induction 1; auto. Qed. -Hints Immediate fst_nth_nth. +Hint Immediate fst_nth_nth. -Lemma nth_lt_O : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(lt O n). -NewInduction 1; Auto. +Lemma nth_lt_O : forall (l:list A) (n:nat) (a:A), nth_spec l n a -> 0 < n. +induction 1; auto. Qed. -Lemma nth_le_length : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(le n (length l)). -NewInduction 1; Simpl; Auto with arith. +Lemma nth_le_length : + forall (l:list A) (n:nat) (a:A), nth_spec l n a -> n <= length l. +induction 1; simpl in |- *; auto with arith. Qed. -Fixpoint Nth_func [l:(list A)] : nat -> (Exc A) - := [n:nat] Cases l n of - (cons a _) (S O) => (value A a) - | (cons _ l') (S (S p)) => (Nth_func l' (S p)) - | _ _ => Error - end. - -Lemma Nth : (l:(list A))(n:nat) - {a:A|(nth_spec l n a)}+{(n=O)\/(lt (length l) n)}. -NewInduction l as [|a l IHl]. -Intro n; Case n; Simpl; Auto with arith. -Intro n; NewDestruct n as [|[|n1]]; Simpl; Auto. -Left; Exists a; Auto. -NewDestruct (IHl (S n1)) as [[b]|o]. -Left; Exists b; Auto. -Right; NewDestruct o. -Absurd (S n1)=O; Auto. -Auto with arith. +Fixpoint Nth_func (l:list A) (n:nat) {struct l} : Exc A := + match l, n with + | a :: _, S O => value a + | _ :: l', S (S p) => Nth_func l' (S p) + | _, _ => error + end. + +Lemma Nth : + forall (l:list A) (n:nat), + {a : A | nth_spec l n a} + {n = 0 \/ length l < n}. +induction l as [| a l IHl]. +intro n; case n; simpl in |- *; auto with arith. +intro n; destruct n as [| [| n1]]; simpl in |- *; auto. +left; exists a; auto. +destruct (IHl (S n1)) as [[b]| o]. +left; exists b; auto. +right; destruct o. +absurd (S n1 = 0); auto. +auto with arith. (* Realizer Nth_func. *) Qed. -Lemma Item : (l:(list A))(n:nat){a:A|(nth_spec l (S n) a)}+{(le (length l) n)}. -Intros l n; Case (Nth l (S n)); Intro. -Case s; Intro a; Left; Exists a; Auto. -Right; Case o; Intro. -Absurd (S n)=O; Auto. -Auto with arith. +Lemma Item : + forall (l:list A) (n:nat), {a : A | nth_spec l (S n) a} + {length l <= n}. +intros l n; case (Nth l (S n)); intro. +case s; intro a; left; exists a; auto. +right; case o; intro. +absurd (S n = 0); auto. +auto with arith. Qed. -Require Minus. -Require DecBool. - -Fixpoint index_p [a:A;l:(list A)] : nat -> (Exc nat) := - Cases l of nil => [p]Error - | (cons b m) => [p](ifdec (eqA_dec a b) (Value p) (index_p a m (S p))) - end. - -Lemma Index_p : (a:A)(l:(list A))(p:nat) - {n:nat|(fst_nth_spec l (minus (S n) p) a)}+{(AllS [b:A]~a=b l)}. -NewInduction l as [|b m irec]. -Auto. -Intro p. -NewDestruct (eqA_dec a b) as [e|e]. -Left; Exists p. -NewDestruct e; Elim minus_Sn_m; Trivial; Elim minus_n_n; Auto with arith. -NewDestruct (irec (S p)) as [[n H]|]. -Left; Exists n; Auto with arith. -Elim minus_Sn_m; Auto with arith. -Apply lt_le_weak; Apply lt_O_minus_lt; Apply nth_lt_O with m a; Auto with arith. -Auto. +Require Import Minus. +Require Import DecBool. + +Fixpoint index_p (a:A) (l:list A) {struct l} : nat -> Exc nat := + match l with + | nil => fun p => error + | b :: m => fun p => ifdec (eqA_dec a b) (value p) (index_p a m (S p)) + end. + +Lemma Index_p : + forall (a:A) (l:list A) (p:nat), + {n : nat | fst_nth_spec l (S n - p) a} + {AllS (fun b:A => a <> b) l}. +induction l as [| b m irec]. +auto. +intro p. +destruct (eqA_dec a b) as [e| e]. +left; exists p. +destruct e; elim minus_Sn_m; trivial; elim minus_n_n; auto with arith. +destruct (irec (S p)) as [[n H]| ]. +left; exists n; auto with arith. +elim minus_Sn_m; auto with arith. +apply lt_le_weak; apply lt_O_minus_lt; apply nth_lt_O with m a; + auto with arith. +auto. Qed. -Lemma Index : (a:A)(l:(list A)) - {n:nat|(fst_nth_spec l n a)}+{(AllS [b:A]~a=b l)}. +Lemma Index : + forall (a:A) (l:list A), + {n : nat | fst_nth_spec l n a} + {AllS (fun b:A => a <> b) l}. -Intros a l; Case (Index_p a l (S O)); Auto. -Intros (n,P); Left; Exists n; Auto. -Rewrite (minus_n_O n); Trivial. +intros a l; case (Index_p a l 1); auto. +intros [n P]; left; exists n; auto. +rewrite (minus_n_O n); trivial. (* Realizer (fun a l -> Index_p a l (S O)). *) Qed. Section Find_sec. -Variable R,P : A -> Prop. +Variables R P : A -> Prop. -Inductive InR : (list A) -> Prop - := inR_hd : (a:A)(l:(list A))(R a)->(InR (cons a l)) - | inR_tl : (a:A)(l:(list A))(InR l)->(InR (cons a l)). -Hints Resolve inR_hd inR_tl. +Inductive InR : list A -> Prop := + | inR_hd : forall (a:A) (l:list A), R a -> InR (a :: l) + | inR_tl : forall (a:A) (l:list A), InR l -> InR (a :: l). +Hint Resolve inR_hd inR_tl. -Definition InR_inv := - [l:(list A)]Cases l of - nil => False - | (cons b m) => (R b)\/(InR m) - end. +Definition InR_inv (l:list A) := + match l with + | nil => False + | b :: m => R b \/ InR m + end. -Lemma InR_INV : (l:(list A))(InR l)->(InR_inv l). -NewInduction 1; Simpl; Auto. +Lemma InR_INV : forall l:list A, InR l -> InR_inv l. +induction 1; simpl in |- *; auto. Qed. -Lemma InR_cons_inv : (a:A)(l:(list A))(InR (cons a l))->((R a)\/(InR l)). -Intros a l H; Exact (InR_INV H). +Lemma InR_cons_inv : forall (a:A) (l:list A), InR (a :: l) -> R a \/ InR l. +intros a l H; exact (InR_INV H). Qed. -Lemma InR_or_app : (l,m:(list A))((InR l)\/(InR m))->(InR (app l m)). -Intros l m [|]. -NewInduction 1; Simpl; Auto. -Intro. NewInduction l; Simpl; Auto. +Lemma InR_or_app : forall l m:list A, InR l \/ InR m -> InR (l ++ m). +intros l m [| ]. +induction 1; simpl in |- *; auto. +intro. induction l; simpl in |- *; auto. Qed. -Lemma InR_app_or : (l,m:(list A))(InR (app l m))->((InR l)\/(InR m)). -Intros l m; Elim l; Simpl; Auto. -Intros b l' Hrec IAc; Elim (InR_cons_inv IAc);Auto. -Intros; Elim Hrec; Auto. +Lemma InR_app_or : forall l m:list A, InR (l ++ m) -> InR l \/ InR m. +intros l m; elim l; simpl in |- *; auto. +intros b l' Hrec IAc; elim (InR_cons_inv IAc); auto. +intros; elim Hrec; auto. Qed. -Hypothesis RS_dec : (a:A){(R a)}+{(P a)}. +Hypothesis RS_dec : forall a:A, {R a} + {P a}. -Fixpoint find [l:(list A)] : (Exc A) := - Cases l of nil => Error - | (cons a m) => (ifdec (RS_dec a) (Value a) (find m)) - end. +Fixpoint find (l:list A) : Exc A := + match l with + | nil => error + | a :: m => ifdec (RS_dec a) (value a) (find m) + end. -Lemma Find : (l:(list A)){a:A | (In a l) & (R a)}+{(AllS P l)}. -NewInduction l as [|a m [[b H1 H2]|H]]; Auto. -Left; Exists b; Auto. -NewDestruct (RS_dec a). -Left; Exists a; Auto. -Auto. +Lemma Find : forall l:list A, {a : A | In a l & R a} + {AllS P l}. +induction l as [| a m [[b H1 H2]| H]]; auto. +left; exists b; auto. +destruct (RS_dec a). +left; exists a; auto. +auto. (* Realizer find. *) @@ -315,26 +328,27 @@ Qed. Variable B : Set. Variable T : A -> B -> Prop. -Variable TS_dec : (a:A){c:B| (T a c)}+{(P a)}. - -Fixpoint try_find [l:(list A)] : (Exc B) := - Cases l of - nil => Error - | (cons a l1) => - Cases (TS_dec a) of - (inleft (exist c _)) => (Value c) - | (inright _) => (try_find l1) - end - end. - -Lemma Try_find : (l:(list A)){c:B|(EX a:A |(In a l) & (T a c))}+{(AllS P l)}. -NewInduction l as [|a m [[b H1]|H]]. -Auto. -Left; Exists b; NewDestruct H1 as [a' H2 H3]; Exists a'; Auto. -NewDestruct (TS_dec a) as [[c H1]|]. -Left; Exists c. -Exists a; Auto. -Auto. +Variable TS_dec : forall a:A, {c : B | T a c} + {P a}. + +Fixpoint try_find (l:list A) : Exc B := + match l with + | nil => error + | a :: l1 => + match TS_dec a with + | inleft (exist c _) => value c + | inright _ => try_find l1 + end + end. + +Lemma Try_find : + forall l:list A, {c : B | exists2 a : A | In a l & T a c} + {AllS P l}. +induction l as [| a m [[b H1]| H]]. +auto. +left; exists b; destruct H1 as [a' H2 H3]; exists a'; auto. +destruct (TS_dec a) as [[c H1]| ]. +left; exists c. +exists a; auto. +auto. (* Realizer try_find. *) @@ -345,17 +359,20 @@ End Find_sec. Section Assoc_sec. Variable B : Set. -Fixpoint assoc [a:A;l:(list A*B)] : (Exc B) := - Cases l of nil => Error - | (cons (a',b) m) => (ifdec (eqA_dec a a') (Value b) (assoc a m)) - end. +Fixpoint assoc (a:A) (l:list (A * B)) {struct l} : + Exc B := + match l with + | nil => error + | (a', b) :: m => ifdec (eqA_dec a a') (value b) (assoc a m) + end. -Inductive AllS_assoc [P:A -> Prop]: (list A*B) -> Prop := - allS_assoc_nil : (AllS_assoc P (nil A*B)) - | allS_assoc_cons : (a:A)(b:B)(l:(list A*B)) - (P a)->(AllS_assoc P l)->(AllS_assoc P (cons (a,b) l)). +Inductive AllS_assoc (P:A -> Prop) : list (A * B) -> Prop := + | allS_assoc_nil : AllS_assoc P nil + | allS_assoc_cons : + forall (a:A) (b:B) (l:list (A * B)), + P a -> AllS_assoc P l -> AllS_assoc P ((a, b) :: l). -Hints Resolve allS_assoc_nil allS_assoc_cons. +Hint Resolve allS_assoc_nil allS_assoc_cons. (* The specification seems too weak: it is enough to return b if the list has at least an element (a,b); probably the intention is to have @@ -364,13 +381,14 @@ Hints Resolve allS_assoc_nil allS_assoc_cons. (a:A)(l:(list A*B)){b:B|(In_spec (a,b) l)}+{(AllS_assoc [a':A]~(a=a') l)}. *) -Lemma Assoc : (a:A)(l:(list A*B))(B+{(AllS_assoc [a':A]~(a=a') l)}). -NewInduction l as [|[a' b] m assrec]. Auto. -NewDestruct (eqA_dec a a'). -Left; Exact b. -NewDestruct assrec as [b'|]. -Left; Exact b'. -Right; Auto. +Lemma Assoc : + forall (a:A) (l:list (A * B)), B + {AllS_assoc (fun a':A => a <> a') l}. +induction l as [| [a' b] m assrec]. auto. +destruct (eqA_dec a a'). +left; exact b. +destruct assrec as [b'| ]. +left; exact b'. +right; auto. (* Realizer assoc. *) @@ -380,7 +398,6 @@ End Assoc_sec. End Lists. -Hints Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons - : datatypes. -Hints Immediate fst_nth_nth : datatypes. - +Hint Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons: + datatypes. +Hint Immediate fst_nth_nth: datatypes. diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v index 9f6217320..932db000f 100644 --- a/theories/Logic/Berardi.v +++ b/theories/Logic/Berardi.v @@ -31,62 +31,55 @@ Set Implicit Arguments. Section Berardis_paradox. (** Excluded middle *) -Hypothesis EM : (P:Prop) P \/ ~P. +Hypothesis EM : forall P:Prop, P \/ ~ P. (** Conditional on any proposition. *) -Definition IFProp := [P,B:Prop][e1,e2:P] - Cases (EM B) of - (or_introl _) => e1 - | (or_intror _) => e2 +Definition IFProp (P B:Prop) (e1 e2:P) := + match EM B with + | or_introl _ => e1 + | or_intror _ => e2 end. (** Axiom of choice applied to disjunction. Provable in Coq because of dependent elimination. *) -Lemma AC_IF : (P,B:Prop)(e1,e2:P)(Q:P->Prop) - ( B -> (Q e1))-> - (~B -> (Q e2))-> - (Q (IFProp B e1 e2)). +Lemma AC_IF : + forall (P B:Prop) (e1 e2:P) (Q:P -> Prop), + (B -> Q e1) -> (~ B -> Q e2) -> Q (IFProp B e1 e2). Proof. -Intros P B e1 e2 Q p1 p2. -Unfold IFProp. -Case (EM B); Assumption. +intros P B e1 e2 Q p1 p2. +unfold IFProp in |- *. +case (EM B); assumption. Qed. (** We assume a type with two elements. They play the role of booleans. The main theorem under the current assumptions is that [T=F] *) -Variable Bool: Prop. -Variable T: Bool. -Variable F: Bool. +Variable Bool : Prop. +Variable T : Bool. +Variable F : Bool. (** The powerset operator *) -Definition pow [P:Prop] :=P->Bool. +Definition pow (P:Prop) := P -> Bool. (** A piece of theory about retracts *) Section Retracts. -Variable A,B: Prop. +Variables A B : Prop. -Record retract : Prop := { - i: A->B; - j: B->A; - inv: (a:A)(j (i a))==a - }. +Record retract : Prop := + {i : A -> B; j : B -> A; inv : forall a:A, j (i a) = a}. -Record retract_cond : Prop := { - i2: A->B; - j2: B->A; - inv2: retract -> (a:A)(j2 (i2 a))==a - }. +Record retract_cond : Prop := + {i2 : A -> B; j2 : B -> A; inv2 : retract -> forall a:A, j2 (i2 a) = a}. (** The dependent elimination above implies the axiom of choice: *) -Lemma AC: (r:retract_cond) retract -> (a:A)((j2 r) ((i2 r) a))==a. +Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a. Proof. -Intros r. -Case r; Simpl. -Trivial. +intros r. +case r; simpl in |- *. +trivial. Qed. End Retracts. @@ -96,75 +89,71 @@ End Retracts. which is provable in classical logic ( => is already provable in intuitionnistic logic). *) -Lemma L1 : (A,B:Prop)(retract_cond (pow A) (pow B)). +Lemma L1 : forall A B:Prop, retract_cond (pow A) (pow B). Proof. -Intros A B. -Elim (EM (retract (pow A) (pow B))). -Intros (f0, g0, e). -Exists f0 g0. -Trivial. - -Intros hf. -Exists ([x:(pow A); y:B]F) ([x:(pow B); y:A]F). -Intros; Elim hf; Auto. +intros A B. +elim (EM (retract (pow A) (pow B))). +intros [f0 g0 e]. +exists f0 g0. +trivial. + +intros hf. +exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F). +intros; elim hf; auto. Qed. (** The paradoxical set *) -Definition U := (P:Prop)(pow P). +Definition U := forall P:Prop, pow P. (** Bijection between [U] and [(pow U)] *) -Definition f : U -> (pow U) := - [u](u U). +Definition f (u:U) : pow U := u U. -Definition g : (pow U) -> U := - [h,X] - let lX = (j2 (L1 X U)) in - let rU = (i2 (L1 U U)) in - (lX (rU h)). +Definition g (h:pow U) : U := + fun X => let lX := j2 (L1 X U) in let rU := i2 (L1 U U) in lX (rU h). (** We deduce that the powerset of [U] is a retract of [U]. This lemma is stated in Berardi's article, but is not used afterwards. *) -Lemma retract_pow_U_U : (retract (pow U) U). +Lemma retract_pow_U_U : retract (pow U) U. Proof. -Exists g f. -Intro a. -Unfold f g; Simpl. -Apply AC. -Exists ([x:(pow U)]x) ([x:(pow U)]x). -Trivial. +exists g f. +intro a. +unfold f, g in |- *; simpl in |- *. +apply AC. +exists (fun x:pow U => x) (fun x:pow U => x). +trivial. Qed. (** Encoding of Russel's paradox *) (** The boolean negation. *) -Definition Not_b := [b:Bool](IFProp b==T F T). +Definition Not_b (b:Bool) := IFProp (b = T) F T. (** the set of elements not belonging to itself *) -Definition R : U := (g ([u:U](Not_b (u U u)))). +Definition R : U := g (fun u:U => Not_b (u U u)). -Lemma not_has_fixpoint : (R R)==(Not_b (R R)). +Lemma not_has_fixpoint : R R = Not_b (R R). Proof. -Unfold 1 R. -Unfold g. -Rewrite AC with r:=(L1 U U) a:=[u:U](Not_b (u U u)). -Trivial. -Exists ([x:(pow U)]x) ([x:(pow U)]x); Trivial. +unfold R at 1 in |- *. +unfold g in |- *. +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. Qed. -Theorem classical_proof_irrelevence : T==F. +Theorem classical_proof_irrelevence : T = F. Proof. -Generalize not_has_fixpoint. -Unfold Not_b. -Apply AC_IF. -Intros is_true is_false. -Elim is_true; Elim is_false; Trivial. - -Intros not_true is_true. -Elim not_true; Trivial. +generalize not_has_fixpoint. +unfold Not_b in |- *. +apply AC_IF. +intros is_true is_false. +elim is_true; elim is_false; trivial. + +intros not_true is_true. +elim not_true; trivial. Qed. -End Berardis_paradox. +End Berardis_paradox.
\ No newline at end of file diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index 699051ec1..192603273 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -18,64 +18,66 @@ though definite description conflicts with classical logic *) Definition RelationalChoice := - (A:Type;B:Type;R: A->B->Prop) - ((x:A)(EX y:B|(R x y))) - -> (EXT R':A->B->Prop | - ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))). + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists y : B | R x y) -> + exists R' : A -> B -> Prop + | (forall x:A, + exists y : B | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). Definition FunctionalChoice := - (A:Type;B:Type;R: A->B->Prop) - ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))). + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists y : B | R x y) -> + exists f : A -> B | (forall x:A, R x (f x)). Definition ParamDefiniteDescription := - (A:Type;B:Type;R: A->B->Prop) - ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y'))) - -> (EX f:A->B | (x:A)(R x (f x))). - -Lemma description_rel_choice_imp_funct_choice : - ParamDefiniteDescription->RelationalChoice->FunctionalChoice. -Intros Descr RelCh. -Red; Intros A B R H. -NewDestruct (RelCh A B R H) as [R' H0]. -NewDestruct (Descr A B R') as [f H1]. -Intro x. -Elim (H0 x); Intros y [H2 [H3 H4]]; Exists y; Split; [Exact H3 | Exact H4]. -Exists f; Intro x. -Elim (H0 x); Intros y [H2 [H3 H4]]. -Rewrite <- (H4 (f x) (H1 x)). -Exact H2. + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists y : B | R x y /\ (forall y':B, R x y' -> y = y')) -> + exists f : A -> B | (forall x:A, R x (f x)). + +Lemma description_rel_choice_imp_funct_choice : + ParamDefiniteDescription -> RelationalChoice -> FunctionalChoice. +intros Descr RelCh. +red in |- *; intros A B R H. +destruct (RelCh A B R H) as [R' H0]. +destruct (Descr A B R') as [f H1]. +intro x. +elim (H0 x); intros y [H2 [H3 H4]]; exists y; split; [ exact H3 | exact H4 ]. +exists f; intro x. +elim (H0 x); intros y [H2 [H3 H4]]. +rewrite <- (H4 (f x) (H1 x)). +exact H2. Qed. -Lemma funct_choice_imp_rel_choice : - FunctionalChoice->RelationalChoice. -Intros FunCh. -Red; Intros A B R H. -NewDestruct (FunCh A B R H) as [f H0]. -Exists [x,y]y=(f x). -Intro x; Exists (f x); -Split; [Apply H0| Split;[Reflexivity| Intros y H1; Symmetry; Exact H1]]. +Lemma funct_choice_imp_rel_choice : FunctionalChoice -> RelationalChoice. +intros FunCh. +red in |- *; intros A B R H. +destruct (FunCh A B R H) as [f H0]. +exists (fun x y => y = f x). +intro x; exists (f x); split; + [ apply H0 + | split; [ reflexivity | intros y H1; symmetry in |- *; exact H1 ] ]. Qed. -Lemma funct_choice_imp_description : - FunctionalChoice->ParamDefiniteDescription. -Intros FunCh. -Red; Intros A B R H. -NewDestruct (FunCh A B R) as [f H0]. +Lemma funct_choice_imp_description : + FunctionalChoice -> ParamDefiniteDescription. +intros FunCh. +red in |- *; intros A B R H. +destruct (FunCh A B R) as [f H0]. (* 1 *) -Intro x. -Elim (H x); Intros y [H0 H1]. -Exists y; Exact H0. +intro x. +elim (H x); intros y [H0 H1]. +exists y; exact H0. (* 2 *) -Exists f; Exact H0. +exists f; exact H0. Qed. Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr : - FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription. -Split. -Intro H; Split; [ - Exact (funct_choice_imp_rel_choice H) - | Exact (funct_choice_imp_description H)]. -Intros [H H0]; Exact (description_rel_choice_imp_funct_choice H0 H). + FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription. +split. +intro H; split; + [ exact (funct_choice_imp_rel_choice H) + | exact (funct_choice_imp_description H) ]. +intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H). Qed. (* We show that the guarded relational formulation of the axiom of Choice @@ -83,52 +85,55 @@ Qed. independance of premises or proof-irrelevance *) Definition GuardedRelationalChoice := - (A:Type;B:Type;P:A->Prop;R: A->B->Prop) - ((x:A)(P x)->(EX y:B|(R x y))) - -> (EXT R':A->B->Prop | - ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))). + forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop), + (forall x:A, P x -> exists y : B | R x y) -> + exists R' : A -> B -> Prop + | (forall x:A, + P x -> + exists y : B | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). -Definition ProofIrrelevance := (A:Prop)(a1,a2:A) a1==a2. +Definition ProofIrrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. -Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : - RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice. +Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : + RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice. Proof. -Intros rel_choice proof_irrel. -Red; Intros A B P R H. -NewDestruct (rel_choice ? ? [x:(sigT ? P);y:B](R (projT1 ? ? x) y)) as [R' H0]. -Intros [x HPx]. -NewDestruct (H x HPx) as [y HRxy]. -Exists y; Exact HRxy. -Pose R'':=[x:A;y:B](EXT H:(P x) | (R' (existT ? P x H) y)). -Exists R''; Intros x HPx. -NewDestruct (H0 (existT ? P x HPx)) as [y [HRxy [HR'xy Huniq]]]. -Exists y. Split. - Exact HRxy. - Split. - Red; Exists HPx; Exact HR'xy. - Intros y' HR''xy'. - Apply Huniq. - Unfold R'' in HR''xy'. - NewDestruct HR''xy' as [H'Px HR'xy']. - Rewrite proof_irrel with a1:=HPx a2:=H'Px. - Exact HR'xy'. +intros rel_choice proof_irrel. +red in |- *; intros A B P R H. +destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as [R' H0]. +intros [x HPx]. +destruct (H x HPx) as [y HRxy]. +exists y; exact HRxy. +pose (R'' := fun (x:A) (y:B) => exists H : P x | R' (existT P x H) y). +exists R''; intros x HPx. +destruct (H0 (existT P x HPx)) as [y [HRxy [HR'xy Huniq]]]. +exists y. split. + exact HRxy. + split. + red in |- *; exists HPx; exact HR'xy. + intros y' HR''xy'. + apply Huniq. + unfold R'' in HR''xy'. + destruct HR''xy' as [H'Px HR'xy']. + rewrite proof_irrel with (a1 := HPx) (a2 := H'Px). + exact HR'xy'. Qed. Definition IndependenceOfPremises := - (A:Type)(P:A->Prop)(Q:Prop)(Q->(EXT x|(P x)))->(EXT x|Q->(P x)). + forall (A:Type) (P:A -> Prop) (Q:Prop), + (Q -> exists x : _ | P x) -> exists x : _ | Q -> P x. Lemma rel_choice_indep_of_premises_imp_guarded_rel_choice : - RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice. + RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice. Proof. -Intros RelCh IndPrem. -Red; Intros A B P R H. -NewDestruct (RelCh A B [x,y](P x)->(R x y)) as [R' H0]. - Intro x. Apply IndPrem. - Apply H. - Exists R'. - Intros x HPx. - NewDestruct (H0 x) as [y [H1 H2]]. - Exists y. Split. - Apply (H1 HPx). - Exact H2. -Qed. +intros RelCh IndPrem. +red in |- *; intros A B P R H. +destruct (RelCh A B (fun x y => P x -> R x y)) as [R' H0]. + intro x. apply IndPrem. + apply H. + exists R'. + intros x HPx. + destruct (H0 x) as [y [H1 H2]]. + exists y. split. + apply (H1 HPx). + exact H2. +Qed.
\ No newline at end of file diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v index 324005caf..1f3b531af 100755 --- a/theories/Logic/Classical.v +++ b/theories/Logic/Classical.v @@ -11,4 +11,4 @@ (** Classical Logic *) Require Export Classical_Prop. -Require Export Classical_Pred_Type. +Require Export Classical_Pred_Type.
\ No newline at end of file diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v index 31f58a95e..80bbce461 100644 --- a/theories/Logic/ClassicalChoice.v +++ b/theories/Logic/ClassicalChoice.v @@ -19,13 +19,14 @@ Require Export ClassicalDescription. Require Export RelationalChoice. -Require ChoiceFacts. +Require Import ChoiceFacts. -Theorem choice : - (A:Type;B:Type;R: A->B->Prop) - ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))). +Theorem choice : + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists y : B | R x y) -> + exists f : A -> B | (forall x:A, R x (f x)). Proof. -Apply description_rel_choice_imp_funct_choice. -Exact description. -Exact relational_choice. -Qed. +apply description_rel_choice_imp_funct_choice. +exact description. +exact relational_choice. +Qed.
\ No newline at end of file diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v index ea2f4f727..26e696a7c 100644 --- a/theories/Logic/ClassicalDescription.v +++ b/theories/Logic/ClassicalDescription.v @@ -22,55 +22,57 @@ Require Export Classical. -Axiom dependent_description : - (A:Type;B:A->Type;R: (x:A)(B x)->Prop) - ((x:A)(EX y:(B x)|(R x y)/\ ((y':(B x))(R x y') -> y=y'))) - -> (EX f:(x:A)(B x) | (x:A)(R x (f x))). +Axiom + dependent_description : + forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop), + (forall x:A, + exists y : B x | R x y /\ (forall y':B x, R x y' -> y = y')) -> + exists f : forall x:A, B x | (forall x:A, R x (f x)). (** Principle of definite description (aka axiom of unique choice) *) Theorem description : - (A:Type;B:Type;R: A->B->Prop) - ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y'))) - -> (EX f:A->B | (x:A)(R x (f x))). + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists y : B | R x y /\ (forall y':B, R x y' -> y = y')) -> + exists f : A -> B | (forall x:A, R x (f x)). Proof. -Intros A B. -Apply (dependent_description A [_]B). +intros A B. +apply (dependent_description A (fun _ => B)). Qed. (** The followig proof comes from [1] *) -Theorem classic_set : (((P:Prop){P}+{~P}) -> False) -> False. +Theorem classic_set : ((forall P:Prop, {P} + {~ P}) -> False) -> False. Proof. -Intro HnotEM. -Pose R:=[A,b]A/\true=b \/ ~A/\false=b. -Assert H:(EX f:Prop->bool|(A:Prop)(R A (f A))). -Apply description. -Intro A. -NewDestruct (classic A) as [Ha|Hnota]. - Exists true; Split. - Left; Split; [Assumption|Reflexivity]. - Intros y [[_ Hy]|[Hna _]]. - Assumption. - Contradiction. - Exists false; Split. - Right; Split; [Assumption|Reflexivity]. - Intros y [[Ha _]|[_ Hy]]. - Contradiction. - Assumption. -NewDestruct H as [f Hf]. -Apply HnotEM. -Intro P. -Assert HfP := (Hf P). +intro HnotEM. +pose (R := fun A b => A /\ true = b \/ ~ A /\ false = b). +assert (H : exists f : Prop -> bool | (forall A:Prop, R A (f A))). +apply description. +intro A. +destruct (classic A) as [Ha| Hnota]. + exists true; split. + left; split; [ assumption | reflexivity ]. + intros y [[_ Hy]| [Hna _]]. + assumption. + contradiction. + exists false; split. + right; split; [ assumption | reflexivity ]. + intros y [[Ha _]| [_ Hy]]. + contradiction. + assumption. +destruct H as [f Hf]. +apply HnotEM. +intro P. +assert (HfP := Hf P). (* Elimination from Hf to Set is not allowed but from f to Set yes ! *) -NewDestruct (f P). - Left. - NewDestruct HfP as [[Ha _]|[_ Hfalse]]. - Assumption. - Discriminate. - Right. - NewDestruct HfP as [[_ Hfalse]|[Hna _]]. - Discriminate. - Assumption. +destruct (f P). + left. + destruct HfP as [[Ha _]| [_ Hfalse]]. + assumption. + discriminate. + right. + destruct HfP as [[_ Hfalse]| [Hna _]]. + discriminate. + assumption. Qed. - +
\ No newline at end of file diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index 622e6959d..0ece7ac76 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -12,49 +12,50 @@ (** [prop_degeneracy] asserts (up to consistency) that there are only *) (* two distinct formulas *) -Definition prop_degeneracy := (A:Prop) A==True \/ A==False. +Definition prop_degeneracy := forall A:Prop, A = True \/ A = False. (** [prop_extensionality] asserts equivalent formulas are equal *) -Definition prop_extensionality := (A,B:Prop) (A<->B) -> A==B. +Definition prop_extensionality := forall A B:Prop, (A <-> B) -> A = B. (** [excluded_middle] asserts we can reason by case on the truth *) (* or falsity of any formula *) -Definition excluded_middle := (A:Prop) A \/ ~A. +Definition excluded_middle := forall A:Prop, A \/ ~ A. (** [proof_irrelevance] asserts equality of all proofs of a given formula *) -Definition proof_irrelevance := (A:Prop)(a1,a2:A) a1==a2. +Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. (** We show [prop_degeneracy <-> (prop_extensionality /\ excluded_middle)] *) Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality. Proof. -Intros H A B (Hab,Hba). -NewDestruct (H A); NewDestruct (H B). - Rewrite H1; Exact H0. - Absurd B. - Rewrite H1; Exact [H]H. - Apply Hab; Rewrite H0; Exact I. - Absurd A. - Rewrite H0; Exact [H]H. - Apply Hba; Rewrite H1; Exact I. - Rewrite H1; Exact H0. +intros H A B [Hab Hba]. +destruct (H A); destruct (H B). + rewrite H1; exact H0. + absurd B. + rewrite H1; exact (fun H => H). + apply Hab; rewrite H0; exact I. + absurd A. + rewrite H0; exact (fun H => H). + apply Hba; rewrite H1; exact I. + rewrite H1; exact H0. Qed. Lemma prop_degen_em : prop_degeneracy -> excluded_middle. Proof. -Intros H A. -NewDestruct (H A). - Left; Rewrite H0; Exact I. - Right; Rewrite H0; Exact [x]x. +intros H A. +destruct (H A). + left; rewrite H0; exact I. + right; rewrite H0; exact (fun x => x). Qed. Lemma prop_ext_em_degen : - prop_extensionality -> excluded_middle -> prop_degeneracy. + prop_extensionality -> excluded_middle -> prop_degeneracy. Proof. -Intros Ext EM A. -NewDestruct (EM A). - Left; Apply (Ext A True); Split; [Exact [_]I | Exact [_]H]. - Right; Apply (Ext A False); Split; [Exact H | Apply False_ind]. +intros Ext EM A. +destruct (EM A). + left; apply (Ext A True); split; + [ exact (fun _ => I) | exact (fun _ => H) ]. + right; apply (Ext A False); split; [ exact H | apply False_ind ]. Qed. (** We successively show that: @@ -67,45 +68,40 @@ Qed. (e.g. take the Y combinator of lambda-calculus) *) -Definition inhabited [A:Prop] := A. +Definition inhabited (A:Prop) := A. Lemma prop_ext_A_eq_A_imp_A : - prop_extensionality->(A:Prop)(inhabited A)->(A->A)==A. + prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A. Proof. -Intros Ext A a. -Apply (Ext A->A A); Split; [ Exact [_]a | Exact [_;_]a ]. +intros Ext A a. +apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ]. Qed. -Record retract [A,B:Prop] : Prop := { - f1: A->B; - f2: B->A; - f1_o_f2: (x:B)(f1 (f2 x))==x -}. +Record retract (A B:Prop) : Prop := + {f1 : A -> B; f2 : B -> A; f1_o_f2 : forall x:B, f1 (f2 x) = x}. Lemma prop_ext_retract_A_A_imp_A : - prop_extensionality->(A:Prop)(inhabited A)->(retract A A->A). + prop_extensionality -> forall A:Prop, inhabited A -> retract A (A -> A). Proof. -Intros Ext A a. -Rewrite -> (prop_ext_A_eq_A_imp_A Ext A a). -Exists [x:A]x [x:A]x. -Reflexivity. +intros Ext A a. +rewrite (prop_ext_A_eq_A_imp_A Ext A a). +exists (fun x:A => x) (fun x:A => x). +reflexivity. Qed. -Record has_fixpoint [A:Prop] : Prop := { - F : (A->A)->A; - fix : (f:A->A)(F f)==(f (F f)) -}. +Record has_fixpoint (A:Prop) : Prop := + {F : (A -> A) -> A; Fix : forall f:A -> A, F f = f (F f)}. Lemma ext_prop_fixpoint : - prop_extensionality->(A:Prop)(inhabited A)->(has_fixpoint A). + prop_extensionality -> forall A:Prop, inhabited A -> has_fixpoint A. Proof. -Intros Ext A a. -Case (prop_ext_retract_A_A_imp_A Ext A a); Intros g1 g2 g1_o_g2. -Exists [f]([x:A](f (g1 x x)) (g2 [x](f (g1 x x)))). -Intro f. -Pattern 1 (g1 (g2 [x:A](f (g1 x x)))). -Rewrite (g1_o_g2 [x:A](f (g1 x x))). -Reflexivity. +intros Ext A a. +case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2. +exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))). +intro f. +pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *. +rewrite (g1_o_g2 (fun x:A => f (g1 x x))). +reflexivity. Qed. (** Assume we have booleans with the property that there is at most 2 @@ -122,36 +118,40 @@ Section Proof_irrelevance_gen. Variable bool : Prop. Variable true : bool. Variable false : bool. -Hypothesis bool_elim : (C:Prop)C->C->bool->C. -Hypothesis bool_elim_redl : (C:Prop)(c1,c2:C)c1==(bool_elim C c1 c2 true). -Hypothesis bool_elim_redr : (C:Prop)(c1,c2:C)c2==(bool_elim C c1 c2 false). -Local bool_dep_induction := (P:bool->Prop)(P true)->(P false)->(b:bool)(P b). - -Lemma aux : prop_extensionality -> bool_dep_induction -> true==false. +Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C. +Hypothesis + bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true. +Hypothesis + bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false. +Let bool_dep_induction := + forall P:bool -> Prop, P true -> P false -> forall b:bool, P b. + +Lemma aux : prop_extensionality -> bool_dep_induction -> true = false. Proof. -Intros Ext Ind. -Case (ext_prop_fixpoint Ext bool true); Intros G Gfix. -Pose neg := [b:bool](bool_elim bool false true b). -Generalize (refl_eqT ? (G neg)). -Pattern 1 (G neg). -Apply Ind with b:=(G neg); Intro Heq. -Rewrite (bool_elim_redl bool false true). -Change true==(neg true); Rewrite -> Heq; Apply Gfix. -Rewrite (bool_elim_redr bool false true). -Change (neg false)==false; Rewrite -> Heq; Symmetry; Apply Gfix. +intros Ext Ind. +case (ext_prop_fixpoint Ext bool true); intros G Gfix. +pose (neg := fun b:bool => bool_elim bool false true b). +generalize (refl_equal (G neg)). +pattern (G neg) at 1 in |- *. +apply Ind with (b := G neg); intro Heq. +rewrite (bool_elim_redl bool false true). +change (true = neg true) in |- *; rewrite Heq; apply Gfix. +rewrite (bool_elim_redr bool false true). +change (neg false = false) in |- *; rewrite Heq; symmetry in |- *; + apply Gfix. Qed. Lemma ext_prop_dep_proof_irrel_gen : - prop_extensionality -> bool_dep_induction -> proof_irrelevance. + prop_extensionality -> bool_dep_induction -> proof_irrelevance. Proof. -Intros Ext Ind A a1 a2. -Pose f := [b:bool](bool_elim A a1 a2 b). -Rewrite (bool_elim_redl A a1 a2). -Change (f true)==a2. -Rewrite (bool_elim_redr A a1 a2). -Change (f true)==(f false). -Rewrite (aux Ext Ind). -Reflexivity. +intros Ext Ind A a1 a2. +pose (f := fun b:bool => bool_elim A a1 a2 b). +rewrite (bool_elim_redl A a1 a2). +change (f true = a2) in |- *. +rewrite (bool_elim_redr A a1 a2). +change (f true = f false) in |- *. +rewrite (aux Ext Ind). +reflexivity. Qed. End Proof_irrelevance_gen. @@ -163,22 +163,23 @@ End Proof_irrelevance_gen. Section Proof_irrelevance_CC. -Definition BoolP := (C:Prop)C->C->C. -Definition TrueP := [C][c1,c2]c1 : BoolP. -Definition FalseP := [C][c1,c2]c2 : BoolP. -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) - := [C;c1,c2](refl_eqT C c1). -Definition BoolP_elim_redr : (C:Prop)(c1,c2:C)c2==(BoolP_elim C c1 c2 FalseP) - := [C;c1,c2](refl_eqT C c2). +Definition BoolP := forall C:Prop, C -> C -> C. +Definition TrueP : BoolP := fun C c1 c2 => c1. +Definition FalseP : BoolP := fun C c1 c2 => c2. +Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2. +Definition BoolP_elim_redl (C:Prop) (c1 c2:C) : + c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1. +Definition BoolP_elim_redr (C:Prop) (c1 c2:C) : + c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2. -Definition BoolP_dep_induction := - (P:BoolP->Prop)(P TrueP)->(P FalseP)->(b:BoolP)(P b). +Definition BoolP_dep_induction := + forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b. Lemma ext_prop_dep_proof_irrel_cc : - prop_extensionality -> BoolP_dep_induction -> proof_irrelevance. -Proof (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim - BoolP_elim_redl BoolP_elim_redr). + prop_extensionality -> BoolP_dep_induction -> proof_irrelevance. +Proof + ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl + BoolP_elim_redr. End Proof_irrelevance_CC. @@ -189,16 +190,20 @@ End Proof_irrelevance_CC. Section Proof_irrelevance_CIC. -Inductive boolP : Prop := trueP : boolP | falseP : boolP. -Definition boolP_elim_redl : (C:Prop)(c1,c2:C)c1==(boolP_ind C c1 c2 trueP) - := [C;c1,c2](refl_eqT C c1). -Definition boolP_elim_redr : (C:Prop)(c1,c2:C)c2==(boolP_ind C c1 c2 falseP) - := [C;c1,c2](refl_eqT C c2). +Inductive boolP : Prop := + | trueP : boolP + | falseP : boolP. +Definition boolP_elim_redl (C:Prop) (c1 c2:C) : + c1 = boolP_ind C c1 c2 trueP := refl_equal c1. +Definition boolP_elim_redr (C:Prop) (c1 c2:C) : + c2 = boolP_ind C c1 c2 falseP := refl_equal c2. Scheme boolP_indd := Induction for boolP Sort Prop. Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance. -Proof [pe](ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind - boolP_elim_redl boolP_elim_redr pe boolP_indd). +Proof + fun pe => + ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl + boolP_elim_redr pe boolP_indd. End Proof_irrelevance_CIC. @@ -211,4 +216,4 @@ End Proof_irrelevance_CIC. satisfy propositional degeneracy without satisfying proof-irrelevance (nor dependent case analysis). This would imply that the previous results cannot be refined. -*) +*)
\ No newline at end of file diff --git a/theories/Logic/Classical_Pred_Set.v b/theories/Logic/Classical_Pred_Set.v index 7ca160517..e308eff14 100755 --- a/theories/Logic/Classical_Pred_Set.v +++ b/theories/Logic/Classical_Pred_Set.v @@ -10,55 +10,61 @@ (** Classical Predicate Logic on Set*) -Require Classical_Prop. +Require Import Classical_Prop. Section Generic. -Variable U: Set. +Variable U : Set. (** de Morgan laws for quantifiers *) -Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EX n:U | ~(P n)). +Lemma not_all_ex_not : + forall P:U -> Prop, ~ (forall n:U, P n) -> exists n : U | ~ P n. Proof. -Unfold not; Intros P notall. -Apply NNPP; Unfold not. -Intro abs. -Cut ((n:U)(P n)); Auto. -Intro n; Apply NNPP. -Unfold not; Intros. -Apply abs; Exists n; Trivial. +unfold not in |- *; intros P notall. +apply NNPP; unfold not in |- *. +intro abs. +cut (forall n:U, P n); auto. +intro n; apply NNPP. +unfold not in |- *; intros. +apply abs; exists n; trivial. Qed. -Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EX n:U |(P n)). +Lemma not_all_not_ex : + forall P:U -> Prop, ~ (forall n:U, ~ P n) -> exists n : U | P n. Proof. -Intros P H. -Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n. -Apply NNPP; Trivial. +intros P H. +elim (not_all_ex_not (fun n:U => ~ P n) H); intros n Pn; exists n. +apply NNPP; trivial. Qed. -Lemma not_ex_all_not : (P:U->Prop) (~(EX n:U |(P n))) -> (n:U)~(P n). +Lemma not_ex_all_not : + forall P:U -> Prop, ~ ( exists n : U | P n) -> forall n:U, ~ P n. Proof. -Unfold not; Intros P notex n abs. -Apply notex. -Exists n; Trivial. +unfold not in |- *; intros P notex n abs. +apply notex. +exists n; trivial. Qed. -Lemma not_ex_not_all : (P:U->Prop)(~(EX n:U | ~(P n))) -> (n:U)(P n). +Lemma not_ex_not_all : + forall P:U -> Prop, ~ ( exists n : U | ~ P n) -> forall n:U, P n. Proof. -Intros P H n. -Apply NNPP. -Red; Intro K; Apply H; Exists n; Trivial. +intros P H n. +apply NNPP. +red in |- *; intro K; apply H; exists n; trivial. Qed. -Lemma ex_not_not_all : (P:U->Prop) (EX n:U | ~(P n)) -> ~(n:U)(P n). +Lemma ex_not_not_all : + forall P:U -> Prop, ( exists n : U | ~ P n) -> ~ (forall n:U, P n). Proof. -Unfold not; Intros P exnot allP. -Elim exnot; Auto. +unfold not in |- *; intros P exnot allP. +elim exnot; auto. Qed. -Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EX n:U |(P n)). +Lemma all_not_not_ex : + forall P:U -> Prop, (forall n:U, ~ P n) -> ~ ( exists n : U | P n). Proof. -Unfold not; Intros P allnot exP; Elim exP; Intros n p. -Apply allnot with n; Auto. +unfold not in |- *; intros P allnot exP; elim exP; intros n p. +apply allnot with n; auto. Qed. -End Generic. +End Generic.
\ No newline at end of file diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v index 6745d05fd..6bfd08e43 100755 --- a/theories/Logic/Classical_Pred_Type.v +++ b/theories/Logic/Classical_Pred_Type.v @@ -10,55 +10,61 @@ (** Classical Predicate Logic on Type *) -Require Classical_Prop. +Require Import Classical_Prop. Section Generic. -Variable U: Type. +Variable U : Type. (** de Morgan laws for quantifiers *) -Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EXT n:U | ~(P n)). +Lemma not_all_ex_not : + forall P:U -> Prop, ~ (forall n:U, P n) -> exists n : U | ~ P n. Proof. -Unfold not; Intros P notall. -Apply NNPP; Unfold not. -Intro abs. -Cut ((n:U)(P n)); Auto. -Intro n; Apply NNPP. -Unfold not; Intros. -Apply abs; Exists n; Trivial. +unfold not in |- *; intros P notall. +apply NNPP; unfold not in |- *. +intro abs. +cut (forall n:U, P n); auto. +intro n; apply NNPP. +unfold not in |- *; intros. +apply abs; exists n; trivial. Qed. -Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EXT n:U | (P n)). +Lemma not_all_not_ex : + forall P:U -> Prop, ~ (forall n:U, ~ P n) -> exists n : U | P n. Proof. -Intros P H. -Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n. -Apply NNPP; Trivial. +intros P H. +elim (not_all_ex_not (fun n:U => ~ P n) H); intros n Pn; exists n. +apply NNPP; trivial. Qed. -Lemma not_ex_all_not : (P:U->Prop)(~(EXT n:U | (P n))) -> (n:U)~(P n). +Lemma not_ex_all_not : + forall P:U -> Prop, ~ ( exists n : U | P n) -> forall n:U, ~ P n. Proof. -Unfold not; Intros P notex n abs. -Apply notex. -Exists n; Trivial. +unfold not in |- *; intros P notex n abs. +apply notex. +exists n; trivial. Qed. -Lemma not_ex_not_all : (P:U->Prop)(~(EXT n:U | ~(P n))) -> (n:U)(P n). +Lemma not_ex_not_all : + forall P:U -> Prop, ~ ( exists n : U | ~ P n) -> forall n:U, P n. Proof. -Intros P H n. -Apply NNPP. -Red; Intro K; Apply H; Exists n; Trivial. +intros P H n. +apply NNPP. +red in |- *; intro K; apply H; exists n; trivial. Qed. -Lemma ex_not_not_all : (P:U->Prop) (EXT n:U | ~(P n)) -> ~(n:U)(P n). +Lemma ex_not_not_all : + forall P:U -> Prop, ( exists n : U | ~ P n) -> ~ (forall n:U, P n). Proof. -Unfold not; Intros P exnot allP. -Elim exnot; Auto. +unfold not in |- *; intros P exnot allP. +elim exnot; auto. Qed. -Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EXT n:U | (P n)). +Lemma all_not_not_ex : + forall P:U -> Prop, (forall n:U, ~ P n) -> ~ ( exists n : U | P n). Proof. -Unfold not; Intros P allnot exP; Elim exP; Intros n p. -Apply allnot with n; Auto. +unfold not in |- *; intros P allnot exP; elim exP; intros n p. +apply allnot with n; auto. Qed. -End Generic. +End Generic.
\ No newline at end of file diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v index 0a5987d01..908ad40a2 100755 --- a/theories/Logic/Classical_Prop.v +++ b/theories/Logic/Classical_Prop.v @@ -10,76 +10,76 @@ (** Classical Propositional Logic *) -Require ProofIrrelevance. +Require Import ProofIrrelevance. -Hints Unfold not : core. +Hint Unfold not: core. -Axiom classic: (P:Prop)(P \/ ~(P)). +Axiom classic : forall P:Prop, P \/ ~ P. -Lemma NNPP : (p:Prop)~(~(p))->p. +Lemma NNPP : forall p:Prop, ~ ~ p -> p. Proof. -Unfold not; Intros; Elim (classic p); Auto. -Intro NP; Elim (H NP). +unfold not in |- *; intros; elim (classic p); auto. +intro NP; elim (H NP). Qed. -Lemma not_imply_elim : (P,Q:Prop)~(P->Q)->P. +Lemma not_imply_elim : forall P Q:Prop, ~ (P -> Q) -> P. Proof. -Intros; Apply NNPP; Red. -Intro; Apply H; Intro; Absurd P; Trivial. +intros; apply NNPP; red in |- *. +intro; apply H; intro; absurd P; trivial. Qed. -Lemma not_imply_elim2 : (P,Q:Prop)~(P->Q) -> ~Q. +Lemma not_imply_elim2 : forall P Q:Prop, ~ (P -> Q) -> ~ Q. Proof. -Intros; Elim (classic Q); Auto. +intros; elim (classic Q); auto. Qed. -Lemma imply_to_or : (P,Q:Prop)(P->Q) -> ~P \/ Q. +Lemma imply_to_or : forall P Q:Prop, (P -> Q) -> ~ P \/ Q. Proof. -Intros; Elim (classic P); Auto. +intros; elim (classic P); auto. Qed. -Lemma imply_to_and : (P,Q:Prop)~(P->Q) -> P /\ ~Q. +Lemma imply_to_and : forall P Q:Prop, ~ (P -> Q) -> P /\ ~ Q. Proof. -Intros; Split. -Apply not_imply_elim with Q; Trivial. -Apply not_imply_elim2 with P; Trivial. +intros; split. +apply not_imply_elim with Q; trivial. +apply not_imply_elim2 with P; trivial. Qed. -Lemma or_to_imply : (P,Q:Prop)(~P \/ Q) -> P->Q. +Lemma or_to_imply : forall P Q:Prop, ~ P \/ Q -> P -> Q. Proof. -Induction 1; Auto. -Intros H1 H2; Elim (H1 H2). +simple induction 1; auto. +intros H1 H2; elim (H1 H2). Qed. -Lemma not_and_or : (P,Q:Prop)~(P/\Q)-> ~P \/ ~Q. +Lemma not_and_or : forall P Q:Prop, ~ (P /\ Q) -> ~ P \/ ~ Q. Proof. -Intros; Elim (classic P); Auto. +intros; elim (classic P); auto. Qed. -Lemma or_not_and : (P,Q:Prop)(~P \/ ~Q) -> ~(P/\Q). +Lemma or_not_and : forall P Q:Prop, ~ P \/ ~ Q -> ~ (P /\ Q). Proof. -Induction 1; Red; Induction 2; Auto. +simple induction 1; red in |- *; simple induction 2; auto. Qed. -Lemma not_or_and : (P,Q:Prop)~(P\/Q)-> ~P /\ ~Q. +Lemma not_or_and : forall P Q:Prop, ~ (P \/ Q) -> ~ P /\ ~ Q. Proof. -Intros; Elim (classic P); Auto. +intros; elim (classic P); auto. Qed. -Lemma and_not_or : (P,Q:Prop)(~P /\ ~Q) -> ~(P\/Q). +Lemma and_not_or : forall P Q:Prop, ~ P /\ ~ Q -> ~ (P \/ Q). Proof. -Induction 1; Red; Induction 3; Trivial. +simple induction 1; red in |- *; simple induction 3; trivial. Qed. -Lemma imply_and_or: (P,Q:Prop)(P->Q) -> P \/ Q -> Q. +Lemma imply_and_or : forall P Q:Prop, (P -> Q) -> P \/ Q -> Q. Proof. -Induction 2; Trivial. +simple induction 2; trivial. Qed. -Lemma imply_and_or2: (P,Q,R:Prop)(P->Q) -> P \/ R -> Q \/ R. +Lemma imply_and_or2 : forall P Q R:Prop, (P -> Q) -> P \/ R -> Q \/ R. Proof. -Induction 2; Auto. +simple induction 2; auto. Qed. -Lemma proof_irrelevance: (P:Prop)(p1,p2:P)p1==p2. -Proof (proof_irrelevance_cci classic). +Lemma proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2. +Proof proof_irrelevance_cci classic.
\ No newline at end of file diff --git a/theories/Logic/Classical_Type.v b/theories/Logic/Classical_Type.v index 243daa9c4..acb7beac0 100755 --- a/theories/Logic/Classical_Type.v +++ b/theories/Logic/Classical_Type.v @@ -11,4 +11,4 @@ (** Classical Logic for Type *) Require Export Classical_Prop. -Require Export Classical_Pred_Type. +Require Export Classical_Pred_Type.
\ No newline at end of file diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v index 82464b3af..ebc21f755 100644 --- a/theories/Logic/Decidable.v +++ b/theories/Logic/Decidable.v @@ -9,50 +9,52 @@ (** Properties of decidable propositions *) -Definition decidable := [P:Prop] P \/ ~P. +Definition decidable (P:Prop) := P \/ ~ P. -Theorem dec_not_not : (P:Prop)(decidable P) -> (~P -> False) -> P. -Unfold decidable; Tauto. +Theorem dec_not_not : forall P:Prop, decidable P -> (~ P -> False) -> P. +unfold decidable in |- *; tauto. Qed. -Theorem dec_True: (decidable True). -Unfold decidable; Auto. +Theorem dec_True : decidable True. +unfold decidable in |- *; auto. Qed. -Theorem dec_False: (decidable False). -Unfold decidable not; Auto. +Theorem dec_False : decidable False. +unfold decidable, not in |- *; auto. Qed. -Theorem dec_or: (A,B:Prop)(decidable A) -> (decidable B) -> (decidable (A\/B)). -Unfold decidable; Tauto. +Theorem dec_or : + forall A B:Prop, decidable A -> decidable B -> decidable (A \/ B). +unfold decidable in |- *; tauto. Qed. -Theorem dec_and: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A/\B)). -Unfold decidable; Tauto. +Theorem dec_and : + forall A B:Prop, decidable A -> decidable B -> decidable (A /\ B). +unfold decidable in |- *; tauto. Qed. -Theorem dec_not: (A:Prop)(decidable A) -> (decidable ~A). -Unfold decidable; Tauto. +Theorem dec_not : forall A:Prop, decidable A -> decidable (~ A). +unfold decidable in |- *; tauto. Qed. -Theorem dec_imp: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A->B)). -Unfold decidable; Tauto. +Theorem dec_imp : + forall A B:Prop, decidable A -> decidable B -> decidable (A -> B). +unfold decidable in |- *; tauto. Qed. -Theorem not_not : (P:Prop)(decidable P) -> (~(~P)) -> P. -Unfold decidable; Tauto. Qed. +Theorem not_not : forall P:Prop, decidable P -> ~ ~ P -> P. +unfold decidable in |- *; tauto. Qed. -Theorem not_or : (A,B:Prop) ~(A\/B) -> ~A /\ ~B. -Tauto. Qed. +Theorem not_or : forall A B:Prop, ~ (A \/ B) -> ~ A /\ ~ B. +tauto. Qed. -Theorem not_and : (A,B:Prop) (decidable A) -> ~(A/\B) -> ~A \/ ~B. -Unfold decidable; Tauto. Qed. +Theorem not_and : forall A B:Prop, decidable A -> ~ (A /\ B) -> ~ A \/ ~ B. +unfold decidable in |- *; tauto. Qed. -Theorem not_imp : (A,B:Prop) (decidable A) -> ~(A -> B) -> A /\ ~B. -Unfold decidable;Tauto. +Theorem not_imp : forall A B:Prop, decidable A -> ~ (A -> B) -> A /\ ~ B. +unfold decidable in |- *; tauto. Qed. -Theorem imp_simp : (A,B:Prop) (decidable A) -> (A -> B) -> ~A \/ B. -Unfold decidable; Tauto. +Theorem imp_simp : forall A B:Prop, decidable A -> (A -> B) -> ~ A \/ B. +unfold decidable in |- *; tauto. Qed. - diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index ff94d8e3b..b03ec80e8 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -30,104 +30,109 @@ Section PredExt_GuardRelChoice_imp_EM. (* The axiom of extensionality for predicates *) Definition PredicateExtensionality := - (P,Q:bool->Prop)((b:bool)(P b)<->(Q b))->P==Q. + forall P Q:bool -> Prop, (forall b:bool, P b <-> Q b) -> P = Q. (* From predicate extensionality we get propositional extensionality hence proof-irrelevance *) -Require ClassicalFacts. +Require Import ClassicalFacts. Variable pred_extensionality : PredicateExtensionality. -Lemma prop_ext : (A,B:Prop) (A<->B) -> A==B. +Lemma prop_ext : forall A B:Prop, (A <-> B) -> A = B. Proof. - Intros A B H. - Change ([_]A true)==([_]B true). - Rewrite pred_extensionality with P:=[_:bool]A Q:=[_:bool]B. - Reflexivity. - Intros _; Exact H. + intros A B H. + change ((fun _ => A) true = (fun _ => B) true) in |- *. + rewrite + pred_extensionality with (P := fun _:bool => A) (Q := fun _:bool => B). + reflexivity. + intros _; exact H. Qed. -Lemma proof_irrel : (A:Prop)(a1,a2:A) a1==a2. +Lemma proof_irrel : forall (A:Prop) (a1 a2:A), a1 = a2. Proof. - Apply (ext_prop_dep_proof_irrel_cic prop_ext). + apply (ext_prop_dep_proof_irrel_cic prop_ext). Qed. (* From proof-irrelevance and relational choice, we get guarded relational choice *) -Require ChoiceFacts. +Require Import ChoiceFacts. Variable rel_choice : RelationalChoice. Lemma guarded_rel_choice : - (A:Type)(B:Type)(P:A->Prop)(R:A->B->Prop) - ((x:A)(P x)->(EX y:B|(R x y)))-> - (EXT R':A->B->Prop | - ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B)(R' x y') -> y=y')))). + forall (A B:Type) (P:A -> Prop) (R:A -> B -> Prop), + (forall x:A, P x -> exists y : B | R x y) -> + exists R' : A -> B -> Prop + | (forall x:A, + P x -> + exists y : B | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')). Proof. - Exact - (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel). + exact + (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel). Qed. (* The form of choice we need: there is a functional relation which chooses an element in any non empty subset of bool *) -Require Bool. +Require Import Bool. Lemma AC : - (EXT R:(bool->Prop)->bool->Prop | - (P:bool->Prop)(EX b : bool | (P b))-> - (EX b : bool | (P b) /\ (R P b) /\ ((b':bool)(R P b')->b=b'))). + exists R : (bool -> Prop) -> bool -> Prop + | (forall P:bool -> Prop, + ( exists b : bool | P b) -> + exists b : bool | P b /\ R P b /\ (forall b':bool, R P b' -> b = b')). Proof. - Apply guarded_rel_choice with - P:= [Q:bool->Prop](EX y | (Q y)) R:=[Q:bool->Prop;y:bool](Q y). - Exact [_;H]H. + apply guarded_rel_choice with + (P := fun Q:bool -> Prop => exists y : _ | Q y) + (R := fun (Q:bool -> Prop) (y:bool) => Q y). + exact (fun _ H => H). Qed. (* The proof of the excluded middle *) (* Remark: P could have been in Set or Type *) -Theorem pred_ext_and_rel_choice_imp_EM : (P:Prop)P\/~P. +Theorem pred_ext_and_rel_choice_imp_EM : forall P:Prop, P \/ ~ P. Proof. -Intro P. +intro P. (* first we exhibit the choice functional relation R *) -NewDestruct AC as [R H]. +destruct AC as [R H]. -Pose class_of_true := [b]b=true\/P. -Pose class_of_false := [b]b=false\/P. +pose (class_of_true := fun b => b = true \/ P). +pose (class_of_false := fun b => b = false \/ P). (* the actual "decision": is (R class_of_true) = true or false? *) -NewDestruct (H class_of_true) as [b0 [H0 [H0' H0'']]]. -Exists true; Left; Reflexivity. -NewDestruct H0. +destruct (H class_of_true) as [b0 [H0 [H0' H0'']]]. +exists true; left; reflexivity. +destruct H0. (* the actual "decision": is (R class_of_false) = true or false? *) -NewDestruct (H class_of_false) as [b1 [H1 [H1' H1'']]]. -Exists false; Left; Reflexivity. -NewDestruct H1. +destruct (H class_of_false) as [b1 [H1 [H1' H1'']]]. +exists false; left; reflexivity. +destruct H1. (* case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *) -Right. -Intro HP. -Assert Hequiv:(b:bool)(class_of_true b)<->(class_of_false b). -Intro b; Split. -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. -Rewrite <- H0. -Rewrite <- H1. -Rewrite <- H0''. Reflexivity. -Rewrite Heq. -Assumption. +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. +assert (Heq : class_of_true = class_of_false). +apply pred_extensionality with (1 := Hequiv). +apply diff_true_false. +rewrite <- H0. +rewrite <- H1. +rewrite <- H0''. reflexivity. +rewrite Heq. +assumption. (* cases where P is true *) -Left; Assumption. -Left; Assumption. +left; assumption. +left; assumption. Qed. -End PredExt_GuardRelChoice_imp_EM. +End PredExt_GuardRelChoice_imp_EM.
\ No newline at end of file diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v index 40a50837d..c5afa683a 100755 --- a/theories/Logic/Eqdep.v +++ b/theories/Logic/Eqdep.v @@ -32,67 +32,68 @@ Section Dependent_Equality. Variable U : Type. -Variable P : U->Type. +Variable P : U -> Type. (** Dependent equality *) -Inductive eq_dep [p:U;x:(P p)] : (q:U)(P q)->Prop := - eq_dep_intro : (eq_dep p x p x). -Hint constr_eq_dep : core v62 := Constructors eq_dep. +Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop := + eq_dep_intro : eq_dep p x p x. +Hint Constructors eq_dep: core v62. -Lemma eq_dep_sym : (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep q y p x). +Lemma eq_dep_sym : + forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x. Proof. -Induction 1; Auto. +simple induction 1; auto. Qed. -Hints Immediate eq_dep_sym : core v62. +Hint Immediate eq_dep_sym: core v62. -Lemma eq_dep_trans : (p,q,r:U)(x:(P p))(y:(P q))(z:(P r)) - (eq_dep p x q y)->(eq_dep q y r z)->(eq_dep p x r z). +Lemma eq_dep_trans : + forall (p q r:U) (x:P p) (y:P q) (z:P r), + eq_dep p x q y -> eq_dep q y r z -> eq_dep p x r z. Proof. -Induction 1; Auto. +simple induction 1; auto. Qed. -Inductive eq_dep1 [p:U;x:(P p);q:U;y:(P q)] : Prop := - eq_dep1_intro : (h:q=p) - (x=(eq_rect U q P y p h))->(eq_dep1 p x q y). +Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop := + eq_dep1_intro : forall h:q = p, x = eq_rect q P y p h -> eq_dep1 p x q y. (** Invariance by Substitution of Reflexive Equality Proofs *) -Axiom eq_rect_eq : (p:U)(Q:U->Type)(x:(Q p))(h:p=p) - x=(eq_rect U p Q x p h). +Axiom + eq_rect_eq : + forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Lemma eq_dep1_dep : - (p:U)(x:(P p))(q:U)(y:(P q))(eq_dep1 p x q y)->(eq_dep p x q y). + forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y. Proof. -Induction 1; Intros eq_qp. -Cut (h:q=p)(y0:(P q)) - (x=(eq_rect U q P y0 p h))->(eq_dep p x q y0). -Intros; Apply H0 with eq_qp; Auto. -Rewrite eq_qp; Intros h y0. -Elim eq_rect_eq. -Induction 1; Auto. +simple induction 1; intros eq_qp. +cut (forall (h:q = p) (y0:P q), x = eq_rect q P y0 p h -> eq_dep p x q y0). +intros; apply H0 with eq_qp; auto. +rewrite eq_qp; intros h y0. +elim eq_rect_eq. +simple induction 1; auto. Qed. -Lemma eq_dep_dep1 : - (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep1 p x q y). +Lemma eq_dep_dep1 : + forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y. Proof. -Induction 1; Intros. -Apply eq_dep1_intro with (refl_equal U p). -Simpl; Trivial. +simple induction 1; intros. +apply eq_dep1_intro with (refl_equal p). +simpl in |- *; trivial. Qed. -Lemma eq_dep1_eq : (p:U)(x,y:(P p))(eq_dep1 p x p y)->x=y. +Lemma eq_dep1_eq : forall (p:U) (x y:P p), eq_dep1 p x p y -> x = y. Proof. -Induction 1; Intro. -Elim eq_rect_eq; Auto. +simple induction 1; intro. +elim eq_rect_eq; auto. Qed. (** Injectivity of Dependent Equality is a consequence of *) (** Invariance by Substitution of Reflexive Equality Proof *) -Lemma eq_dep_eq : (p:U)(x,y:(P p))(eq_dep p x p y)->x=y. +Lemma eq_dep_eq : forall (p:U) (x y:P p), eq_dep p x p y -> x = y. Proof. -Intros; Apply eq_dep1_eq; Apply eq_dep_dep1; Trivial. +intros; apply eq_dep1_eq; apply eq_dep_dep1; trivial. Qed. End Dependent_Equality. @@ -102,84 +103,88 @@ End Dependent_Equality. Scheme eq_indd := Induction for eq Sort Prop. -Lemma UIP : (U:Type)(x,y:U)(p1,p2:x=y)p1=p2. +Lemma UIP : forall (U:Type) (x y:U) (p1 p2:x = y), p1 = p2. Proof. -Intros; Apply eq_dep_eq with P:=[y]x=y. -Elim p2 using eq_indd. -Elim p1 using eq_indd. -Apply eq_dep_intro. +intros; apply eq_dep_eq with (P := fun y => x = y). +elim p2 using eq_indd. +elim p1 using eq_indd. +apply eq_dep_intro. Qed. (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) -Lemma UIP_refl : (U:Type)(x:U)(p:x=x)p=(refl_equal U x). +Lemma UIP_refl : forall (U:Type) (x:U) (p:x = x), p = refl_equal x. Proof. -Intros; Apply UIP. +intros; apply UIP. Qed. (** Streicher axiom K is a direct consequence of Uniqueness of Reflexive Identity Proofs *) -Lemma Streicher_K : (U:Type)(x:U)(P:x=x->Prop) - (P (refl_equal ? x))->(p:x=x)(P p). +Lemma Streicher_K : + forall (U:Type) (x:U) (P:x = x -> Prop), + P (refl_equal x) -> forall p:x = x, P p. Proof. -Intros; Rewrite UIP_refl; Assumption. +intros; rewrite UIP_refl; assumption. Qed. (** We finally recover eq_rec_eq (alternatively eq_rect_eq) from K *) -Lemma eq_rec_eq : (U:Type)(P:U->Set)(p:U)(x:(P p))(h:p=p) - x=(eq_rec U p P x p h). +Lemma eq_rec_eq : + forall (U:Type) (P:U -> Set) (p:U) (x:P p) (h:p = p), x = eq_rec p P x p h. Proof. -Intros. -Apply Streicher_K with p:=h. -Reflexivity. +intros. +apply Streicher_K with (p := h). +reflexivity. Qed. (** Dependent equality is equivalent to equality on dependent pairs *) -Lemma equiv_eqex_eqdep : (U:Set)(P:U->Set)(p,q:U)(x:(P p))(y:(P q)) - (existS U P p x)=(existS U P q y) <-> (eq_dep U P p x q y). +Lemma equiv_eqex_eqdep : + forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q), + existS P p x = existS P q y <-> eq_dep U P p x q y. Proof. -Split. +split. (* -> *) -Intro H. -Change p with (projS1 U P (existS U P p x)). -Change 2 x with (projS2 U P (existS U P p x)). -Rewrite H. -Apply eq_dep_intro. +intro H. +change p with (projS1 (existS P p x)) in |- *. +change x at 2 with (projS2 (existS P p x)) in |- *. +rewrite H. +apply eq_dep_intro. (* <- *) -NewDestruct 1; Reflexivity. +destruct 1; reflexivity. Qed. (** UIP implies the injectivity of equality on dependent pairs *) -Lemma inj_pair2: (U:Set)(P:U->Set)(p:U)(x,y:(P p)) - (existS U P p x)=(existS U P p y)-> x=y. +Lemma inj_pair2 : + forall (U:Set) (P:U -> Set) (p:U) (x y:P p), + existS P p x = existS P p y -> x = y. Proof. -Intros. -Apply (eq_dep_eq U P). -Generalize (equiv_eqex_eqdep U P p p x y) . -Induction 1. -Intros. -Auto. +intros. +apply (eq_dep_eq U P). +generalize (equiv_eqex_eqdep U P p p x y). +simple induction 1. +intros. +auto. Qed. (** UIP implies the injectivity of equality on dependent pairs *) -Lemma inj_pairT2: (U:Type)(P:U->Type)(p:U)(x,y:(P p)) - (existT U P p x)=(existT U P p y)-> x=y. +Lemma inj_pairT2 : + forall (U:Type) (P:U -> Type) (p:U) (x y:P p), + existT P p x = existT P p y -> x = y. Proof. -Intros. -Apply (eq_dep_eq U P). -Change 1 p with (projT1 U P (existT U P p x)). -Change 2 x with (projT2 U P (existT U P p x)). -Rewrite H. -Apply eq_dep_intro. +intros. +apply (eq_dep_eq U P). +change p at 1 with (projT1 (existT P p x)) in |- *. +change x at 2 with (projT2 (existT P p x)) in |- *. +rewrite H. +apply eq_dep_intro. Qed. (** The main results to be exported *) -Hints Resolve eq_dep_intro eq_dep_eq : core v62. -Hints Immediate eq_dep_sym : core v62. -Hints Resolve inj_pair2 inj_pairT2 : core. +Hint Resolve eq_dep_intro eq_dep_eq: core v62. +Hint Immediate eq_dep_sym: core v62. +Hint Resolve inj_pair2 inj_pairT2: core.
\ No newline at end of file diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v index 8f7e76d51..22476505f 100644 --- a/theories/Logic/Eqdep_dec.v +++ b/theories/Logic/Eqdep_dec.v @@ -25,125 +25,134 @@ Set Implicit Arguments. (** Bijection between [eq] and [eqT] *) - Definition eq2eqT: (A:Set)(x,y:A)x=y->x==y := - [A,x,_,eqxy]<[y:A]x==y>Cases eqxy of refl_equal => (refl_eqT ? x) end. - - Definition eqT2eq: (A:Set)(x,y:A)x==y->x=y := - [A,x,_,eqTxy]<[y:A]x=y>Cases eqTxy of refl_eqT => (refl_equal ? x) end. - - Lemma eq_eqT_bij: (A:Set)(x,y:A)(p:x=y)p==(eqT2eq (eq2eqT p)). -Intros. -Case p; Reflexivity. + Definition eq2eqT (A:Set) (x y:A) (eqxy:x = y) : + x = y := + match eqxy in (_ = y) return x = y with + | refl_equal => refl_equal x + end. + + Definition eqT2eq (A:Set) (x y:A) (eqTxy:x = y) : + x = y := + match eqTxy in (_ = y) return x = y with + | refl_equal => refl_equal x + end. + + Lemma eq_eqT_bij : forall (A:Set) (x y:A) (p:x = y), p = eqT2eq (eq2eqT p). +intros. +case p; reflexivity. Qed. - Lemma eqT_eq_bij: (A:Set)(x,y:A)(p:x==y)p==(eq2eqT (eqT2eq p)). -Intros. -Case p; Reflexivity. + Lemma eqT_eq_bij : forall (A:Set) (x y:A) (p:x = y), p = eq2eqT (eqT2eq p). +intros. +case p; reflexivity. Qed. Section DecidableEqDep. - Variable A: Type. + Variable A : Type. - Local comp [x,y,y':A]: x==y->x==y'->y==y' := - [eq1,eq2](eqT_ind ? ? [a]a==y' eq2 ? eq1). + 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_eqT: (x,y:A)(u:x==y)(comp u u)==(refl_eqT ? y). -Intros. -Case u; Trivial. + Remark trans_sym_eqT : forall (x y:A) (u:x = y), comp u u = refl_equal y. +intros. +case u; trivial. Qed. - Variable eq_dec: (x,y:A) x==y \/ ~x==y. + Variable eq_dec : forall x y:A, x = y \/ x <> y. - Variable x: A. + Variable x : A. - Local nu [y:A]: x==y->x==y := - [u]Cases (eq_dec x y) of - (or_introl eqxy) => eqxy - | (or_intror neqxy) => (False_ind ? (neqxy u)) - end. + Let nu (y:A) (u:x = y) : x = y := + match eq_dec x y with + | or_introl eqxy => eqxy + | or_intror neqxy => False_ind _ (neqxy u) + end. - Local nu_constant : (y:A)(u,v:x==y) (nu u)==(nu v). -Intros. -Unfold nu. -Case (eq_dec x y); Intros. -Reflexivity. + Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v. +intros. +unfold nu in |- *. +case (eq_dec x y); intros. +reflexivity. -Case n; Trivial. +case n; trivial. Qed. - Local nu_inv [y:A]: x==y->x==y := [v](comp (nu (refl_eqT ? x)) v). + Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v. - Remark nu_left_inv : (y:A)(u:x==y) (nu_inv (nu u))==u. -Intros. -Case u; Unfold nu_inv. -Apply trans_sym_eqT. + Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u. +intros. +case u; unfold nu_inv in |- *. +apply trans_sym_eqT. Qed. - Theorem eq_proofs_unicity: (y:A)(p1,p2:x==y) p1==p2. -Intros. -Elim nu_left_inv with u:=p1. -Elim nu_left_inv with u:=p2. -Elim nu_constant with y p1 p2. -Reflexivity. + Theorem eq_proofs_unicity : forall (y:A) (p1 p2:x = y), p1 = p2. +intros. +elim nu_left_inv with (u := p1). +elim nu_left_inv with (u := p2). +elim nu_constant with y p1 p2. +reflexivity. Qed. - Theorem K_dec: (P:x==x->Prop)(P (refl_eqT ? x)) -> (p:x==x)(P p). -Intros. -Elim eq_proofs_unicity with x (refl_eqT ? x) p. -Trivial. + Theorem K_dec : + forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p. +intros. +elim eq_proofs_unicity with x (refl_equal x) p. +trivial. Qed. (** The corollary *) - Local proj: (P:A->Prop)(ExT P)->(P x)->(P x) := - [P,exP,def]Cases exP of - (exT_intro x' prf) => - Cases (eq_dec x' x) of - (or_introl eqprf) => (eqT_ind ? x' P prf x eqprf) + Let proj (P:A -> Prop) (exP:ex P) (def:P x) : P x := + match exP with + | ex_intro x' prf => + match eq_dec x' x with + | or_introl eqprf => eq_ind x' P prf x eqprf | _ => def end - end. + end. - Theorem inj_right_pair: (P:A->Prop)(y,y':(P x)) - (exT_intro ? P x y)==(exT_intro ? P x y') -> y==y'. -Intros. -Cut (proj (exT_intro A P x y) y)==(proj (exT_intro A P x y') y). -Simpl. -Case (eq_dec x x). -Intro e. -Elim e using K_dec; Trivial. + Theorem inj_right_pair : + forall (P:A -> Prop) (y y':P x), + ex_intro P x y = ex_intro P x y' -> y = y'. +intros. +cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y). +simpl in |- *. +case (eq_dec x x). +intro e. +elim e using K_dec; trivial. -Intros. -Case n; Trivial. +intros. +case n; trivial. -Case H. -Reflexivity. +case H. +reflexivity. Qed. End DecidableEqDep. (** We deduce the [K] axiom for (decidable) Set *) - Theorem K_dec_set: (A:Set)((x,y:A){x=y}+{~x=y}) - ->(x:A)(P: x=x->Prop)(P (refl_equal ? x)) - ->(p:x=x)(P p). -Intros. -Rewrite eq_eqT_bij. -Elim (eq2eqT p) using K_dec. -Intros. -Case (H x0 y); Intros. -Elim e; Left ; Reflexivity. - -Right ; Red; Intro neq; Apply n; Elim neq; Reflexivity. - -Trivial. -Qed. + Theorem K_dec_set : + forall A:Set, + (forall x y:A, {x = y} + {x <> y}) -> + forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. +intros. +rewrite eq_eqT_bij. +elim (eq2eqT p) using K_dec. +intros. +case (H x0 y); intros. +elim e; left; reflexivity. + +right; red in |- *; intro neq; apply n; elim neq; reflexivity. + +trivial. +Qed.
\ No newline at end of file diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v index 44d259431..8ae8a545f 100644 --- a/theories/Logic/Hurkens.v +++ b/theories/Logic/Hurkens.v @@ -31,53 +31,55 @@ Section Paradox. Variable bool : Prop. Variable p2b : Prop -> bool. Variable b2p : bool -> Prop. -Hypothesis p2p1 : (A:Prop)(b2p (p2b A))->A. -Hypothesis p2p2 : (A:Prop)A->(b2p (p2b A)). -Variable B:Prop. +Hypothesis p2p1 : forall A:Prop, b2p (p2b A) -> A. +Hypothesis p2p2 : forall A:Prop, A -> b2p (p2b A). +Variable B : Prop. -Definition V := (A:Prop)((A->bool)->(A->bool))->(A->bool). -Definition U := V->bool. -Definition sb : V -> V := [z][A;r;a](r (z A r) a). -Definition le : (U->bool)->(U->bool) := [i][x](x [A;r;a](i [v](sb v A r a))). -Definition induct : (U->bool)->Prop := [i](x:U)(b2p (le i x))->(b2p (i x)). -Definition WF : U := [z](p2b (induct (z U le))). -Definition I : U->Prop := - [x]((i:U->bool)(b2p (le i x))->(b2p (i [v](sb v U le x))))->B. +Definition V := forall A:Prop, ((A -> bool) -> A -> bool) -> A -> bool. +Definition U := V -> bool. +Definition sb (z:V) : V := fun A r a => r (z A r) a. +Definition le (i:U -> bool) (x:U) : bool := + x (fun A r a => i (fun v => sb v A r a)). +Definition induct (i:U -> bool) : Prop := + forall x:U, b2p (le i x) -> b2p (i x). +Definition WF : U := fun z => p2b (induct (z U le)). +Definition I (x:U) : Prop := + (forall i:U -> bool, b2p (le i x) -> b2p (i (fun v => sb v U le x))) -> B. -Lemma Omega : (i:U->bool)(induct i)->(b2p (i WF)). +Lemma Omega : forall i:U -> bool, induct i -> b2p (i WF). Proof. -Intros i y. -Apply y. -Unfold le WF induct. -Apply p2p2. -Intros x H0. -Apply y. -Exact H0. +intros i y. +apply y. +unfold le, WF, induct in |- *. +apply p2p2. +intros x H0. +apply y. +exact H0. Qed. -Lemma lemma1 : (induct [u](p2b (I u))). +Lemma lemma1 : induct (fun u => p2b (I u)). Proof. -Unfold induct. -Intros x p. -Apply (p2p2 (I x)). -Intro q. -Apply (p2p1 (I [v:V](sb v U le x)) (q [u](p2b (I u)) p)). -Intro i. -Apply q with i:=[y:?](i [v:V](sb v U le y)). +unfold induct in |- *. +intros x p. +apply (p2p2 (I x)). +intro q. +apply (p2p1 (I (fun v:V => sb v U le x)) (q (fun u => p2b (I u)) p)). +intro i. +apply q with (i := fun y => i (fun v:V => sb v U le y)). Qed. -Lemma lemma2 : ((i:U->bool)(induct i)->(b2p (i WF)))->B. +Lemma lemma2 : (forall i:U -> bool, induct i -> b2p (i WF)) -> B. Proof. -Intro x. -Apply (p2p1 (I WF) (x [u](p2b (I u)) lemma1)). -Intros i H0. -Apply (x [y](i [v](sb v U le y))). -Apply (p2p1 ? H0). +intro x. +apply (p2p1 (I WF) (x (fun u => p2b (I u)) lemma1)). +intros i H0. +apply (x (fun y => i (fun v => sb v U le y))). +apply (p2p1 _ H0). Qed. Theorem paradox : B. Proof. -Exact (lemma2 Omega). +exact (lemma2 Omega). Qed. -End Paradox. +End Paradox.
\ No newline at end of file diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v index 04c62b3a1..10c9083f0 100644 --- a/theories/Logic/JMeq.v +++ b/theories/Logic/JMeq.v @@ -12,53 +12,57 @@ Set Implicit Arguments. -Inductive JMeq [A:Set;x:A] : (B:Set)B->Prop := - JMeq_refl : (JMeq x x). +Inductive JMeq (A:Set) (x:A) : forall B:Set, B -> Prop := + JMeq_refl : JMeq x x. Reset JMeq_ind. -Hints Resolve JMeq_refl. +Hint Resolve JMeq_refl. -Lemma sym_JMeq : (A,B:Set)(x:A)(y:B)(JMeq x y)->(JMeq y x). -NewDestruct 1; Trivial. +Lemma sym_JMeq : forall (A B:Set) (x:A) (y:B), JMeq x y -> JMeq y x. +destruct 1; trivial. Qed. -Hints Immediate sym_JMeq. +Hint Immediate sym_JMeq. -Lemma trans_JMeq : (A,B,C:Set)(x:A)(y:B)(z:C) - (JMeq x y)->(JMeq y z)->(JMeq x z). -NewDestruct 1; Trivial. +Lemma trans_JMeq : + forall (A B C:Set) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z. +destruct 1; trivial. Qed. -Axiom JMeq_eq : (A:Set)(x,y:A)(JMeq x y)->(x=y). +Axiom JMeq_eq : forall (A:Set) (x y:A), JMeq x y -> x = y. -Lemma JMeq_ind : (A:Set)(x,y:A)(P:A->Prop)(P x)->(JMeq x y)->(P y). -Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial. +Lemma JMeq_ind : forall (A:Set) (x y:A) (P:A -> Prop), P x -> JMeq x y -> P y. +intros A x y P H H'; case JMeq_eq with (1 := H'); trivial. Qed. -Lemma JMeq_rec : (A:Set)(x,y:A)(P:A->Set)(P x)->(JMeq x y)->(P y). -Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial. +Lemma JMeq_rec : forall (A:Set) (x y:A) (P:A -> Set), P x -> JMeq x y -> P y. +intros A x y P H H'; case JMeq_eq with (1 := H'); trivial. Qed. -Lemma JMeq_ind_r : (A:Set)(x,y:A)(P:A->Prop)(P y)->(JMeq x y)->(P x). -Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial. +Lemma JMeq_ind_r : + forall (A:Set) (x y:A) (P:A -> Prop), P y -> JMeq x y -> P x. +intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial. Qed. -Lemma JMeq_rec_r : (A:Set)(x,y:A)(P:A->Set)(P y)->(JMeq x y)->(P x). -Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial. +Lemma JMeq_rec_r : + forall (A:Set) (x y:A) (P:A -> Set), P y -> JMeq x y -> P x. +intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial. Qed. (** [JMeq] is equivalent to [(eq_dep Set [X]X)] *) -Require Eqdep. +Require Import Eqdep. -Lemma JMeq_eq_dep : (A,B:Set)(x:A)(y:B)(JMeq x y)->(eq_dep Set [X]X A x B y). +Lemma JMeq_eq_dep : + forall (A B:Set) (x:A) (y:B), JMeq x y -> eq_dep Set (fun X => X) A x B y. Proof. -NewDestruct 1. -Apply eq_dep_intro. +destruct 1. +apply eq_dep_intro. Qed. -Lemma eq_dep_JMeq : (A,B:Set)(x:A)(y:B)(eq_dep Set [X]X A x B y)->(JMeq x y). +Lemma eq_dep_JMeq : + forall (A B:Set) (x:A) (y:B), eq_dep Set (fun X => X) A x B y -> JMeq x y. Proof. -NewDestruct 1. -Apply JMeq_refl. -Qed. +destruct 1. +apply JMeq_refl. +Qed.
\ No newline at end of file diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v index ab2ca17c2..8636e5ddc 100644 --- a/theories/Logic/ProofIrrelevance.v +++ b/theories/Logic/ProofIrrelevance.v @@ -30,57 +30,62 @@ paradox of system U- (e.g. Hurkens' paradox). *) -Require Hurkens. +Require Import Hurkens. Section Proof_irrelevance_CC. Variable or : Prop -> Prop -> Prop. -Variable or_introl : (A,B:Prop)A->(or A B). -Variable or_intror : (A,B:Prop)B->(or A B). -Hypothesis or_elim : (A,B:Prop)(C:Prop)(A->C)->(B->C)->(or A B)->C. -Hypothesis or_elim_redl : - (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A) - (f a)==(or_elim A B C f g (or_introl A B a)). -Hypothesis or_elim_redr : - (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B) - (g b)==(or_elim A B C f g (or_intror A B b)). -Hypothesis or_dep_elim : - (A,B:Prop)(P:(or A B)->Prop) - ((a:A)(P (or_introl A B a))) -> - ((b:B)(P (or_intror A B b))) -> (b:(or A B))(P b). - -Hypothesis em : (A:Prop)(or A ~A). +Variable or_introl : forall A B:Prop, A -> or A B. +Variable or_intror : forall A B:Prop, B -> or A B. +Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C. +Hypothesis + or_elim_redl : + forall (A B C:Prop) (f:A -> C) (g:B -> C) (a:A), + f a = or_elim A B C f g (or_introl A B a). +Hypothesis + or_elim_redr : + forall (A B C:Prop) (f:A -> C) (g:B -> C) (b:B), + g b = or_elim A B C f g (or_intror A B b). +Hypothesis + or_dep_elim : + forall (A B:Prop) (P:or A B -> Prop), + (forall a:A, P (or_introl A B a)) -> + (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b. + +Hypothesis em : forall A:Prop, or A (~ A). Variable B : Prop. -Variable b1,b2 : B. +Variables b1 b2 : B. (** [p2b] and [b2p] form a retract if [~b1==b2] *) -Definition p2b [A] := (or_elim A ~A B [_]b1 [_]b2 (em A)). -Definition b2p [b] := b1==b. +Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A). +Definition b2p b := b1 = b. -Lemma p2p1 : (A:Prop) A -> (b2p (p2b A)). +Lemma p2p1 : forall A:Prop, A -> b2p (p2b A). Proof. - Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros. - Apply (or_elim_redl A ~A B [_]b1 [_]b2). - NewDestruct (b H). + unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A); + unfold b2p in |- *; intros. + apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)). + destruct (b H). Qed. -Lemma p2p2 : ~b1==b2->(A:Prop) (b2p (p2b A)) -> A. +Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A. Proof. - Intro not_eq_b1_b2. - Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros. - Assumption. - NewDestruct not_eq_b1_b2. - Rewrite <- (or_elim_redr A ~A B [_]b1 [_]b2) in H. - Assumption. + intro not_eq_b1_b2. + unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A); + unfold b2p in |- *; intros. + assumption. + destruct not_eq_b1_b2. + rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H. + assumption. Qed. (** Using excluded-middle a second time, we get proof-irrelevance *) -Theorem proof_irrelevance_cc : b1==b2. +Theorem proof_irrelevance_cc : b1 = b2. Proof. - Refine (or_elim ? ? ? ? ? (em b1==b2));Intro H. - Trivial. - Apply (paradox B p2b b2p (p2p2 H) p2p1). + refine (or_elim _ _ _ _ _ (em (b1 = b2))); intro H. + trivial. + apply (paradox B p2b b2p (p2p2 H) p2p1). Qed. End Proof_irrelevance_CC. @@ -92,26 +97,22 @@ End Proof_irrelevance_CC. Section Proof_irrelevance_CCI. -Hypothesis em : (A:Prop) A \/ ~A. +Hypothesis em : forall A:Prop, A \/ ~ A. -Definition or_elim_redl : - (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A) - (f a)==(or_ind A B C f g (or_introl A B a)) - := [A,B,C;f;g;a](refl_eqT C (f a)). -Definition or_elim_redr : - (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B) - (g b)==(or_ind A B C f g (or_intror A B b)) - := [A,B,C;f;g;b](refl_eqT C (g b)). +Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) + (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a). +Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) + (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b). Scheme or_indd := Induction for or Sort Prop. -Theorem proof_irrelevance_cci : (B:Prop)(b1,b2:B)b1==b2. +Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2. Proof - (proof_irrelevance_cc or or_introl or_intror or_ind - or_elim_redl or_elim_redr or_indd em). + proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl + or_elim_redr or_indd em. End Proof_irrelevance_CCI. (** Remark: in CCI, [bool] can be taken in [Set] as well in the paradox and since [~true=false] for [true] and [false] in [bool], we get the inconsistency of [em : (A:Prop){A}+{~A}] in CCI -*) +*)
\ No newline at end of file diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v index 5addb4d24..c55095e47 100644 --- a/theories/Logic/RelationalChoice.v +++ b/theories/Logic/RelationalChoice.v @@ -10,8 +10,11 @@ (* This file axiomatizes the relational form of the axiom of choice *) -Axiom relational_choice : - (A:Type;B:Type;R: A->B->Prop) - ((x:A)(EX y:B|(R x y))) - -> (EXT R':A->B->Prop | - ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))). +Axiom + relational_choice : + forall (A B:Type) (R:A -> B -> Prop), + (forall x:A, exists y : B | R x y) -> + exists R' : A -> B -> Prop + | (forall x:A, + exists y : B + | R x y /\ R' x y /\ (forall y':B, R' x y' -> y = y')).
\ No newline at end of file diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index e11194a5d..edaa3130f 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -8,198 +8,205 @@ (*i $Id$ i*) -Require BinPos. +Require Import BinPos. (**********************************************************************) (** Binary natural numbers *) -Inductive entier: Set := Nul : entier | Pos : positive -> entier. +Inductive N : Set := + | N0 : N + | Npos : positive -> N. (** Declare binding key for scope positive_scope *) -Delimits Scope N_scope with N. +Delimit Scope N_scope with N. (** Automatically open scope N_scope for the constructors of N *) -Bind Scope N_scope with entier. -Arguments Scope Pos [ N_scope ]. +Bind Scope N_scope with N. +Arguments Scope Npos [N_scope]. Open Local Scope N_scope. (** Operation x -> 2*x+1 *) -Definition Un_suivi_de := [x] - Cases x of Nul => (Pos xH) | (Pos p) => (Pos (xI p)) end. +Definition Ndouble_plus_one x := + match x with + | N0 => Npos 1%positive + | Npos p => Npos (xI p) + end. (** Operation x -> 2*x *) -Definition Zero_suivi_de := - [n] Cases n of Nul => Nul | (Pos p) => (Pos (xO p)) end. +Definition Ndouble n := match n with + | N0 => N0 + | Npos p => Npos (xO p) + end. (** Successor *) -Definition Nsucc := - [n] Cases n of Nul => (Pos xH) | (Pos p) => (Pos (add_un p)) end. +Definition Nsucc n := + match n with + | N0 => Npos 1%positive + | Npos p => Npos (Psucc p) + end. (** Addition *) -Definition Nplus := [n,m] - Cases n m of - | Nul _ => m - | _ Nul => n - | (Pos p) (Pos q) => (Pos (add p q)) +Definition Nplus n m := + match n, m with + | N0, _ => m + | _, N0 => n + | Npos p, Npos q => Npos (p + q)%positive end. -V8Infix "+" Nplus : N_scope. +Infix "+" := Nplus : N_scope. (** Multiplication *) -Definition Nmult := [n,m] - Cases n m of - | Nul _ => Nul - | _ Nul => Nul - | (Pos p) (Pos q) => (Pos (times p q)) +Definition Nmult n m := + match n, m with + | N0, _ => N0 + | _, N0 => N0 + | Npos p, Npos q => Npos (p * q)%positive end. -V8Infix "*" Nmult : N_scope. +Infix "*" := Nmult : N_scope. (** Order *) -Definition Ncompare := [n,m] - Cases n m of - | Nul Nul => EGAL - | Nul (Pos m') => INFERIEUR - | (Pos n') Nul => SUPERIEUR - | (Pos n') (Pos m') => (compare n' m' EGAL) +Definition Ncompare n m := + match n, m with + | N0, N0 => Eq + | N0, Npos m' => Lt + | Npos n', N0 => Gt + | Npos n', Npos m' => (n' ?= m')%positive Eq end. -V8Infix "?=" Ncompare (at level 70, no associativity) : N_scope. +Infix "?=" := Ncompare (at level 70, no associativity) : N_scope. (** Peano induction on binary natural numbers *) -Theorem Nind : (P:(entier ->Prop)) - (P Nul) ->((n:entier)(P n) ->(P (Nsucc n))) ->(n:entier)(P n). +Theorem Nind : + forall P:N -> Prop, + P N0 -> (forall n:N, P n -> P (Nsucc n)) -> forall n:N, P n. Proof. -NewDestruct n. - Assumption. - Apply Pind with P := [p](P (Pos p)). -Exact (H0 Nul H). -Intro p'; Exact (H0 (Pos p')). +destruct n. + assumption. + apply Pind with (P := fun p => P (Npos p)). +exact (H0 N0 H). +intro p'; exact (H0 (Npos p')). Qed. (** Properties of addition *) -Theorem Nplus_0_l : (n:entier)(Nplus Nul n)=n. +Theorem Nplus_0_l : forall n:N, N0 + n = n. Proof. -Reflexivity. +reflexivity. Qed. -Theorem Nplus_0_r : (n:entier)(Nplus n Nul)=n. +Theorem Nplus_0_r : forall n:N, n + N0 = n. Proof. -NewDestruct n; Reflexivity. +destruct n; reflexivity. Qed. -Theorem Nplus_comm : (n,m:entier)(Nplus n m)=(Nplus m n). +Theorem Nplus_comm : forall n m:N, n + m = m + n. Proof. -Intros. -NewDestruct n; NewDestruct m; Simpl; Try Reflexivity. -Rewrite add_sym; Reflexivity. +intros. +destruct n; destruct m; simpl in |- *; try reflexivity. +rewrite Pplus_comm; reflexivity. Qed. -Theorem Nplus_assoc : - (n,m,p:entier)(Nplus n (Nplus m p))=(Nplus (Nplus n m) p). +Theorem Nplus_assoc : forall n m p:N, n + (m + p) = n + m + p. Proof. -Intros. -NewDestruct n; Try Reflexivity. -NewDestruct m; Try Reflexivity. -NewDestruct p; Try Reflexivity. -Simpl; Rewrite add_assoc; Reflexivity. +intros. +destruct n; try reflexivity. +destruct m; try reflexivity. +destruct p; try reflexivity. +simpl in |- *; rewrite Pplus_assoc; reflexivity. Qed. -Theorem Nplus_succ : (n,m:entier)(Nplus (Nsucc n) m)=(Nsucc (Nplus n m)). +Theorem Nplus_succ : forall n m:N, Nsucc n + m = Nsucc (n + m). Proof. -NewDestruct n; NewDestruct m. - Simpl; Reflexivity. - Unfold Nsucc Nplus; Rewrite <- ZL12bis; Reflexivity. - Simpl; Reflexivity. - Simpl; Rewrite ZL14bis; Reflexivity. +destruct n; destruct m. + simpl in |- *; reflexivity. + unfold Nsucc, Nplus in |- *; rewrite <- Pplus_one_succ_l; reflexivity. + simpl in |- *; reflexivity. + simpl in |- *; rewrite Pplus_succ_permute_l; reflexivity. Qed. -Theorem Nsucc_inj : (n,m:entier)(Nsucc n)=(Nsucc m)->n=m. +Theorem Nsucc_inj : forall n m:N, Nsucc n = Nsucc m -> n = m. Proof. -NewDestruct n; NewDestruct m; Simpl; Intro H; - Reflexivity Orelse Injection H; Clear H; Intro H. - Symmetry in H; Contradiction add_un_not_un with p. - Contradiction add_un_not_un with p. - Rewrite add_un_inj with 1:=H; Reflexivity. +destruct n; destruct m; simpl in |- *; intro H; reflexivity || injection H; + clear H; intro H. + symmetry in H; contradiction Psucc_not_one with p. + contradiction Psucc_not_one with p. + rewrite Psucc_inj with (1 := H); reflexivity. Qed. -Theorem Nplus_reg_l : (n,m,p:entier)(Nplus n m)=(Nplus n p)->m=p. +Theorem Nplus_reg_l : forall n m p:N, n + m = n + p -> m = p. Proof. -Intro n; Pattern n; Apply Nind; Clear n; Simpl. - Trivial. - Intros n IHn m p H0; Do 2 Rewrite Nplus_succ in H0. - Apply IHn; Apply Nsucc_inj; Assumption. +intro n; pattern n in |- *; apply Nind; clear n; simpl in |- *. + trivial. + intros n IHn m p H0; do 2 rewrite Nplus_succ in H0. + apply IHn; apply Nsucc_inj; assumption. Qed. (** Properties of multiplication *) -Theorem Nmult_1_l : (n:entier)(Nmult (Pos xH) n)=n. +Theorem Nmult_1_l : forall n:N, Npos 1%positive * n = n. Proof. -NewDestruct n; Reflexivity. +destruct n; reflexivity. Qed. -Theorem Nmult_1_r : (n:entier)(Nmult n (Pos xH))=n. +Theorem Nmult_1_r : forall n:N, n * Npos 1%positive = n. Proof. -NewDestruct n; Simpl; Try Reflexivity. -Rewrite times_x_1; Reflexivity. +destruct n; simpl in |- *; try reflexivity. +rewrite Pmult_1_r; reflexivity. Qed. -Theorem Nmult_comm : (n,m:entier)(Nmult n m)=(Nmult m n). +Theorem Nmult_comm : forall n m:N, n * m = m * n. Proof. -Intros. -NewDestruct n; NewDestruct m; Simpl; Try Reflexivity. -Rewrite times_sym; Reflexivity. +intros. +destruct n; destruct m; simpl in |- *; try reflexivity. +rewrite Pmult_comm; reflexivity. Qed. -Theorem Nmult_assoc : - (n,m,p:entier)(Nmult n (Nmult m p))=(Nmult (Nmult n m) p). +Theorem Nmult_assoc : forall n m p:N, n * (m * p) = n * m * p. Proof. -Intros. -NewDestruct n; Try Reflexivity. -NewDestruct m; Try Reflexivity. -NewDestruct p; Try Reflexivity. -Simpl; Rewrite times_assoc; Reflexivity. +intros. +destruct n; try reflexivity. +destruct m; try reflexivity. +destruct p; try reflexivity. +simpl in |- *; rewrite Pmult_assoc; reflexivity. Qed. -Theorem Nmult_plus_distr_r : - (n,m,p:entier)(Nmult (Nplus n m) p)=(Nplus (Nmult n p) (Nmult m p)). +Theorem Nmult_plus_distr_r : forall n m p:N, (n + m) * p = n * p + m * p. Proof. -Intros. -NewDestruct n; Try Reflexivity. -NewDestruct m; NewDestruct p; Try Reflexivity. -Simpl; Rewrite times_add_distr_l; Reflexivity. +intros. +destruct n; try reflexivity. +destruct m; destruct p; try reflexivity. +simpl in |- *; rewrite Pmult_plus_distr_r; reflexivity. Qed. -Theorem Nmult_reg_r : (n,m,p:entier) ~p=Nul->(Nmult n p)=(Nmult m p) -> n=m. +Theorem Nmult_reg_r : forall n m p:N, p <> N0 -> n * p = m * p -> n = m. Proof. -NewDestruct p; Intros Hp H. -Contradiction Hp; Reflexivity. -NewDestruct n; NewDestruct m; Reflexivity Orelse Try Discriminate H. -Injection H; Clear H; Intro H; Rewrite simpl_times_r with 1:=H; Reflexivity. +destruct p; intros Hp H. +contradiction Hp; reflexivity. +destruct n; destruct m; reflexivity || (try discriminate H). +injection H; clear H; intro H; rewrite Pmult_reg_r with (1 := H); reflexivity. Qed. -Theorem Nmult_0_l : (n:entier) (Nmult Nul n) = Nul. +Theorem Nmult_0_l : forall n:N, N0 * n = N0. Proof. -Reflexivity. +reflexivity. Qed. (** Properties of comparison *) -Theorem Ncompare_Eq_eq : (n,m:entier) (Ncompare n m) = EGAL -> n = m. +Theorem Ncompare_Eq_eq : forall n m:N, (n ?= m) = Eq -> n = m. Proof. -NewDestruct n as [|n]; NewDestruct m as [|m]; Simpl; Intro H; - Reflexivity Orelse Try Discriminate H. - Rewrite (compare_convert_EGAL n m H); Reflexivity. +destruct n as [| n]; destruct m as [| m]; simpl in |- *; intro H; + reflexivity || (try discriminate H). + rewrite (Pcompare_Eq_eq n m H); reflexivity. Qed. - diff --git a/theories/NArith/BinPos.v b/theories/NArith/BinPos.v index b5fa6694b..6ef509d06 100644 --- a/theories/NArith/BinPos.v +++ b/theories/NArith/BinPos.v @@ -14,202 +14,212 @@ (** Original development by Pierre Crégut, CNET, Lannion, France *) Inductive positive : Set := - xI : positive -> positive -| xO : positive -> positive -| xH : positive. + | xI : positive -> positive + | xO : positive -> positive + | xH : positive. (** Declare binding key for scope positive_scope *) -Delimits Scope positive_scope with positive. +Delimit Scope positive_scope with positive. (** Automatically open scope positive_scope for type positive, xO and xI *) Bind Scope positive_scope with positive. -Arguments Scope xO [ positive_scope ]. -Arguments Scope xI [ positive_scope ]. +Arguments Scope xO [positive_scope]. +Arguments Scope xI [positive_scope]. (** Successor *) -Fixpoint add_un [x:positive]:positive := - Cases x of - (xI x') => (xO (add_un x')) - | (xO x') => (xI x') - | xH => (xO xH) +Fixpoint Psucc (x:positive) : positive := + match x with + | xI x' => xO (Psucc x') + | xO x' => xI x' + | xH => xO xH end. (** Addition *) -Fixpoint add [x:positive]:positive -> positive := [y:positive] - Cases x y of - | (xI x') (xI y') => (xO (add_carry x' y')) - | (xI x') (xO y') => (xI (add x' y')) - | (xI x') xH => (xO (add_un x')) - | (xO x') (xI y') => (xI (add x' y')) - | (xO x') (xO y') => (xO (add x' y')) - | (xO x') xH => (xI x') - | xH (xI y') => (xO (add_un y')) - | xH (xO y') => (xI y') - | xH xH => (xO xH) +Fixpoint Pplus (x y:positive) {struct x} : positive := + match x, y with + | xI x', xI y' => xO (Pplus_carry x' y') + | xI x', xO y' => xI (Pplus x' y') + | xI x', xH => xO (Psucc x') + | xO x', xI y' => xI (Pplus x' y') + | xO x', xO y' => xO (Pplus x' y') + | xO x', xH => xI x' + | xH, xI y' => xO (Psucc y') + | xH, xO y' => xI y' + | xH, xH => xO xH end -with add_carry [x:positive]:positive -> positive := [y:positive] - Cases x y of - | (xI x') (xI y') => (xI (add_carry x' y')) - | (xI x') (xO y') => (xO (add_carry x' y')) - | (xI x') xH => (xI (add_un x')) - | (xO x') (xI y') => (xO (add_carry x' y')) - | (xO x') (xO y') => (xI (add x' y')) - | (xO x') xH => (xO (add_un x')) - | xH (xI y') => (xI (add_un y')) - | xH (xO y') => (xO (add_un y')) - | xH xH => (xI xH) + + with Pplus_carry (x y:positive) {struct x} : positive := + match x, y with + | xI x', xI y' => xI (Pplus_carry x' y') + | xI x', xO y' => xO (Pplus_carry x' y') + | xI x', xH => xI (Psucc x') + | xO x', xI y' => xO (Pplus_carry x' y') + | xO x', xO y' => xI (Pplus x' y') + | xO x', xH => xO (Psucc x') + | xH, xI y' => xI (Psucc y') + | xH, xO y' => xO (Psucc y') + | xH, xH => xI xH end. -V7only [Notation "x + y" := (add x y) : positive_scope.]. -V8Infix "+" add : positive_scope. +Infix "+" := Pplus : positive_scope. Open Local Scope positive_scope. (** From binary positive numbers to Peano natural numbers *) -Fixpoint positive_to_nat [x:positive]:nat -> nat := - [pow2:nat] - Cases x of - (xI x') => (plus pow2 (positive_to_nat x' (plus pow2 pow2))) - | (xO x') => (positive_to_nat x' (plus pow2 pow2)) - | xH => pow2 - end. +Fixpoint Pmult_nat (x:positive) (pow2:nat) {struct x} : nat := + match x with + | xI x' => (pow2 + Pmult_nat x' (pow2 + pow2))%nat + | xO x' => Pmult_nat x' (pow2 + pow2)%nat + | xH => pow2 + end. -Definition convert := [x:positive] (positive_to_nat x (S O)). +Definition nat_of_P (x:positive) := Pmult_nat x 1. (** From Peano natural numbers to binary positive numbers *) -Fixpoint anti_convert [n:nat]: positive := - Cases n of - O => xH - | (S x') => (add_un (anti_convert x')) - end. +Fixpoint P_of_succ_nat (n:nat) : positive := + match n with + | O => xH + | S x' => Psucc (P_of_succ_nat x') + end. (** Operation x -> 2*x-1 *) -Fixpoint double_moins_un [x:positive]:positive := - Cases x of - (xI x') => (xI (xO x')) - | (xO x') => (xI (double_moins_un x')) - | xH => xH - end. +Fixpoint Pdouble_minus_one (x:positive) : positive := + match x with + | xI x' => xI (xO x') + | xO x' => xI (Pdouble_minus_one x') + | xH => xH + end. (** Predecessor *) -Definition sub_un := [x:positive] - Cases x of - (xI x') => (xO x') - | (xO x') => (double_moins_un x') - | xH => xH - end. +Definition Ppred (x:positive) := + match x with + | xI x' => xO x' + | xO x' => Pdouble_minus_one x' + | xH => xH + end. (** An auxiliary type for subtraction *) -Inductive positive_mask: Set := - IsNul : positive_mask - | IsPos : positive -> positive_mask - | IsNeg : positive_mask. +Inductive positive_mask : Set := + | IsNul : positive_mask + | IsPos : positive -> positive_mask + | IsNeg : positive_mask. (** Operation x -> 2*x+1 *) -Definition Un_suivi_de_mask := [x:positive_mask] - Cases x of IsNul => (IsPos xH) | IsNeg => IsNeg | (IsPos p) => (IsPos (xI p)) end. +Definition Pdouble_plus_one_mask (x:positive_mask) := + match x with + | IsNul => IsPos xH + | IsNeg => IsNeg + | IsPos p => IsPos (xI p) + end. (** Operation x -> 2*x *) -Definition Zero_suivi_de_mask := [x:positive_mask] - Cases x of IsNul => IsNul | IsNeg => IsNeg | (IsPos p) => (IsPos (xO p)) end. +Definition Pdouble_mask (x:positive_mask) := + match x with + | IsNul => IsNul + | IsNeg => IsNeg + | IsPos p => IsPos (xO p) + end. (** Operation x -> 2*x-2 *) -Definition double_moins_deux := - [x:positive] Cases x of - (xI x') => (IsPos (xO (xO x'))) - | (xO x') => (IsPos (xO (double_moins_un x'))) - | xH => IsNul - end. +Definition Pdouble_minus_two (x:positive) := + match x with + | xI x' => IsPos (xO (xO x')) + | xO x' => IsPos (xO (Pdouble_minus_one x')) + | xH => IsNul + end. (** Subtraction of binary positive numbers into a positive numbers mask *) -Fixpoint sub_pos[x,y:positive]:positive_mask := - Cases x y of - | (xI x') (xI y') => (Zero_suivi_de_mask (sub_pos x' y')) - | (xI x') (xO y') => (Un_suivi_de_mask (sub_pos x' y')) - | (xI x') xH => (IsPos (xO x')) - | (xO x') (xI y') => (Un_suivi_de_mask (sub_neg x' y')) - | (xO x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y')) - | (xO x') xH => (IsPos (double_moins_un x')) - | xH xH => IsNul - | xH _ => IsNeg +Fixpoint Pminus_mask (x y:positive) {struct y} : positive_mask := + match x, y with + | xI x', xI y' => Pdouble_mask (Pminus_mask x' y') + | xI x', xO y' => Pdouble_plus_one_mask (Pminus_mask x' y') + | xI x', xH => IsPos (xO x') + | xO x', xI y' => Pdouble_plus_one_mask (Pminus_mask_carry x' y') + | xO x', xO y' => Pdouble_mask (Pminus_mask x' y') + | xO x', xH => IsPos (Pdouble_minus_one x') + | xH, xH => IsNul + | xH, _ => IsNeg end -with sub_neg [x,y:positive]:positive_mask := - Cases x y of - (xI x') (xI y') => (Un_suivi_de_mask (sub_neg x' y')) - | (xI x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y')) - | (xI x') xH => (IsPos (double_moins_un x')) - | (xO x') (xI y') => (Zero_suivi_de_mask (sub_neg x' y')) - | (xO x') (xO y') => (Un_suivi_de_mask (sub_neg x' y')) - | (xO x') xH => (double_moins_deux x') - | xH _ => IsNeg + + with Pminus_mask_carry (x y:positive) {struct y} : positive_mask := + match x, y with + | xI x', xI y' => Pdouble_plus_one_mask (Pminus_mask_carry x' y') + | xI x', xO y' => Pdouble_mask (Pminus_mask x' y') + | xI x', xH => IsPos (Pdouble_minus_one x') + | xO x', xI y' => Pdouble_mask (Pminus_mask_carry x' y') + | xO x', xO y' => Pdouble_plus_one_mask (Pminus_mask_carry x' y') + | xO x', xH => Pdouble_minus_two x' + | xH, _ => IsNeg end. (** Subtraction of binary positive numbers x and y, returns 1 if x<=y *) -Definition true_sub := [x,y:positive] - Cases (sub_pos x y) of (IsPos z) => z | _ => xH end. +Definition Pminus (x y:positive) := + match Pminus_mask x y with + | IsPos z => z + | _ => xH + end. -V8Infix "-" true_sub : positive_scope. +Infix "-" := Pminus : positive_scope. (** Multiplication on binary positive numbers *) -Fixpoint times [x:positive] : positive -> positive:= - [y:positive] - Cases x of - (xI x') => (add y (xO (times x' y))) - | (xO x') => (xO (times x' y)) +Fixpoint Pmult (x y:positive) {struct x} : positive := + match x with + | xI x' => y + xO (Pmult x' y) + | xO x' => xO (Pmult x' y) | xH => y end. -V8Infix "*" times : positive_scope. +Infix "*" := Pmult : positive_scope. (** Division by 2 rounded below but for 1 *) -Definition Zdiv2_pos := - [z:positive]Cases z of xH => xH - | (xO p) => p - | (xI p) => p - end. +Definition Pdiv2 (z:positive) := + match z with + | xH => xH + | xO p => p + | xI p => p + end. -V8Infix "/" Zdiv2_pos : positive_scope. +Infix "/" := Pdiv2 : positive_scope. (** Comparison on binary positive numbers *) -Fixpoint compare [x,y:positive]: relation -> relation := - [r:relation] - Cases x y of - | (xI x') (xI y') => (compare x' y' r) - | (xI x') (xO y') => (compare x' y' SUPERIEUR) - | (xI x') xH => SUPERIEUR - | (xO x') (xI y') => (compare x' y' INFERIEUR) - | (xO x') (xO y') => (compare x' y' r) - | (xO x') xH => SUPERIEUR - | xH (xI y') => INFERIEUR - | xH (xO y') => INFERIEUR - | xH xH => r +Fixpoint Pcompare (x y:positive) (r:comparison) {struct y} : comparison := + match x, y with + | xI x', xI y' => Pcompare x' y' r + | xI x', xO y' => Pcompare x' y' Gt + | xI x', xH => Gt + | xO x', xI y' => Pcompare x' y' Lt + | xO x', xO y' => Pcompare x' y' r + | xO x', xH => Gt + | xH, xI y' => Lt + | xH, xO y' => Lt + | xH, xH => r end. -V8Infix "?=" compare (at level 70, no associativity) : positive_scope. +Infix "?=" := Pcompare (at level 70, no associativity) : positive_scope. (**********************************************************************) (** Miscellaneous properties of binary positive numbers *) -Lemma ZL11: (x:positive) (x=xH) \/ ~(x=xH). +Lemma ZL11 : forall p:positive, p = xH \/ p <> xH. Proof. -Intros x;Case x;Intros; (Left;Reflexivity) Orelse (Right;Discriminate). +intros x; case x; intros; (left; reflexivity) || (right; discriminate). Qed. (**********************************************************************) @@ -217,72 +227,78 @@ Qed. (** Specification of [xI] in term of [Psucc] and [xO] *) -Lemma xI_add_un_xO : (x:positive)(xI x) = (add_un (xO x)). +Lemma xI_succ_xO : forall p:positive, xI p = Psucc (xO p). Proof. -Reflexivity. +reflexivity. Qed. -Lemma add_un_discr : (x:positive)x<>(add_un x). +Lemma Psucc_discr : forall p:positive, p <> Psucc p. Proof. -Intro x; NewDestruct x; Discriminate. +intro x; destruct x as [p| p| ]; discriminate. Qed. (** Successor and double *) -Lemma is_double_moins_un : (x:positive) (add_un (double_moins_un x)) = (xO x). +Lemma Psucc_o_double_minus_one_eq_xO : + forall p:positive, Psucc (Pdouble_minus_one p) = xO p. Proof. -Intro x; NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity. +intro x; induction x as [x IHx| x| ]; simpl in |- *; try rewrite IHx; + reflexivity. Qed. -Lemma double_moins_un_add_un_xI : - (x:positive)(double_moins_un (add_un x))=(xI x). +Lemma Pdouble_minus_one_o_succ_eq_xI : + forall p:positive, Pdouble_minus_one (Psucc p) = xI p. Proof. -Intro x;NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity. +intro x; induction x as [x IHx| x| ]; simpl in |- *; try rewrite IHx; + reflexivity. Qed. -Lemma ZL1: (y:positive)(xO (add_un y)) = (add_un (add_un (xO y))). +Lemma xO_succ_permute : + forall p:positive, xO (Psucc p) = Psucc (Psucc (xO p)). Proof. -Intro y; Induction y; Simpl; Auto. +intro y; induction y as [y Hrecy| y Hrecy| ]; simpl in |- *; auto. Qed. -Lemma double_moins_un_xO_discr : (x:positive)(double_moins_un x)<>(xO x). +Lemma double_moins_un_xO_discr : + forall p:positive, Pdouble_minus_one p <> xO p. Proof. -Intro x; NewDestruct x; Discriminate. +intro x; destruct x as [p| p| ]; discriminate. Qed. (** Successor and predecessor *) -Lemma add_un_not_un : (x:positive) (add_un x) <> xH. +Lemma Psucc_not_one : forall p:positive, Psucc p <> xH. Proof. -Intro x; NewDestruct x as [x|x|]; Discriminate. +intro x; destruct x as [x| x| ]; discriminate. Qed. -Lemma sub_add_one : (x:positive) (sub_un (add_un x)) = x. +Lemma Ppred_succ : forall p:positive, Ppred (Psucc p) = p. Proof. -(Intro x; NewDestruct x as [p|p|]; [Idtac | Idtac | Simpl;Auto]); -(NewInduction p as [p IHp||]; [Idtac | Reflexivity | Reflexivity ]); -Simpl; Simpl in IHp; Try Rewrite <- IHp; Reflexivity. +intro x; destruct x as [p| p| ]; [ idtac | idtac | simpl in |- *; auto ]; + (induction p as [p IHp| | ]; [ idtac | reflexivity | reflexivity ]); + simpl in |- *; simpl in IHp; try rewrite <- IHp; reflexivity. Qed. -Lemma add_sub_one : (x:positive) (x=xH) \/ (add_un (sub_un x)) = x. +Lemma Psucc_pred : forall p:positive, p = xH \/ Psucc (Ppred p) = p. Proof. -Intro x; Induction x; [ - Simpl; Auto -| Simpl; Intros;Right;Apply is_double_moins_un -| Auto ]. +intro x; induction x as [x Hrecx| x Hrecx| ]; + [ simpl in |- *; auto + | simpl in |- *; intros; right; apply Psucc_o_double_minus_one_eq_xO + | auto ]. Qed. (** Injectivity of successor *) -Lemma add_un_inj : (x,y:positive) (add_un x)=(add_un y) -> x=y. +Lemma Psucc_inj : forall p q:positive, Psucc p = Psucc q -> p = q. Proof. -Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; - Intro H; Discriminate H Orelse Try (Injection H; Clear H; Intro H). -Rewrite (IHx y H); Reflexivity. -Absurd (add_un x)=xH; [ Apply add_un_not_un | Assumption ]. -Apply f_equal with 1:=H; Assumption. -Absurd (add_un y)=xH; [ Apply add_un_not_un | Symmetry; Assumption ]. -Reflexivity. +intro x; induction x; intro y; destruct y as [y| y| ]; simpl in |- *; intro H; + discriminate H || (try (injection H; clear H; intro H)). +rewrite (IHx y H); reflexivity. +absurd (Psucc x = xH); [ apply Psucc_not_one | assumption ]. +apply f_equal with (1 := H); assumption. +absurd (Psucc y = xH); + [ apply Psucc_not_one | symmetry in |- *; assumption ]. +reflexivity. Qed. (**********************************************************************) @@ -290,605 +306,656 @@ Qed. (** Specification of [Psucc] in term of [Pplus] *) -Lemma ZL12: (q:positive) (add_un q) = (add q xH). +Lemma Pplus_one_succ_r : forall p:positive, Psucc p = p + xH. Proof. -Intro q; NewDestruct q; Reflexivity. +intro q; destruct q as [p| p| ]; reflexivity. Qed. -Lemma ZL12bis: (q:positive) (add_un q) = (add xH q). +Lemma Pplus_one_succ_l : forall p:positive, Psucc p = xH + p. Proof. -Intro q; NewDestruct q; Reflexivity. +intro q; destruct q as [p| p| ]; reflexivity. Qed. (** Specification of [Pplus_carry] *) -Theorem ZL13: (x,y:positive)(add_carry x y) = (add_un (add x y)). +Theorem Pplus_carry_spec : + forall p q:positive, Pplus_carry p q = Psucc (p + q). Proof. -(Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto); - Rewrite IHp; Auto. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; simpl in |- *; auto; rewrite IHp; + auto. Qed. (** Commutativity *) -Theorem add_sym : (x,y:positive) (add x y) = (add y x). +Theorem Pplus_comm : forall p q:positive, p + q = q + p. Proof. -Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto; - Try Do 2 Rewrite ZL13; Rewrite IHp;Auto. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; simpl in |- *; auto; + try do 2 rewrite Pplus_carry_spec; rewrite IHp; auto. Qed. (** Permutation of [Pplus] and [Psucc] *) -Theorem ZL14: (x,y:positive)(add x (add_un y)) = (add_un (add x y)). +Theorem Pplus_succ_permute_r : + forall p q:positive, p + Psucc q = Psucc (p + q). Proof. -Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto; [ - Rewrite ZL13; Rewrite IHp; Auto -| Rewrite ZL13; Auto -| NewDestruct p;Simpl;Auto -| Rewrite IHp;Auto -| NewDestruct p;Simpl;Auto ]. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; simpl in |- *; auto; + [ rewrite Pplus_carry_spec; rewrite IHp; auto + | rewrite Pplus_carry_spec; auto + | destruct p; simpl in |- *; auto + | rewrite IHp; auto + | destruct p; simpl in |- *; auto ]. Qed. -Theorem ZL14bis: (x,y:positive)(add (add_un x) y) = (add_un (add x y)). +Theorem Pplus_succ_permute_l : + forall p q:positive, Psucc p + q = Psucc (p + q). Proof. -Intros x y; Rewrite add_sym; Rewrite add_sym with x:=x; Apply ZL14. +intros x y; rewrite Pplus_comm; rewrite Pplus_comm with (p := x); + apply Pplus_succ_permute_r. Qed. -Theorem ZL15: (q,z:positive) ~z=xH -> (add_carry q (sub_un z)) = (add q z). +Theorem Pplus_carry_pred_eq_plus : + forall p q:positive, q <> xH -> Pplus_carry p (Ppred q) = p + q. Proof. -Intros q z H; Elim (add_sub_one z); [ - Intro;Absurd z=xH;Auto -| Intros E;Pattern 2 z ;Rewrite <- E; Rewrite ZL14; Rewrite ZL13; Trivial ]. +intros q z H; elim (Psucc_pred z); + [ intro; absurd (z = xH); auto + | intros E; pattern z at 2 in |- *; rewrite <- E; + rewrite Pplus_succ_permute_r; rewrite Pplus_carry_spec; + trivial ]. Qed. (** No neutral for addition on strictly positive numbers *) -Lemma add_no_neutral : (x,y:positive) ~(add y x)=x. +Lemma Pplus_no_neutral : forall p q:positive, q + p <> p. Proof. -Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; - Discriminate H Orelse Injection H; Clear H; Intro H; Apply (IHx y H). +intro x; induction x; intro y; destruct y as [y| y| ]; simpl in |- *; intro H; + discriminate H || injection H; clear H; intro H; apply (IHx y H). Qed. -Lemma add_carry_not_add_un : (x,y:positive) ~(add_carry y x)=(add_un x). +Lemma Pplus_carry_no_neutral : + forall p q:positive, Pplus_carry q p <> Psucc p. Proof. -Intros x y H; Absurd (add y x)=x; - [ Apply add_no_neutral - | Apply add_un_inj; Rewrite <- ZL13; Assumption ]. +intros x y H; absurd (y + x = x); + [ apply Pplus_no_neutral + | apply Psucc_inj; rewrite <- Pplus_carry_spec; assumption ]. Qed. (** Simplification *) -Lemma add_carry_add : - (x,y,z,t:positive) (add_carry x z)=(add_carry y t) -> (add x z)=(add y t). +Lemma Pplus_carry_plus : + forall p q r s:positive, Pplus_carry p r = Pplus_carry q s -> p + r = q + s. Proof. -Intros x y z t H; Apply add_un_inj; Do 2 Rewrite <- ZL13; Assumption. +intros x y z t H; apply Psucc_inj; do 2 rewrite <- Pplus_carry_spec; + assumption. Qed. -Lemma simpl_add_r : (x,y,z:positive) (add x z)=(add y z) -> x=y. +Lemma Pplus_reg_r : forall p q r:positive, p + r = q + r -> p = q. Proof. -Intros x y z; Generalize x y; Clear x y. -NewInduction z as [z|z|]. - NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; - Discriminate H Orelse Try (Injection H; Clear H; Intro H). - Rewrite IHz with 1:=(add_carry_add ? ? ? ? H); Reflexivity. - Absurd (add_carry x z)=(add_un z); - [ Apply add_carry_not_add_un | Assumption ]. - Rewrite IHz with 1:=H; Reflexivity. - Symmetry in H; Absurd (add_carry y z)=(add_un z); - [ Apply add_carry_not_add_un | Assumption ]. - Reflexivity. - NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; - Discriminate H Orelse Try (Injection H; Clear H; Intro H). - Rewrite IHz with 1:=H; Reflexivity. - Absurd (add x z)=z; [ Apply add_no_neutral | Assumption ]. - Rewrite IHz with 1:=H; Reflexivity. - Symmetry in H; Absurd y+z=z; [ Apply add_no_neutral | Assumption ]. - Reflexivity. - Intros H x y; Apply add_un_inj; Do 2 Rewrite ZL12; Assumption. +intros x y z; generalize x y; clear x y. +induction z as [z| z| ]. + destruct x as [x| x| ]; intro y; destruct y as [y| y| ]; simpl in |- *; + intro H; discriminate H || (try (injection H; clear H; intro H)). + rewrite IHz with (1 := Pplus_carry_plus _ _ _ _ H); reflexivity. + absurd (Pplus_carry x z = Psucc z); + [ apply Pplus_carry_no_neutral | assumption ]. + rewrite IHz with (1 := H); reflexivity. + symmetry in H; absurd (Pplus_carry y z = Psucc z); + [ apply Pplus_carry_no_neutral | assumption ]. + reflexivity. + destruct x as [x| x| ]; intro y; destruct y as [y| y| ]; simpl in |- *; + intro H; discriminate H || (try (injection H; clear H; intro H)). + rewrite IHz with (1 := H); reflexivity. + absurd (x + z = z); [ apply Pplus_no_neutral | assumption ]. + rewrite IHz with (1 := H); reflexivity. + symmetry in H; absurd (y + z = z); + [ apply Pplus_no_neutral | assumption ]. + reflexivity. + intros H x y; apply Psucc_inj; do 2 rewrite Pplus_one_succ_r; assumption. Qed. -Lemma simpl_add_l : (x,y,z:positive) (add x y)=(add x z) -> y=z. +Lemma Pplus_reg_l : forall p q r:positive, p + q = p + r -> q = r. Proof. -Intros x y z H;Apply simpl_add_r with z:=x; - Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Assumption. +intros x y z H; apply Pplus_reg_r with (r := x); + rewrite Pplus_comm with (p := z); rewrite Pplus_comm with (p := y); + assumption. Qed. -Lemma simpl_add_carry_r : - (x,y,z:positive) (add_carry x z)=(add_carry y z) -> x=y. +Lemma Pplus_carry_reg_r : + forall p q r:positive, Pplus_carry p r = Pplus_carry q r -> p = q. Proof. -Intros x y z H; Apply simpl_add_r with z:=z; Apply add_carry_add; Assumption. +intros x y z H; apply Pplus_reg_r with (r := z); apply Pplus_carry_plus; + assumption. Qed. -Lemma simpl_add_carry_l : - (x,y,z:positive) (add_carry x y)=(add_carry x z) -> y=z. +Lemma Pplus_carry_reg_l : + forall p q r:positive, Pplus_carry p q = Pplus_carry p r -> q = r. Proof. -Intros x y z H;Apply simpl_add_r with z:=x; -Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Apply add_carry_add; -Assumption. +intros x y z H; apply Pplus_reg_r with (r := x); + rewrite Pplus_comm with (p := z); rewrite Pplus_comm with (p := y); + apply Pplus_carry_plus; assumption. Qed. (** Addition on positive is associative *) -Theorem add_assoc: (x,y,z:positive)(add x (add y z)) = (add (add x y) z). -Proof. -Intros x y; Generalize x; Clear x. -NewInduction y as [y|y|]; Intro x. - NewDestruct x as [x|x|]; - Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13; - Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse - Repeat Apply f_equal with A:=positive; Apply IHy. - NewDestruct x as [x|x|]; - Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13; - Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse - Repeat Apply f_equal with A:=positive; Apply IHy. - Intro z; Rewrite add_sym with x:=xH; Do 2 Rewrite <- ZL12; Rewrite ZL14bis; Rewrite ZL14; Reflexivity. +Theorem Pplus_assoc : forall p q r:positive, p + (q + r) = p + q + r. +Proof. +intros x y; generalize x; clear x. +induction y as [y| y| ]; intro x. + destruct x as [x| x| ]; intro z; destruct z as [z| z| ]; simpl in |- *; + repeat rewrite Pplus_carry_spec; repeat rewrite Pplus_succ_permute_r; + repeat rewrite Pplus_succ_permute_l; + reflexivity || (repeat apply f_equal with (A := positive)); + apply IHy. + destruct x as [x| x| ]; intro z; destruct z as [z| z| ]; simpl in |- *; + repeat rewrite Pplus_carry_spec; repeat rewrite Pplus_succ_permute_r; + repeat rewrite Pplus_succ_permute_l; + reflexivity || (repeat apply f_equal with (A := positive)); + apply IHy. + intro z; rewrite Pplus_comm with (p := xH); + do 2 rewrite <- Pplus_one_succ_r; rewrite Pplus_succ_permute_l; + rewrite Pplus_succ_permute_r; reflexivity. Qed. (** Commutation of addition with the double of a positive number *) -Lemma add_xI_double_moins_un : - (p,q:positive)(xO (add p q)) = (add (xI p) (double_moins_un q)). +Lemma Pplus_xI_double_minus_one : + forall p q:positive, xO (p + q) = xI p + Pdouble_minus_one q. Proof. -Intros; Change (xI p) with (add (xO p) xH). -Rewrite <- add_assoc; Rewrite <- ZL12bis; Rewrite is_double_moins_un. -Reflexivity. +intros; change (xI p) with (xO p + xH) in |- *. +rewrite <- Pplus_assoc; rewrite <- Pplus_one_succ_l; + rewrite Psucc_o_double_minus_one_eq_xO. +reflexivity. Qed. -Lemma add_xO_double_moins_un : - (p,q:positive) (double_moins_un (add p q)) = (add (xO p) (double_moins_un q)). +Lemma Pplus_xO_double_minus_one : + forall p q:positive, Pdouble_minus_one (p + q) = xO p + Pdouble_minus_one q. Proof. -NewInduction p as [p IHp|p IHp|]; NewDestruct q as [q|q|]; - Simpl; Try Rewrite ZL13; Try Rewrite double_moins_un_add_un_xI; - Try Rewrite IHp; Try Rewrite add_xI_double_moins_un; Try Reflexivity. - Rewrite <- is_double_moins_un; Rewrite ZL12bis; Reflexivity. +induction p as [p IHp| p IHp| ]; destruct q as [q| q| ]; simpl in |- *; + try rewrite Pplus_carry_spec; try rewrite Pdouble_minus_one_o_succ_eq_xI; + try rewrite IHp; try rewrite Pplus_xI_double_minus_one; + try reflexivity. + rewrite <- Psucc_o_double_minus_one_eq_xO; rewrite Pplus_one_succ_l; + reflexivity. Qed. (** Misc *) -Lemma add_x_x : (x:positive) (add x x) = (xO x). +Lemma Pplus_diag : forall p:positive, p + p = xO p. Proof. -Intro x;NewInduction x; Simpl; Try Rewrite ZL13; Try Rewrite IHx; Reflexivity. +intro x; induction x; simpl in |- *; try rewrite Pplus_carry_spec; + try rewrite IHx; reflexivity. Qed. (**********************************************************************) (** Peano induction on binary positive positive numbers *) -Fixpoint plus_iter [x:positive] : positive -> positive := - [y]Cases x of - | xH => (add_un y) - | (xO x) => (plus_iter x (plus_iter x y)) - | (xI x) => (plus_iter x (plus_iter x (add_un y))) +Fixpoint plus_iter (x y:positive) {struct x} : positive := + match x with + | xH => Psucc y + | xO x => plus_iter x (plus_iter x y) + | xI x => plus_iter x (plus_iter x (Psucc y)) end. -Lemma plus_iter_add : (x,y:positive)(plus_iter x y)=(add x y). +Lemma plus_iter_eq_plus : forall p q:positive, plus_iter p q = p + q. Proof. -Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; Simpl; - Reflexivity Orelse Do 2 Rewrite IHp; Rewrite add_assoc; Rewrite add_x_x; - Try Reflexivity. -Rewrite ZL13; Rewrite <- ZL14; Reflexivity. -Rewrite ZL12; Reflexivity. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; simpl in |- *; reflexivity || (do 2 rewrite IHp); + rewrite Pplus_assoc; rewrite Pplus_diag; try reflexivity. +rewrite Pplus_carry_spec; rewrite <- Pplus_succ_permute_r; reflexivity. +rewrite Pplus_one_succ_r; reflexivity. Qed. -Lemma plus_iter_xO : (x:positive)(plus_iter x x)=(xO x). +Lemma plus_iter_xO : forall p:positive, plus_iter p p = xO p. Proof. -Intro; Rewrite <- add_x_x; Apply plus_iter_add. +intro; rewrite <- Pplus_diag; apply plus_iter_eq_plus. Qed. -Lemma plus_iter_xI : (x:positive)(add_un (plus_iter x x))=(xI x). +Lemma plus_iter_xI : forall p:positive, Psucc (plus_iter p p) = xI p. Proof. -Intro; Rewrite xI_add_un_xO; Rewrite <- add_x_x; - Apply (f_equal positive); Apply plus_iter_add. +intro; rewrite xI_succ_xO; rewrite <- Pplus_diag; + apply (f_equal (A:=positive)); apply plus_iter_eq_plus. Qed. -Lemma iterate_add : (P:(positive->Type)) - ((n:positive)(P n) ->(P (add_un n)))->(p,n:positive)(P n) -> - (P (plus_iter p n)). +Lemma iterate_add : + forall P:positive -> Type, + (forall n:positive, P n -> P (Psucc n)) -> + forall p q:positive, P q -> P (plus_iter p q). Proof. -Intros P H; NewInduction p; Simpl; Intros. -Apply IHp; Apply IHp; Apply H; Assumption. -Apply IHp; Apply IHp; Assumption. -Apply H; Assumption. +intros P H; induction p; simpl in |- *; intros. +apply IHp; apply IHp; apply H; assumption. +apply IHp; apply IHp; assumption. +apply H; assumption. Defined. (** Peano induction *) -Theorem Pind : (P:(positive->Prop)) - (P xH) ->((n:positive)(P n) ->(P (add_un n))) ->(n:positive)(P n). +Theorem Pind : + forall P:positive -> Prop, + P xH -> (forall n:positive, P n -> P (Psucc n)) -> forall p:positive, P p. Proof. -Intros P H1 Hsucc n; NewInduction n. -Rewrite <- plus_iter_xI; Apply Hsucc; Apply iterate_add; Assumption. -Rewrite <- plus_iter_xO; Apply iterate_add; Assumption. -Assumption. +intros P H1 Hsucc n; induction n. +rewrite <- plus_iter_xI; apply Hsucc; apply iterate_add; assumption. +rewrite <- plus_iter_xO; apply iterate_add; assumption. +assumption. Qed. (** Peano recursion *) -Definition Prec : (A:Set)A->(positive->A->A)->positive->A := - [A;a;f]Fix Prec { Prec [p:positive] : A := - Cases p of - | xH => a - | (xO p) => (iterate_add [_]A f p p (Prec p)) - | (xI p) => (f (plus_iter p p) (iterate_add [_]A f p p (Prec p))) - end}. +Definition Prec (A:Set) (a:A) (f:positive -> A -> A) : + positive -> A := + (fix Prec (p:positive) : A := + match p with + | xH => a + | xO p => iterate_add (fun _ => A) f p p (Prec p) + | xI p => f (plus_iter p p) (iterate_add (fun _ => A) f p p (Prec p)) + end). (** Peano case analysis *) -Theorem Pcase : (P:(positive->Prop)) - (P xH) ->((n:positive)(P (add_un n))) ->(n:positive)(P n). +Theorem Pcase : + forall P:positive -> Prop, + P xH -> (forall n:positive, P (Psucc n)) -> forall p:positive, P p. Proof. -Intros; Apply Pind; Auto. +intros; apply Pind; auto. Qed. +(* Check - let fact = (Prec positive xH [p;r](times (add_un p) r)) in - let seven = (xI (xI xH)) in - let five_thousand_forty= (xO(xO(xO(xO(xI(xI(xO(xI(xI(xI(xO(xO xH)))))))))))) - in ((refl_equal ? ?) :: (fact seven) = five_thousand_forty). + (let fact := Prec positive xH (fun p r => Psucc p * r) in + let seven := xI (xI xH) in + let five_thousand_forty := + xO (xO (xO (xO (xI (xI (xO (xI (xI (xI (xO (xO xH))))))))))) in + refl_equal _:fact seven = five_thousand_forty). +*) (**********************************************************************) (** Properties of multiplication on binary positive numbers *) (** One is right neutral for multiplication *) -Lemma times_x_1 : (x:positive) (times x xH) = x. +Lemma Pmult_1_r : forall p:positive, p * xH = p. Proof. -Intro x;NewInduction x; Simpl. - Rewrite IHx; Reflexivity. - Rewrite IHx; Reflexivity. - Reflexivity. +intro x; induction x; simpl in |- *. + rewrite IHx; reflexivity. + rewrite IHx; reflexivity. + reflexivity. Qed. (** Right reduction properties for multiplication *) -Lemma times_x_double : (x,y:positive) (times x (xO y)) = (xO (times x y)). +Lemma Pmult_xO_permute_r : forall p q:positive, p * xO q = xO (p * q). Proof. -Intros x y; NewInduction x; Simpl. - Rewrite IHx; Reflexivity. - Rewrite IHx; Reflexivity. - Reflexivity. +intros x y; induction x; simpl in |- *. + rewrite IHx; reflexivity. + rewrite IHx; reflexivity. + reflexivity. Qed. -Lemma times_x_double_plus_one : - (x,y:positive) (times x (xI y)) = (add x (xO (times x y))). +Lemma Pmult_xI_permute_r : forall p q:positive, p * xI q = p + xO (p * q). Proof. -Intros x y; NewInduction x; Simpl. - Rewrite IHx; Do 2 Rewrite add_assoc; Rewrite add_sym with x:=y; Reflexivity. - Rewrite IHx; Reflexivity. - Reflexivity. +intros x y; induction x; simpl in |- *. + rewrite IHx; do 2 rewrite Pplus_assoc; rewrite Pplus_comm with (p := y); + reflexivity. + rewrite IHx; reflexivity. + reflexivity. Qed. (** Commutativity of multiplication *) -Theorem times_sym : (x,y:positive) (times x y) = (times y x). +Theorem Pmult_comm : forall p q:positive, p * q = q * p. Proof. -Intros x y; NewInduction y; Simpl. - Rewrite <- IHy; Apply times_x_double_plus_one. - Rewrite <- IHy; Apply times_x_double. - Apply times_x_1. +intros x y; induction y; simpl in |- *. + rewrite <- IHy; apply Pmult_xI_permute_r. + rewrite <- IHy; apply Pmult_xO_permute_r. + apply Pmult_1_r. Qed. (** Distributivity of multiplication over addition *) -Theorem times_add_distr: - (x,y,z:positive) (times x (add y z)) = (add (times x y) (times x z)). +Theorem Pmult_plus_distr_l : + forall p q r:positive, p * (q + r) = p * q + p * r. Proof. -Intros x y z; NewInduction x; Simpl. - Rewrite IHx; Rewrite <- add_assoc with y := (xO (times x y)); - Rewrite -> add_assoc with x := (xO (times x y)); - Rewrite -> add_sym with x := (xO (times x y)); - Rewrite <- add_assoc with y := (xO (times x y)); - Rewrite -> add_assoc with y := z; Reflexivity. - Rewrite IHx; Reflexivity. - Reflexivity. +intros x y z; induction x; simpl in |- *. + rewrite IHx; rewrite <- Pplus_assoc with (q := xO (x * y)); + rewrite Pplus_assoc with (p := xO (x * y)); + rewrite Pplus_comm with (p := xO (x * y)); + rewrite <- Pplus_assoc with (q := xO (x * y)); + rewrite Pplus_assoc with (q := z); reflexivity. + rewrite IHx; reflexivity. + reflexivity. Qed. -Theorem times_add_distr_l: - (x,y,z:positive) (times (add x y) z) = (add (times x z) (times y z)). +Theorem Pmult_plus_distr_r : + forall p q r:positive, (p + q) * r = p * r + q * r. Proof. -Intros x y z; Do 3 Rewrite times_sym with y:=z; Apply times_add_distr. +intros x y z; do 3 rewrite Pmult_comm with (q := z); apply Pmult_plus_distr_l. Qed. (** Associativity of multiplication *) -Theorem times_assoc : - ((x,y,z:positive) (times x (times y z))= (times (times x y) z)). +Theorem Pmult_assoc : forall p q r:positive, p * (q * r) = p * q * r. Proof. -Intro x;NewInduction x as [x|x|]; Simpl; Intros y z. - Rewrite IHx; Rewrite times_add_distr_l; Reflexivity. - Rewrite IHx; Reflexivity. - Reflexivity. +intro x; induction x as [x| x| ]; simpl in |- *; intros y z. + rewrite IHx; rewrite Pmult_plus_distr_r; reflexivity. + rewrite IHx; reflexivity. + reflexivity. Qed. (** Parity properties of multiplication *) -Lemma times_discr_xO_xI : - (x,y,z:positive)(times (xI x) z)<>(times (xO y) z). +Lemma Pmult_xI_mult_xO_discr : forall p q r:positive, xI p * r <> xO q * r. Proof. -Intros x y z; NewInduction z as [|z IHz|]; Try Discriminate. -Intro H; Apply IHz; Clear IHz. -Do 2 Rewrite times_x_double in H. -Injection H; Clear H; Intro H; Exact H. +intros x y z; induction z as [| z IHz| ]; try discriminate. +intro H; apply IHz; clear IHz. +do 2 rewrite Pmult_xO_permute_r in H. +injection H; clear H; intro H; exact H. Qed. -Lemma times_discr_xO : (x,y:positive)(times (xO x) y)<>y. +Lemma Pmult_xO_discr : forall p q:positive, xO p * q <> q. Proof. -Intros x y; NewInduction y; Try Discriminate. -Rewrite times_x_double; Injection; Assumption. +intros x y; induction y; try discriminate. +rewrite Pmult_xO_permute_r; injection; assumption. Qed. (** Simplification properties of multiplication *) -Theorem simpl_times_r : (x,y,z:positive) (times x z)=(times y z) -> x=y. +Theorem Pmult_reg_r : forall p q r:positive, p * r = q * r -> p = q. Proof. -Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|]; Intros z H; - Reflexivity Orelse Apply (f_equal positive) Orelse Apply False_ind. - Simpl in H; Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double; - Apply simpl_add_l with 1 := H. - Apply times_discr_xO_xI with 1 := H. - Simpl in H; Rewrite add_sym in H; Apply add_no_neutral with 1 := H. - Symmetry in H; Apply times_discr_xO_xI with 1 := H. - Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double; Assumption. - Apply times_discr_xO with 1:=H. - Simpl in H; Symmetry in H; Rewrite add_sym in H; - Apply add_no_neutral with 1 := H. - Symmetry in H; Apply times_discr_xO with 1:=H. +intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ]; + intros z H; reflexivity || apply (f_equal (A:=positive)) || apply False_ind. + simpl in H; apply IHp with (xO z); simpl in |- *; + do 2 rewrite Pmult_xO_permute_r; apply Pplus_reg_l with (1 := H). + apply Pmult_xI_mult_xO_discr with (1 := H). + simpl in H; rewrite Pplus_comm in H; apply Pplus_no_neutral with (1 := H). + symmetry in H; apply Pmult_xI_mult_xO_discr with (1 := H). + apply IHp with (xO z); simpl in |- *; do 2 rewrite Pmult_xO_permute_r; + assumption. + apply Pmult_xO_discr with (1 := H). + simpl in H; symmetry in H; rewrite Pplus_comm in H; + apply Pplus_no_neutral with (1 := H). + symmetry in H; apply Pmult_xO_discr with (1 := H). Qed. -Theorem simpl_times_l : (x,y,z:positive) (times z x)=(times z y) -> x=y. +Theorem Pmult_reg_l : forall p q r:positive, r * p = r * q -> p = q. Proof. -Intros x y z H; Apply simpl_times_r with z:=z. -Rewrite times_sym with x:=x; Rewrite times_sym with x:=y; Assumption. +intros x y z H; apply Pmult_reg_r with (r := z). +rewrite Pmult_comm with (p := x); rewrite Pmult_comm with (p := y); + assumption. Qed. (** Inversion of multiplication *) -Lemma times_one_inversion_l : (x,y:positive) (times x y)=xH -> x=xH. +Lemma Pmult_1_inversion_l : forall p q:positive, p * q = xH -> p = xH. Proof. -Intros x y; NewDestruct x; Simpl. - NewDestruct y; Intro; Discriminate. - Intro; Discriminate. - Reflexivity. +intros x y; destruct x as [p| p| ]; simpl in |- *. + destruct y as [p0| p0| ]; intro; discriminate. + intro; discriminate. + reflexivity. Qed. (**********************************************************************) (** Properties of comparison on binary positive numbers *) -Theorem compare_convert1 : - (x,y:positive) - ~(compare x y SUPERIEUR) = EGAL /\ ~(compare x y INFERIEUR) = EGAL. +Theorem Pcompare_not_Eq : + forall p q:positive, (p ?= q) Gt <> Eq /\ (p ?= q) Lt <> Eq. Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|]; - Split;Simpl;Auto; - Discriminate Orelse (Elim (IHp q); Auto). +intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ]; + split; simpl in |- *; auto; discriminate || (elim (IHp q); auto). Qed. -Theorem compare_convert_EGAL : (x,y:positive) (compare x y EGAL) = EGAL -> x=y. +Theorem Pcompare_Eq_eq : forall p q:positive, (p ?= q) Eq = Eq -> p = q. Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; - Intro y; NewDestruct y as [q|q|];Simpl;Auto; Intro H; [ - Rewrite (IHp q); Trivial -| Absurd (compare p q SUPERIEUR)=EGAL ; - [ Elim (compare_convert1 p q);Auto | Assumption ] -| Discriminate H -| Absurd (compare p q INFERIEUR) = EGAL; - [ Elim (compare_convert1 p q);Auto | Assumption ] -| Rewrite (IHp q);Auto -| Discriminate H -| Discriminate H -| Discriminate H ]. +intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ]; + simpl in |- *; auto; intro H; + [ rewrite (IHp q); trivial + | absurd ((p ?= q) Gt = Eq); + [ elim (Pcompare_not_Eq p q); auto | assumption ] + | discriminate H + | absurd ((p ?= q) Lt = Eq); + [ elim (Pcompare_not_Eq p q); auto | assumption ] + | rewrite (IHp q); auto + | discriminate H + | discriminate H + | discriminate H ]. Qed. -Lemma ZLSI: - (x,y:positive) (compare x y SUPERIEUR) = INFERIEUR -> - (compare x y EGAL) = INFERIEUR. +Lemma Pcompare_Gt_Lt : + forall p q:positive, (p ?= q) Gt = Lt -> (p ?= q) Eq = Lt. Proof. -Intro x; Induction x;Intro y; Induction y;Simpl;Auto; - Discriminate Orelse Intros H;Discriminate H. +intro x; induction x as [x Hrecx| x Hrecx| ]; intro y; + [ induction y as [y Hrecy| y Hrecy| ] + | induction y as [y Hrecy| y Hrecy| ] + | induction y as [y Hrecy| y Hrecy| ] ]; simpl in |- *; + auto; discriminate || intros H; discriminate H. Qed. -Lemma ZLIS: - (x,y:positive) (compare x y INFERIEUR) = SUPERIEUR -> - (compare x y EGAL) = SUPERIEUR. +Lemma Pcompare_Lt_Gt : + forall p q:positive, (p ?= q) Lt = Gt -> (p ?= q) Eq = Gt. Proof. -Intro x; Induction x;Intro y; Induction y;Simpl;Auto; - Discriminate Orelse Intros H;Discriminate H. +intro x; induction x as [x Hrecx| x Hrecx| ]; intro y; + [ induction y as [y Hrecy| y Hrecy| ] + | induction y as [y Hrecy| y Hrecy| ] + | induction y as [y Hrecy| y Hrecy| ] ]; simpl in |- *; + auto; discriminate || intros H; discriminate H. Qed. -Lemma ZLII: - (x,y:positive) (compare x y INFERIEUR) = INFERIEUR -> - (compare x y EGAL) = INFERIEUR \/ x = y. +Lemma Pcompare_Lt_Lt : + forall p q:positive, (p ?= q) Lt = Lt -> (p ?= q) Eq = Lt \/ p = q. Proof. -(Intro x; NewInduction x as [p IHp|p IHp|]; - Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate); - Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E; - Auto. +intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ]; + simpl in |- *; auto; try discriminate; intro H2; elim (IHp q H2); + auto; intros E; rewrite E; auto. Qed. -Lemma ZLSS: - (x,y:positive) (compare x y SUPERIEUR) = SUPERIEUR -> - (compare x y EGAL) = SUPERIEUR \/ x = y. +Lemma Pcompare_Gt_Gt : + forall p q:positive, (p ?= q) Gt = Gt -> (p ?= q) Eq = Gt \/ p = q. Proof. -(Intro x; NewInduction x as [p IHp|p IHp|]; - Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate); - Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E; - Auto. +intro x; induction x as [p IHp| p IHp| ]; intro y; destruct y as [q| q| ]; + simpl in |- *; auto; try discriminate; intro H2; elim (IHp q H2); + auto; intros E; rewrite E; auto. Qed. -Lemma Dcompare : (r:relation) r=EGAL \/ r = INFERIEUR \/ r = SUPERIEUR. +Lemma Dcompare : forall r:comparison, r = Eq \/ r = Lt \/ r = Gt. Proof. -Induction r; Auto. +simple induction r; auto. Qed. -Tactic Definition ElimPcompare c1 c2:= - Elim (Dcompare (compare c1 c2 EGAL)); [ Idtac | - Let x = FreshId "H" In Intro x; Case x; Clear x ]. +Ltac ElimPcompare c1 c2 := + elim (Dcompare ((c1 ?= c2) Eq)); + [ idtac | let x := fresh "H" in + (intro x; case x; clear x) ]. -Theorem convert_compare_EGAL: (x:positive)(compare x x EGAL)=EGAL. -Intro x; Induction x; Auto. +Theorem Pcompare_refl : forall p:positive, (p ?= p) Eq = Eq. +intro x; induction x as [x Hrecx| x Hrecx| ]; auto. Qed. Lemma Pcompare_antisym : - (x,y:positive)(r:relation) (Op (compare x y r)) = (compare y x (Op r)). + forall (p q:positive) (r:comparison), + CompOpp ((p ?= q) r) = (q ?= p) (CompOpp r). Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; -Intro r; Reflexivity Orelse (Symmetry; Assumption) Orelse Discriminate H -Orelse Simpl; Apply IHp Orelse Try Rewrite IHp; Try Reflexivity. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; intro r; + reflexivity || + (symmetry in |- *; assumption) || discriminate H || simpl in |- *; + apply IHp || (try rewrite IHp); try reflexivity. Qed. -Lemma ZC1: - (x,y:positive)(compare x y EGAL)=SUPERIEUR -> (compare y x EGAL)=INFERIEUR. +Lemma ZC1 : forall p q:positive, (p ?= q) Eq = Gt -> (q ?= p) Eq = Lt. Proof. -Intros; Change EGAL with (Op EGAL). -Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity. +intros; change Eq with (CompOpp Eq) in |- *. +rewrite <- Pcompare_antisym; rewrite H; reflexivity. Qed. -Lemma ZC2: - (x,y:positive)(compare x y EGAL)=INFERIEUR -> (compare y x EGAL)=SUPERIEUR. +Lemma ZC2 : forall p q:positive, (p ?= q) Eq = Lt -> (q ?= p) Eq = Gt. Proof. -Intros; Change EGAL with (Op EGAL). -Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity. +intros; change Eq with (CompOpp Eq) in |- *. +rewrite <- Pcompare_antisym; rewrite H; reflexivity. Qed. -Lemma ZC3: (x,y:positive)(compare x y EGAL)=EGAL -> (compare y x EGAL)=EGAL. +Lemma ZC3 : forall p q:positive, (p ?= q) Eq = Eq -> (q ?= p) Eq = Eq. Proof. -Intros; Change EGAL with (Op EGAL). -Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity. +intros; change Eq with (CompOpp Eq) in |- *. +rewrite <- Pcompare_antisym; rewrite H; reflexivity. Qed. -Lemma ZC4: (x,y:positive) (compare x y EGAL) = (Op (compare y x EGAL)). +Lemma ZC4 : forall p q:positive, (p ?= q) Eq = CompOpp ((q ?= p) Eq). Proof. -Intros; Change 1 EGAL with (Op EGAL). -Symmetry; Apply Pcompare_antisym. +intros; change Eq at 1 with (CompOpp Eq) in |- *. +symmetry in |- *; apply Pcompare_antisym. Qed. (**********************************************************************) (** Properties of subtraction on binary positive numbers *) -Lemma ZS: (p:positive_mask) (Zero_suivi_de_mask p) = IsNul -> p = IsNul. +Lemma double_eq_zero_inversion : + forall p:positive_mask, Pdouble_mask p = IsNul -> p = IsNul. Proof. -NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ]. +destruct p; simpl in |- *; [ trivial | discriminate 1 | discriminate 1 ]. Qed. -Lemma US: (p:positive_mask) ~(Un_suivi_de_mask p)=IsNul. +Lemma double_plus_one_zero_discr : + forall p:positive_mask, Pdouble_plus_one_mask p <> IsNul. Proof. -Induction p; Intros; Discriminate. +simple induction p; intros; discriminate. Qed. -Lemma USH: (p:positive_mask) (Un_suivi_de_mask p) = (IsPos xH) -> p = IsNul. +Lemma double_plus_one_eq_one_inversion : + forall p:positive_mask, Pdouble_plus_one_mask p = IsPos xH -> p = IsNul. Proof. -NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ]. +destruct p; simpl in |- *; [ trivial | discriminate 1 | discriminate 1 ]. Qed. -Lemma ZSH: (p:positive_mask) ~(Zero_suivi_de_mask p)= (IsPos xH). +Lemma double_eq_one_discr : + forall p:positive_mask, Pdouble_mask p <> IsPos xH. Proof. -Induction p; Intros; Discriminate. +simple induction p; intros; discriminate. Qed. -Theorem sub_pos_x_x : (x:positive) (sub_pos x x) = IsNul. +Theorem Pminus_mask_diag : forall p:positive, Pminus_mask p p = IsNul. Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; [ - Simpl; Rewrite IHp;Simpl; Trivial -| Simpl; Rewrite IHp;Auto -| Auto ]. +intro x; induction x as [p IHp| p IHp| ]; + [ simpl in |- *; rewrite IHp; simpl in |- *; trivial + | simpl in |- *; rewrite IHp; auto + | auto ]. Qed. -Lemma ZL10: (x,y:positive) - (sub_pos x y) = (IsPos xH) -> (sub_neg x y) = IsNul. +Lemma ZL10 : + forall p q:positive, + Pminus_mask p q = IsPos xH -> Pminus_mask_carry p q = IsNul. Proof. -Intro x; NewInduction x as [p|p|]; Intro y; NewDestruct y as [q|q|]; Simpl; - Intro H; Try Discriminate H; [ - Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH); - [ Apply ZSH | Assumption ] -| Assert Heq : (sub_pos p q)=IsNul; - [ Apply USH;Assumption | Rewrite Heq; Reflexivity ] -| Assert Heq : (sub_neg p q)=IsNul; - [ Apply USH;Assumption | Rewrite Heq; Reflexivity ] -| Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH); - [ Apply ZSH | Assumption ] -| NewDestruct p; Simpl; [ Discriminate H | Discriminate H | Reflexivity ] ]. +intro x; induction x as [p| p| ]; intro y; destruct y as [q| q| ]; + simpl in |- *; intro H; try discriminate H; + [ absurd (Pdouble_mask (Pminus_mask p q) = IsPos xH); + [ apply double_eq_one_discr | assumption ] + | assert (Heq : Pminus_mask p q = IsNul); + [ apply double_plus_one_eq_one_inversion; assumption + | rewrite Heq; reflexivity ] + | assert (Heq : Pminus_mask_carry p q = IsNul); + [ apply double_plus_one_eq_one_inversion; assumption + | rewrite Heq; reflexivity ] + | absurd (Pdouble_mask (Pminus_mask p q) = IsPos xH); + [ apply double_eq_one_discr | assumption ] + | destruct p; simpl in |- *; + [ discriminate H | discriminate H | reflexivity ] ]. Qed. (** Properties of subtraction valid only for x>y *) -Lemma sub_pos_SUPERIEUR: - (x,y:positive)(compare x y EGAL)=SUPERIEUR -> - (EX h:positive | (sub_pos x y) = (IsPos h) /\ (add y h) = x /\ - (h = xH \/ (sub_neg x y) = (IsPos (sub_un h)))). -Proof. -Intro x;NewInduction x as [p|p|];Intro y; NewDestruct y as [q|q|]; Simpl; Intro H; - Try Discriminate H. - NewDestruct (IHp q H) as [z [H4 [H6 H7]]]; Exists (xO z); Split. - Rewrite H4; Reflexivity. - Split. - Simpl; Rewrite H6; Reflexivity. - Right; Clear H6; NewDestruct (ZL11 z) as [H8|H8]; [ - Rewrite H8; Rewrite H8 in H4; - Rewrite ZL10; [ Reflexivity | Assumption ] - | Clear H4; NewDestruct H7 as [H9|H9]; [ - Absurd z=xH; Assumption - | Rewrite H9; Clear H9; NewDestruct z; - [ Reflexivity | Reflexivity | Absurd xH=xH; Trivial ]]]. - Case ZLSS with 1:=H; [ - Intros H3;Elim (IHp q H3); Intros z H4; Exists (xI z); - Elim H4;Intros H5 H6;Elim H6;Intros H7 H8; Split; [ - Simpl;Rewrite H5;Auto - | Split; [ - Simpl; Rewrite H7; Trivial - | Right; - Change (Zero_suivi_de_mask (sub_pos p q))=(IsPos (sub_un (xI z))); - Rewrite H5; Auto ]] - | Intros H3; Exists xH; Rewrite H3; Split; [ - Simpl; Rewrite sub_pos_x_x; Auto - | Split; Auto ]]. - Exists (xO p); Auto. - NewDestruct (IHp q) as [z [H4 [H6 H7]]]. - Apply ZLIS; Assumption. - NewDestruct (ZL11 z) as [vZ|]; [ - Exists xH; Split; [ - Rewrite ZL10; [ Reflexivity | Rewrite vZ in H4;Assumption ] - | Split; [ - Simpl; Rewrite ZL12; Rewrite <- vZ; Rewrite H6; Trivial - | Auto ]] - | Exists (xI (sub_un z)); NewDestruct H7 as [|H8];[ - Absurd z=xH;Assumption - | Split; [ - Rewrite H8; Trivial - | Split; [ Simpl; Rewrite ZL15; [ - Rewrite H6;Trivial - | Assumption ] - | Right; Rewrite H8; Reflexivity]]]]. - NewDestruct (IHp q H) as [z [H4 [H6 H7]]]. - Exists (xO z); Split; [ - Rewrite H4;Auto - | Split; [ - Simpl;Rewrite H6;Reflexivity - | Right; - Change (Un_suivi_de_mask (sub_neg p q))=(IsPos (double_moins_un z)); - NewDestruct (ZL11 z) as [H8|H8]; [ - Rewrite H8; Simpl; - Assert H9:(sub_neg p q)=IsNul;[ - Apply ZL10;Rewrite <- H8;Assumption - | Rewrite H9;Reflexivity ] - | NewDestruct H7 as [H9|H9]; [ - Absurd z=xH;Auto - | Rewrite H9; NewDestruct z; Simpl; - [ Reflexivity - | Reflexivity - | Absurd xH=xH; [Assumption | Reflexivity]]]]]]. - Exists (double_moins_un p); Split; [ - Reflexivity - | Clear IHp; Split; [ - NewDestruct p; Simpl; [ - Reflexivity - | Rewrite is_double_moins_un; Reflexivity - | Reflexivity ] - | NewDestruct p; [Right|Right|Left]; Reflexivity ]]. -Qed. - -Theorem sub_add: -(x,y:positive) (compare x y EGAL) = SUPERIEUR -> (add y (true_sub x y)) = x. -Proof. -Intros x y H;Elim sub_pos_SUPERIEUR with 1:=H; -Intros z H1;Elim H1;Intros H2 H3; Elim H3;Intros H4 H5; -Unfold true_sub ;Rewrite H2; Exact H4. +Lemma Pminus_mask_Gt : + forall p q:positive, + (p ?= q) Eq = Gt -> + exists h : positive + | Pminus_mask p q = IsPos h /\ + q + h = p /\ (h = xH \/ Pminus_mask_carry p q = IsPos (Ppred h)). +Proof. +intro x; induction x as [p| p| ]; intro y; destruct y as [q| q| ]; + simpl in |- *; intro H; try discriminate H. + destruct (IHp q H) as [z [H4 [H6 H7]]]; exists (xO z); split. + rewrite H4; reflexivity. + split. + simpl in |- *; rewrite H6; reflexivity. + right; clear H6; destruct (ZL11 z) as [H8| H8]; + [ rewrite H8; rewrite H8 in H4; rewrite ZL10; + [ reflexivity | assumption ] + | clear H4; destruct H7 as [H9| H9]; + [ absurd (z = xH); assumption + | rewrite H9; clear H9; destruct z as [p0| p0| ]; + [ reflexivity | reflexivity | absurd (xH = xH); trivial ] ] ]. + case Pcompare_Gt_Gt with (1 := H); + [ intros H3; elim (IHp q H3); intros z H4; exists (xI z); elim H4; + intros H5 H6; elim H6; intros H7 H8; split; + [ simpl in |- *; rewrite H5; auto + | split; + [ simpl in |- *; rewrite H7; trivial + | right; + change (Pdouble_mask (Pminus_mask p q) = IsPos (Ppred (xI z))) + in |- *; rewrite H5; auto ] ] + | intros H3; exists xH; rewrite H3; split; + [ simpl in |- *; rewrite Pminus_mask_diag; auto | split; auto ] ]. + exists (xO p); auto. + destruct (IHp q) as [z [H4 [H6 H7]]]. + apply Pcompare_Lt_Gt; assumption. + destruct (ZL11 z) as [vZ| ]; + [ exists xH; split; + [ rewrite ZL10; [ reflexivity | rewrite vZ in H4; assumption ] + | split; + [ simpl in |- *; rewrite Pplus_one_succ_r; rewrite <- vZ; + rewrite H6; trivial + | auto ] ] + | exists (xI (Ppred z)); destruct H7 as [| H8]; + [ absurd (z = xH); assumption + | split; + [ rewrite H8; trivial + | split; + [ simpl in |- *; rewrite Pplus_carry_pred_eq_plus; + [ rewrite H6; trivial | assumption ] + | right; rewrite H8; reflexivity ] ] ] ]. + destruct (IHp q H) as [z [H4 [H6 H7]]]. + exists (xO z); split; + [ rewrite H4; auto + | split; + [ simpl in |- *; rewrite H6; reflexivity + | right; + change + (Pdouble_plus_one_mask (Pminus_mask_carry p q) = + IsPos (Pdouble_minus_one z)) in |- *; + destruct (ZL11 z) as [H8| H8]; + [ rewrite H8; simpl in |- *; + assert (H9 : Pminus_mask_carry p q = IsNul); + [ apply ZL10; rewrite <- H8; assumption + | rewrite H9; reflexivity ] + | destruct H7 as [H9| H9]; + [ absurd (z = xH); auto + | rewrite H9; destruct z as [p0| p0| ]; simpl in |- *; + [ reflexivity + | reflexivity + | absurd (xH = xH); [ assumption | reflexivity ] ] ] ] ] ]. + exists (Pdouble_minus_one p); split; + [ reflexivity + | clear IHp; split; + [ destruct p; simpl in |- *; + [ reflexivity + | rewrite Psucc_o_double_minus_one_eq_xO; reflexivity + | reflexivity ] + | destruct p; [ right | right | left ]; reflexivity ] ]. +Qed. + +Theorem Pplus_minus : + forall p q:positive, (p ?= q) Eq = Gt -> q + (p - q) = p. +Proof. +intros x y H; elim Pminus_mask_Gt with (1 := H); intros z H1; elim H1; + intros H2 H3; elim H3; intros H4 H5; unfold Pminus in |- *; + rewrite H2; exact H4. Qed. - diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v index e3392de4c..5e5ab1f0d 100644 --- a/theories/NArith/NArith.v +++ b/theories/NArith/NArith.v @@ -11,4 +11,4 @@ (** Library for binary natural numbers *) Require Export BinPos. -Require Export BinNat. +Require Export BinNat.
\ No newline at end of file diff --git a/theories/NArith/Pnat.v b/theories/NArith/Pnat.v index 22c6b5cb9..c0e2bb020 100644 --- a/theories/NArith/Pnat.v +++ b/theories/NArith/Pnat.v @@ -8,7 +8,7 @@ (*i $Id$ i*) -Require BinPos. +Require Import BinPos. (**********************************************************************) (** Properties of the injection from binary positive numbers to Peano @@ -16,144 +16,142 @@ Require BinPos. (** Original development by Pierre Crégut, CNET, Lannion, France *) -Require Le. -Require Lt. -Require Gt. -Require Plus. -Require Mult. -Require Minus. +Require Import Le. +Require Import Lt. +Require Import Gt. +Require Import Plus. +Require Import Mult. +Require Import Minus. (** [nat_of_P] is a morphism for addition *) -Lemma convert_add_un : - (x:positive)(m:nat) - (positive_to_nat (add_un x) m) = (plus m (positive_to_nat x m)). +Lemma Pmult_nat_succ_morphism : + forall (p:positive) (n:nat), Pmult_nat (Psucc p) n = n + Pmult_nat p n. Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; Simpl; Auto; Intro m; Rewrite IHp; -Rewrite plus_assoc_l; Trivial. +intro x; induction x as [p IHp| p IHp| ]; simpl in |- *; auto; intro m; + rewrite IHp; rewrite plus_assoc; trivial. Qed. -Lemma cvt_add_un : - (p:positive) (convert (add_un p)) = (S (convert p)). +Lemma nat_of_P_succ_morphism : + forall p:positive, nat_of_P (Psucc p) = S (nat_of_P p). Proof. - Intro; Change (S (convert p)) with (plus (S O) (convert p)); - Unfold convert; Apply convert_add_un. + intro; change (S (nat_of_P p)) with (1 + nat_of_P p) in |- *; + unfold nat_of_P in |- *; apply Pmult_nat_succ_morphism. Qed. -Theorem convert_add_carry : - (x,y:positive)(m:nat) - (positive_to_nat (add_carry x y) m) = - (plus m (positive_to_nat (add x y) m)). +Theorem Pmult_nat_plus_carry_morphism : + forall (p q:positive) (n:nat), + Pmult_nat (Pplus_carry p q) n = n + Pmult_nat (p + q) n. Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; - Intro y; NewDestruct y; Simpl; Auto with arith; Intro m; [ - Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith -| Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith -| Rewrite convert_add_un; Rewrite plus_assoc_l; Trivial with arith -| Rewrite convert_add_un; Apply plus_assoc_r ]. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; simpl in |- *; auto with arith; + intro m; + [ rewrite IHp; rewrite plus_assoc; trivial with arith + | rewrite IHp; rewrite plus_assoc; trivial with arith + | rewrite Pmult_nat_succ_morphism; rewrite plus_assoc; trivial with arith + | rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ]. Qed. -Theorem cvt_carry : - (x,y:positive)(convert (add_carry x y)) = (S (convert (add x y))). +Theorem nat_of_P_plus_carry_morphism : + forall p q:positive, nat_of_P (Pplus_carry p q) = S (nat_of_P (p + q)). Proof. -Intros;Unfold convert; Rewrite convert_add_carry; Simpl; Trivial with arith. +intros; unfold nat_of_P in |- *; rewrite Pmult_nat_plus_carry_morphism; + simpl in |- *; trivial with arith. Qed. -Theorem add_verif : - (x,y:positive)(m:nat) - (positive_to_nat (add x y) m) = - (plus (positive_to_nat x m) (positive_to_nat y m)). +Theorem Pmult_nat_l_plus_morphism : + forall (p q:positive) (n:nat), + Pmult_nat (p + q) n = Pmult_nat p n + Pmult_nat q n. Proof. -Intro x; NewInduction x as [p IHp|p IHp|]; - Intro y; NewDestruct y;Simpl;Auto with arith; [ - Intros m;Rewrite convert_add_carry; Rewrite IHp; - Rewrite plus_assoc_r; Rewrite plus_assoc_r; - Rewrite (plus_permute m (positive_to_nat p (plus m m))); Trivial with arith -| Intros m; Rewrite IHp; Apply plus_assoc_l -| Intros m; Rewrite convert_add_un; - Rewrite (plus_sym (plus m (positive_to_nat p (plus m m)))); - Apply plus_assoc_r -| Intros m; Rewrite IHp; Apply plus_permute -| Intros m; Rewrite convert_add_un; Apply plus_assoc_r ]. +intro x; induction x as [p IHp| p IHp| ]; intro y; + [ destruct y as [p0| p0| ] + | destruct y as [p0| p0| ] + | destruct y as [p| p| ] ]; simpl in |- *; auto with arith; + [ intros m; rewrite Pmult_nat_plus_carry_morphism; rewrite IHp; + rewrite plus_assoc_reverse; rewrite plus_assoc_reverse; + rewrite (plus_permute m (Pmult_nat p (m + m))); + trivial with arith + | intros m; rewrite IHp; apply plus_assoc + | intros m; rewrite Pmult_nat_succ_morphism; + rewrite (plus_comm (m + Pmult_nat p (m + m))); + apply plus_assoc_reverse + | intros m; rewrite IHp; apply plus_permute + | intros m; rewrite Pmult_nat_succ_morphism; apply plus_assoc_reverse ]. Qed. -Theorem convert_add: - (x,y:positive) (convert (add x y)) = (plus (convert x) (convert y)). +Theorem nat_of_P_plus_morphism : + forall p q:positive, nat_of_P (p + q) = nat_of_P p + nat_of_P q. Proof. -Intros x y; Exact (add_verif x y (S O)). +intros x y; exact (Pmult_nat_l_plus_morphism x y 1). Qed. (** [Pmult_nat] is a morphism for addition *) -Lemma ZL2: - (y:positive)(m:nat) - (positive_to_nat y (plus m m)) = - (plus (positive_to_nat y m) (positive_to_nat y m)). +Lemma Pmult_nat_r_plus_morphism : + forall (p:positive) (n:nat), + Pmult_nat p (n + n) = Pmult_nat p n + Pmult_nat p n. Proof. -Intro y; NewInduction y as [p H|p H|]; Intro m; [ - Simpl; Rewrite H; Rewrite plus_assoc_r; - Rewrite (plus_permute m (positive_to_nat p (plus m m))); - Rewrite plus_assoc_r; Auto with arith -| Simpl; Rewrite H; Auto with arith -| Simpl; Trivial with arith ]. +intro y; induction y as [p H| p H| ]; intro m; + [ simpl in |- *; rewrite H; rewrite plus_assoc_reverse; + rewrite (plus_permute m (Pmult_nat p (m + m))); + rewrite plus_assoc_reverse; auto with arith + | simpl in |- *; rewrite H; auto with arith + | simpl in |- *; trivial with arith ]. Qed. -Lemma ZL6: - (p:positive) (positive_to_nat p (S (S O))) = (plus (convert p) (convert p)). +Lemma ZL6 : forall p:positive, Pmult_nat p 2 = nat_of_P p + nat_of_P p. Proof. -Intro p;Change (2) with (plus (S O) (S O)); Rewrite ZL2; Trivial. +intro p; change 2 with (1 + 1) in |- *; rewrite Pmult_nat_r_plus_morphism; + trivial. Qed. (** [nat_of_P] is a morphism for multiplication *) -Theorem times_convert : - (x,y:positive) (convert (times x y)) = (mult (convert x) (convert y)). -Proof. -Intros x y; NewInduction x as [ x' H | x' H | ]; [ - Change (times (xI x') y) with (add y (xO (times x' y))); Rewrite convert_add; - Unfold 2 3 convert; Simpl; Do 2 Rewrite ZL6; Rewrite H; - Rewrite -> mult_plus_distr; Reflexivity -| Unfold 1 2 convert; Simpl; Do 2 Rewrite ZL6; - Rewrite H; Rewrite mult_plus_distr; Reflexivity -| Simpl; Rewrite <- plus_n_O; Reflexivity ]. -Qed. -V7only [ - Comments "Compatibility with the old version of times and times_convert". - Syntactic Definition times1 := - [x:positive;_:positive->positive;y:positive](times x y). - Syntactic Definition times1_convert := - [x,y:positive;_:positive->positive](times_convert x y). -]. +Theorem nat_of_P_mult_morphism : + forall p q:positive, nat_of_P (p * q) = nat_of_P p * nat_of_P q. +Proof. +intros x y; induction x as [x' H| x' H| ]; + [ change (xI x' * y)%positive with (y + xO (x' * y))%positive in |- *; + rewrite nat_of_P_plus_morphism; unfold nat_of_P at 2 3 in |- *; + simpl in |- *; do 2 rewrite ZL6; rewrite H; rewrite mult_plus_distr_r; + reflexivity + | unfold nat_of_P at 1 2 in |- *; simpl in |- *; do 2 rewrite ZL6; rewrite H; + rewrite mult_plus_distr_r; reflexivity + | simpl in |- *; rewrite <- plus_n_O; reflexivity ]. +Qed. (** [nat_of_P] maps to the strictly positive subset of [nat] *) -Lemma ZL4: (y:positive) (EX h:nat |(convert y)=(S h)). +Lemma ZL4 : forall p:positive, exists h : nat | nat_of_P p = S h. Proof. -Intro y; NewInduction y as [p H|p H|]; [ - NewDestruct H as [x H1]; Exists (plus (S x) (S x)); - Unfold convert ;Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2; Unfold convert in H1; - Rewrite H1; Auto with arith -| NewDestruct H as [x H2]; Exists (plus x (S x)); Unfold convert; - Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith -| Exists O ;Auto with arith ]. +intro y; induction y as [p H| p H| ]; + [ destruct H as [x H1]; exists (S x + S x); unfold nat_of_P in |- *; + simpl in |- *; change 2 with (1 + 1) in |- *; + rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H1; + rewrite H1; auto with arith + | destruct H as [x H2]; exists (x + S x); unfold nat_of_P in |- *; + simpl in |- *; change 2 with (1 + 1) in |- *; + rewrite Pmult_nat_r_plus_morphism; unfold nat_of_P in H2; + rewrite H2; auto with arith + | exists 0; auto with arith ]. Qed. (** Extra lemmas on [lt] on Peano natural numbers *) -Lemma ZL7: - (m,n:nat) (lt m n) -> (lt (plus m m) (plus n n)). +Lemma ZL7 : forall n m:nat, n < m -> n + n < m + m. Proof. -Intros m n H; Apply lt_trans with m:=(plus m n); [ - Apply lt_reg_l with 1:=H -| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ]. +intros m n H; apply lt_trans with (m := m + n); + [ apply plus_lt_compat_l with (1 := H) + | rewrite (plus_comm m n); apply plus_lt_compat_l with (1 := H) ]. Qed. -Lemma ZL8: - (m,n:nat) (lt m n) -> (lt (S (plus m m)) (plus n n)). +Lemma ZL8 : forall n m:nat, n < m -> S (n + n) < m + m. Proof. -Intros m n H; Apply le_lt_trans with m:=(plus m n); [ - Change (lt (plus m m) (plus m n)) ; Apply lt_reg_l with 1:=H -| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ]. +intros m n H; apply le_lt_trans with (m := m + n); + [ change (m + m < m + n) in |- *; apply plus_lt_compat_l with (1 := H) + | rewrite (plus_comm m n); apply plus_lt_compat_l with (1 := H) ]. Qed. (** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed @@ -162,29 +160,30 @@ Qed. Part 1: [lt] on [positive] is finer than [lt] on [nat] *) -Lemma compare_convert_INFERIEUR : - (x,y:positive) (compare x y EGAL) = INFERIEUR -> - (lt (convert x) (convert y)). -Proof. -Intro x; NewInduction x as [p H|p H|];Intro y; NewDestruct y as [q|q|]; - Intro H2; [ - Unfold convert ;Simpl; Apply lt_n_S; - Do 2 Rewrite ZL6; Apply ZL7; Apply H; Simpl in H2; Assumption -| Unfold convert ;Simpl; Do 2 Rewrite ZL6; - Apply ZL8; Apply H;Simpl in H2; Apply ZLSI;Assumption -| Simpl; Discriminate H2 -| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; - Elim (ZLII p q H2); [ - Intros H3;Apply lt_S;Apply ZL7; Apply H;Apply H3 - | Intros E;Rewrite E;Apply lt_n_Sn] -| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; - Apply ZL7;Apply H;Assumption -| Simpl; Discriminate H2 -| Unfold convert ;Simpl; Apply lt_n_S; Rewrite ZL6; - Elim (ZL4 q);Intros h H3; Rewrite H3;Simpl; Apply lt_O_Sn -| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 q);Intros h H3; - Rewrite H3; Simpl; Rewrite <- plus_n_Sm; Apply lt_n_S; Apply lt_O_Sn -| Simpl; Discriminate H2 ]. +Lemma nat_of_P_lt_Lt_compare_morphism : + forall p q:positive, (p ?= q)%positive Eq = Lt -> nat_of_P p < nat_of_P q. +Proof. +intro x; induction x as [p H| p H| ]; intro y; destruct y as [q| q| ]; + intro H2; + [ unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; do 2 rewrite ZL6; + apply ZL7; apply H; simpl in H2; assumption + | unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; apply ZL8; + apply H; simpl in H2; apply Pcompare_Gt_Lt; assumption + | simpl in |- *; discriminate H2 + | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; + elim (Pcompare_Lt_Lt p q H2); + [ intros H3; apply lt_S; apply ZL7; apply H; apply H3 + | intros E; rewrite E; apply lt_n_Sn ] + | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; + apply ZL7; apply H; assumption + | simpl in |- *; discriminate H2 + | unfold nat_of_P in |- *; simpl in |- *; apply lt_n_S; rewrite ZL6; + elim (ZL4 q); intros h H3; rewrite H3; simpl in |- *; + apply lt_O_Sn + | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 q); + intros h H3; rewrite H3; simpl in |- *; rewrite <- plus_n_Sm; + apply lt_n_S; apply lt_O_Sn + | simpl in |- *; discriminate H2 ]. Qed. (** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed @@ -193,29 +192,30 @@ Qed. Part 1: [gt] on [positive] is finer than [gt] on [nat] *) -Lemma compare_convert_SUPERIEUR : - (x,y:positive) (compare x y EGAL)=SUPERIEUR -> (gt (convert x) (convert y)). -Proof. -Unfold gt; Intro x; NewInduction x as [p H|p H|]; - Intro y; NewDestruct y as [q|q|]; Intro H2; [ - Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; - Apply lt_n_S; Apply ZL7; Apply H;Assumption -| Simpl; Unfold convert ;Simpl; Do 2 Rewrite ZL6; - Elim (ZLSS p q H2); [ - Intros H3;Apply lt_S;Apply ZL7;Apply H;Assumption - | Intros E;Rewrite E;Apply lt_n_Sn] -| Unfold convert ;Simpl; Rewrite ZL6;Elim (ZL4 p); - Intros h H3;Rewrite H3;Simpl; Apply lt_n_S; Apply lt_O_Sn -| Simpl;Unfold convert ;Simpl;Do 2 Rewrite ZL6; - Apply ZL8; Apply H; Apply ZLIS; Assumption -| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; - Apply ZL7;Apply H;Assumption -| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 p); - Intros h H3;Rewrite H3;Simpl; Rewrite <- plus_n_Sm;Apply lt_n_S; - Apply lt_O_Sn -| Simpl; Discriminate H2 -| Simpl; Discriminate H2 -| Simpl; Discriminate H2 ]. +Lemma nat_of_P_gt_Gt_compare_morphism : + forall p q:positive, (p ?= q)%positive Eq = Gt -> nat_of_P p > nat_of_P q. +Proof. +unfold gt in |- *; intro x; induction x as [p H| p H| ]; intro y; + destruct y as [q| q| ]; intro H2; + [ simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; + apply lt_n_S; apply ZL7; apply H; assumption + | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; + elim (Pcompare_Gt_Gt p q H2); + [ intros H3; apply lt_S; apply ZL7; apply H; assumption + | intros E; rewrite E; apply lt_n_Sn ] + | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 p); + intros h H3; rewrite H3; simpl in |- *; apply lt_n_S; + apply lt_O_Sn + | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; + apply ZL8; apply H; apply Pcompare_Lt_Gt; assumption + | simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; do 2 rewrite ZL6; + apply ZL7; apply H; assumption + | unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; elim (ZL4 p); + intros h H3; rewrite H3; simpl in |- *; rewrite <- plus_n_Sm; + apply lt_n_S; apply lt_O_Sn + | simpl in |- *; discriminate H2 + | simpl in |- *; discriminate H2 + | simpl in |- *; discriminate H2 ]. Qed. (** [nat_of_P] is a morphism from [positive] to [nat] for [lt] (expressed @@ -224,18 +224,18 @@ Qed. Part 2: [lt] on [nat] is finer than [lt] on [positive] *) -Lemma convert_compare_INFERIEUR : - (x,y:positive)(lt (convert x) (convert y)) -> (compare x y EGAL) = INFERIEUR. +Lemma nat_of_P_lt_Lt_compare_complement_morphism : + forall p q:positive, nat_of_P p < nat_of_P q -> (p ?= q)%positive Eq = Lt. Proof. -Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [ - Intros E; Rewrite (compare_convert_EGAL x y E); - Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ] -| Intros H;Elim H; [ - Auto - | Intros H1 H2; Absurd (lt (convert x) (convert y)); [ - Apply lt_not_sym; Change (gt (convert x) (convert y)); - Apply compare_convert_SUPERIEUR; Assumption - | Assumption ]]]. +intros x y; unfold gt in |- *; elim (Dcompare ((x ?= y)%positive Eq)); + [ intros E; rewrite (Pcompare_Eq_eq x y E); intros H; + absurd (nat_of_P y < nat_of_P y); [ apply lt_irrefl | assumption ] + | intros H; elim H; + [ auto + | intros H1 H2; absurd (nat_of_P x < nat_of_P y); + [ apply lt_asym; change (nat_of_P x > nat_of_P y) in |- *; + apply nat_of_P_gt_Gt_compare_morphism; assumption + | assumption ] ] ]. Qed. (** [nat_of_P] is a morphism from [positive] to [nat] for [gt] (expressed @@ -244,78 +244,78 @@ Qed. Part 2: [gt] on [nat] is finer than [gt] on [positive] *) -Lemma convert_compare_SUPERIEUR : - (x,y:positive)(gt (convert x) (convert y)) -> (compare x y EGAL) = SUPERIEUR. +Lemma nat_of_P_gt_Gt_compare_complement_morphism : + forall p q:positive, nat_of_P p > nat_of_P q -> (p ?= q)%positive Eq = Gt. Proof. -Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [ - Intros E; Rewrite (compare_convert_EGAL x y E); - Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ] -| Intros H;Elim H; [ - Intros H1 H2; Absurd (lt (convert y) (convert x)); [ - Apply lt_not_sym; Apply compare_convert_INFERIEUR; Assumption - | Assumption ] - | Auto]]. +intros x y; unfold gt in |- *; elim (Dcompare ((x ?= y)%positive Eq)); + [ intros E; rewrite (Pcompare_Eq_eq x y E); intros H; + absurd (nat_of_P y < nat_of_P y); [ apply lt_irrefl | assumption ] + | intros H; elim H; + [ intros H1 H2; absurd (nat_of_P y < nat_of_P x); + [ apply lt_asym; apply nat_of_P_lt_Lt_compare_morphism; assumption + | assumption ] + | auto ] ]. Qed. (** [nat_of_P] is strictly positive *) -Lemma compare_positive_to_nat_O : - (p:positive)(m:nat)(le m (positive_to_nat p m)). -NewInduction p; Simpl; Auto with arith. -Intro m; Apply le_trans with (plus m m); Auto with arith. +Lemma le_Pmult_nat : forall (p:positive) (n:nat), n <= Pmult_nat p n. +induction p; simpl in |- *; auto with arith. +intro m; apply le_trans with (m + m); auto with arith. Qed. -Lemma compare_convert_O : (p:positive)(lt O (convert p)). -Intro; Unfold convert; Apply lt_le_trans with (S O); Auto with arith. -Apply compare_positive_to_nat_O. +Lemma lt_O_nat_of_P : forall p:positive, 0 < nat_of_P p. +intro; unfold nat_of_P in |- *; apply lt_le_trans with 1; auto with arith. +apply le_Pmult_nat. Qed. (** Pmult_nat permutes with multiplication *) -Lemma positive_to_nat_mult : (p:positive) (n,m:nat) - (positive_to_nat p (mult m n))=(mult m (positive_to_nat p n)). +Lemma Pmult_nat_mult_permute : + forall (p:positive) (n m:nat), Pmult_nat p (m * n) = m * Pmult_nat p n. Proof. - Induction p. Intros. Simpl. Rewrite mult_plus_distr_r. Rewrite <- (mult_plus_distr_r m n n). - Rewrite (H (plus n n) m). Reflexivity. - Intros. Simpl. Rewrite <- (mult_plus_distr_r m n n). Apply H. - Trivial. + simple induction p. intros. simpl in |- *. rewrite mult_plus_distr_l. rewrite <- (mult_plus_distr_l m n n). + rewrite (H (n + n) m). reflexivity. + intros. simpl in |- *. rewrite <- (mult_plus_distr_l m n n). apply H. + trivial. Qed. -Lemma positive_to_nat_2 : (p:positive) - (positive_to_nat p (2))=(mult (2) (positive_to_nat p (1))). +Lemma Pmult_nat_2_mult_2_permute : + forall p:positive, Pmult_nat p 2 = 2 * Pmult_nat p 1. Proof. - Intros. Rewrite <- positive_to_nat_mult. Reflexivity. + intros. rewrite <- Pmult_nat_mult_permute. reflexivity. Qed. -Lemma positive_to_nat_4 : (p:positive) - (positive_to_nat p (4))=(mult (2) (positive_to_nat p (2))). +Lemma Pmult_nat_4_mult_2_permute : + forall p:positive, Pmult_nat p 4 = 2 * Pmult_nat p 2. Proof. - Intros. Rewrite <- positive_to_nat_mult. Reflexivity. + intros. rewrite <- Pmult_nat_mult_permute. reflexivity. Qed. (** Mapping of xH, xO and xI through [nat_of_P] *) -Lemma convert_xH : (convert xH)=(1). +Lemma nat_of_P_xH : nat_of_P 1 = 1. Proof. - Reflexivity. + reflexivity. Qed. -Lemma convert_xO : (p:positive) (convert (xO p))=(mult (2) (convert p)). +Lemma nat_of_P_xO : forall p:positive, nat_of_P (xO p) = 2 * nat_of_P p. Proof. - Induction p. Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. - Rewrite positive_to_nat_4. Rewrite H. Simpl. Rewrite <- plus_Snm_nSm. Reflexivity. - Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4. - Rewrite H. Reflexivity. - Reflexivity. + simple induction p. unfold nat_of_P in |- *. simpl in |- *. intros. rewrite Pmult_nat_2_mult_2_permute. + rewrite Pmult_nat_4_mult_2_permute. rewrite H. simpl in |- *. rewrite <- plus_Snm_nSm. reflexivity. + unfold nat_of_P in |- *. simpl in |- *. intros. rewrite Pmult_nat_2_mult_2_permute. rewrite Pmult_nat_4_mult_2_permute. + rewrite H. reflexivity. + reflexivity. Qed. -Lemma convert_xI : (p:positive) (convert (xI p))=(S (mult (2) (convert p))). +Lemma nat_of_P_xI : forall p:positive, nat_of_P (xI p) = S (2 * nat_of_P p). Proof. - Induction p. Unfold convert. Simpl. Intro p0. Intro. Rewrite positive_to_nat_2. - Rewrite positive_to_nat_4; Injection H; Intro H1; Rewrite H1; Rewrite <- plus_Snm_nSm; Reflexivity. - Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4. - Injection H; Intro H1; Rewrite H1; Reflexivity. - Reflexivity. + simple induction p. unfold nat_of_P in |- *. simpl in |- *. intro p0. intro. rewrite Pmult_nat_2_mult_2_permute. + rewrite Pmult_nat_4_mult_2_permute; injection H; intro H1; rewrite H1; + rewrite <- plus_Snm_nSm; reflexivity. + unfold nat_of_P in |- *. simpl in |- *. intros. rewrite Pmult_nat_2_mult_2_permute. rewrite Pmult_nat_4_mult_2_permute. + injection H; intro H1; rewrite H1; reflexivity. + reflexivity. Qed. (**********************************************************************) @@ -324,54 +324,61 @@ Qed. (** Composition of [P_of_succ_nat] and [nat_of_P] is successor on [nat] *) -Theorem bij1 : (m:nat) (convert (anti_convert m)) = (S m). +Theorem nat_of_P_o_P_of_succ_nat_eq_succ : + forall n:nat, nat_of_P (P_of_succ_nat n) = S n. Proof. -Intro m; NewInduction m as [|n H]; [ - Reflexivity -| Simpl; Rewrite cvt_add_un; Rewrite H; Auto ]. +intro m; induction m as [| n H]; + [ reflexivity + | simpl in |- *; rewrite nat_of_P_succ_morphism; rewrite H; auto ]. Qed. (** Miscellaneous lemmas on [P_of_succ_nat] *) -Lemma ZL3: (x:nat) (add_un (anti_convert (plus x x))) = (xO (anti_convert x)). +Lemma ZL3 : + forall n:nat, Psucc (P_of_succ_nat (n + n)) = xO (P_of_succ_nat n). Proof. -Intro x; NewInduction x as [|n H]; [ - Simpl; Auto with arith -| Simpl; Rewrite plus_sym; Simpl; Rewrite H; Rewrite ZL1;Auto with arith]. +intro x; induction x as [| n H]; + [ simpl in |- *; auto with arith + | simpl in |- *; rewrite plus_comm; simpl in |- *; rewrite H; + rewrite xO_succ_permute; auto with arith ]. Qed. -Lemma ZL5: (x:nat) (anti_convert (plus (S x) (S x))) = (xI (anti_convert x)). +Lemma ZL5 : forall n:nat, P_of_succ_nat (S n + S n) = xI (P_of_succ_nat n). Proof. -Intro x; NewInduction x as [|n H];Simpl; [ - Auto with arith -| Rewrite <- plus_n_Sm; Simpl; Simpl in H; Rewrite H; Auto with arith]. +intro x; induction x as [| n H]; simpl in |- *; + [ auto with arith + | rewrite <- plus_n_Sm; simpl in |- *; simpl in H; rewrite H; + auto with arith ]. Qed. (** Composition of [nat_of_P] and [P_of_succ_nat] is successor on [positive] *) -Theorem bij2 : (x:positive) (anti_convert (convert x)) = (add_un x). +Theorem P_of_succ_nat_o_nat_of_P_eq_succ : + forall p:positive, P_of_succ_nat (nat_of_P p) = Psucc p. Proof. -Intro x; NewInduction x as [p H|p H|]; [ - Simpl; Rewrite <- H; Change (2) with (plus (1) (1)); - Rewrite ZL2; Elim (ZL4 p); - Unfold convert; Intros n H1;Rewrite H1; Rewrite ZL3; Auto with arith -| Unfold convert ;Simpl; Change (2) with (plus (1) (1)); - Rewrite ZL2; - Rewrite <- (sub_add_one - (anti_convert - (plus (positive_to_nat p (S O)) (positive_to_nat p (S O))))); - Rewrite <- (sub_add_one (xI p)); - Simpl;Rewrite <- H;Elim (ZL4 p); Unfold convert ;Intros n H1;Rewrite H1; - Rewrite ZL5; Simpl; Trivial with arith -| Unfold convert; Simpl; Auto with arith ]. +intro x; induction x as [p H| p H| ]; + [ simpl in |- *; rewrite <- H; change 2 with (1 + 1) in |- *; + rewrite Pmult_nat_r_plus_morphism; elim (ZL4 p); + unfold nat_of_P in |- *; intros n H1; rewrite H1; + rewrite ZL3; auto with arith + | unfold nat_of_P in |- *; simpl in |- *; change 2 with (1 + 1) in |- *; + rewrite Pmult_nat_r_plus_morphism; + rewrite <- (Ppred_succ (P_of_succ_nat (Pmult_nat p 1 + Pmult_nat p 1))); + rewrite <- (Ppred_succ (xI p)); simpl in |- *; + rewrite <- H; elim (ZL4 p); unfold nat_of_P in |- *; + intros n H1; rewrite H1; rewrite ZL5; simpl in |- *; + trivial with arith + | unfold nat_of_P in |- *; simpl in |- *; auto with arith ]. Qed. (** Composition of [nat_of_P], [P_of_succ_nat] and [Ppred] is identity on [positive] *) -Theorem bij3: (x:positive)(sub_un (anti_convert (convert x))) = x. +Theorem pred_o_P_of_succ_nat_o_nat_of_P_eq_id : + forall p:positive, Ppred (P_of_succ_nat (nat_of_P p)) = p. Proof. -Intros x; Rewrite bij2; Rewrite sub_add_one; Trivial with arith. +intros x; rewrite P_of_succ_nat_o_nat_of_P_eq_succ; rewrite Ppred_succ; + trivial with arith. Qed. (**********************************************************************) @@ -380,93 +387,99 @@ Qed. (** [nat_of_P] is a morphism for subtraction on positive numbers *) -Theorem true_sub_convert: - (x,y:positive) (compare x y EGAL) = SUPERIEUR -> - (convert (true_sub x y)) = (minus (convert x) (convert y)). +Theorem nat_of_P_minus_morphism : + forall p q:positive, + (p ?= q)%positive Eq = Gt -> nat_of_P (p - q) = nat_of_P p - nat_of_P q. Proof. -Intros x y H; Apply plus_reg_l with (convert y); -Rewrite le_plus_minus_r; [ - Rewrite <- convert_add; Rewrite sub_add; Auto with arith -| Apply lt_le_weak; Exact (compare_convert_SUPERIEUR x y H)]. +intros x y H; apply plus_reg_l with (nat_of_P y); rewrite le_plus_minus_r; + [ rewrite <- nat_of_P_plus_morphism; rewrite Pplus_minus; auto with arith + | apply lt_le_weak; exact (nat_of_P_gt_Gt_compare_morphism x y H) ]. Qed. (** [nat_of_P] is injective *) -Lemma convert_intro : (x,y:positive)(convert x)=(convert y) -> x=y. +Lemma nat_of_P_inj : forall p q:positive, nat_of_P p = nat_of_P q -> p = q. Proof. -Intros x y H;Rewrite <- (bij3 x);Rewrite <- (bij3 y); Rewrite H; Trivial with arith. +intros x y H; rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id x); + rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id y); + rewrite H; trivial with arith. Qed. -Lemma ZL16: (p,q:positive)(lt (minus (convert p) (convert q)) (convert p)). +Lemma ZL16 : forall p q:positive, nat_of_P p - nat_of_P q < nat_of_P p. Proof. -Intros p q; Elim (ZL4 p);Elim (ZL4 q); Intros h H1 i H2; -Rewrite H1;Rewrite H2; Simpl;Unfold lt; Apply le_n_S; Apply le_minus. +intros p q; elim (ZL4 p); elim (ZL4 q); intros h H1 i H2; rewrite H1; + rewrite H2; simpl in |- *; unfold lt in |- *; apply le_n_S; + apply le_minus. Qed. -Lemma ZL17: (p,q:positive)(lt (convert p) (convert (add p q))). +Lemma ZL17 : forall p q:positive, nat_of_P p < nat_of_P (p + q). Proof. -Intros p q; Rewrite convert_add;Unfold lt;Elim (ZL4 q); Intros k H;Rewrite H; -Rewrite plus_sym;Simpl; Apply le_n_S; Apply le_plus_r. +intros p q; rewrite nat_of_P_plus_morphism; unfold lt in |- *; elim (ZL4 q); + intros k H; rewrite H; rewrite plus_comm; simpl in |- *; + apply le_n_S; apply le_plus_r. Qed. (** Comparison and subtraction *) -Lemma compare_true_sub_right : - (p,q,z:positive) - (compare q p EGAL)=INFERIEUR-> - (compare z p EGAL)=SUPERIEUR-> - (compare z q EGAL)=SUPERIEUR-> - (compare (true_sub z p) (true_sub z q) EGAL)=INFERIEUR. -Proof. -Intros; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [ - Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p); - Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [ - Rewrite (plus_sym (convert p)); Apply lt_reg_l; - Apply compare_convert_INFERIEUR; Assumption - | Apply lt_le_weak; Apply compare_convert_INFERIEUR; - Apply ZC1; Assumption ] - | Apply lt_le_weak;Apply compare_convert_INFERIEUR; - Apply ZC1; Assumption ] - | Assumption ] - | Assumption ]. -Qed. - -Lemma compare_true_sub_left : - (p,q,z:positive) - (compare q p EGAL)=INFERIEUR-> - (compare p z EGAL)=SUPERIEUR-> - (compare q z EGAL)=SUPERIEUR-> - (compare (true_sub q z) (true_sub p z) EGAL)=INFERIEUR. -Proof. -Intros p q z; Intros; - Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Unfold gt; Apply simpl_lt_plus_l with p:=(convert z); - Rewrite le_plus_minus_r; [ - Rewrite le_plus_minus_r; [ - Apply compare_convert_INFERIEUR;Assumption - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;Assumption] - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; Assumption] - | Assumption] -| Assumption]. +Lemma Pcompare_minus_r : + forall p q r:positive, + (q ?= p)%positive Eq = Lt -> + (r ?= p)%positive Eq = Gt -> + (r ?= q)%positive Eq = Gt -> (r - p ?= r - q)%positive Eq = Lt. +Proof. +intros; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P q); rewrite le_plus_minus_r; + [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p); + rewrite plus_assoc; rewrite le_plus_minus_r; + [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism; + assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption ] + | assumption ] + | assumption ]. +Qed. + +Lemma Pcompare_minus_l : + forall p q r:positive, + (q ?= p)%positive Eq = Lt -> + (p ?= r)%positive Eq = Gt -> + (q ?= r)%positive Eq = Gt -> (q - r ?= p - r)%positive Eq = Lt. +Proof. +intros p q z; intros; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z); + rewrite le_plus_minus_r; + [ rewrite le_plus_minus_r; + [ apply nat_of_P_lt_Lt_compare_morphism; assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption ] + | assumption ] + | assumption ]. Qed. (** Distributivity of multiplication over subtraction *) -Theorem times_true_sub_distr: - (x,y,z:positive) (compare y z EGAL) = SUPERIEUR -> - (times x (true_sub y z)) = (true_sub (times x y) (times x z)). -Proof. -Intros x y z H; Apply convert_intro; -Rewrite times_convert; Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Do 2 Rewrite times_convert; - Do 3 Rewrite (mult_sym (convert x));Apply mult_minus_distr - | Apply convert_compare_SUPERIEUR; Do 2 Rewrite times_convert; - Unfold gt; Elim (ZL4 x);Intros h H1;Rewrite H1; Apply lt_mult_left; - Exact (compare_convert_SUPERIEUR y z H) ] -| Assumption ]. +Theorem Pmult_minus_distr_l : + forall p q r:positive, + (q ?= r)%positive Eq = Gt -> + (p * (q - r))%positive = (p * q - p * r)%positive. +Proof. +intros x y z H; apply nat_of_P_inj; rewrite nat_of_P_mult_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ do 2 rewrite nat_of_P_mult_morphism; + do 3 rewrite (mult_comm (nat_of_P x)); apply mult_minus_distr_r + | apply nat_of_P_gt_Gt_compare_complement_morphism; + do 2 rewrite nat_of_P_mult_morphism; unfold gt in |- *; + elim (ZL4 x); intros h H1; rewrite H1; apply mult_S_lt_compat_l; + exact (nat_of_P_gt_Gt_compare_morphism y z H) ] + | assumption ]. Qed. - diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v index 455803aa1..7d8a93914 100644 --- a/theories/Reals/Alembert.v +++ b/theories/Reals/Alembert.v @@ -8,12 +8,12 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require SeqProp. -Require PartSum. -Require Max. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import SeqProp. +Require Import PartSum. +Require Import Max. Open Local Scope R_scope. @@ -21,529 +21,706 @@ Open Local Scope R_scope. (* Various versions of the criterion of D'Alembert *) (***************************************************) -Lemma Alembert_C1 : (An:nat->R) ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intros An H H0. -Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intro; Apply X. -Apply complet. -Unfold Un_cv in H0; Unfold bound; Cut ``0</2``; [Intro | Apply Rlt_Rinv; Sup0]. -Elim (H0 ``/2`` H1); Intros. -Exists ``(sum_f_R0 An x)+2*(An (S x))``. -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 (Rplus (sum_f_R0 An x1) (sum_f_R0 [i:nat](An (plus (S x1) i)) (minus x (S x1)))). -Pattern 1 (sum_f_R0 An x1); Rewrite <- Rplus_Or; Rewrite Rplus_assoc; Apply Rle_compatibility. -Left; Apply gt0_plus_gt0_is_gt0. -Apply tech1; Intros; Apply H. -Apply Rmult_lt_pos; [Sup0 | Apply H]. -Symmetry; Apply tech2; Assumption. -Rewrite b; Pattern 1 (sum_f_R0 An x); Rewrite <- Rplus_Or; Apply Rle_compatibility. -Left; Apply Rmult_lt_pos; [Sup0 | Apply H]. -Replace (sum_f_R0 An x1) with (Rplus (sum_f_R0 An x) (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x)))). -Apply Rle_compatibility. -Cut (Rle (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x))) (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x))))). -Intro; Apply Rle_trans with (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x)))). -Assumption. -Rewrite <- (Rmult_sym (An (S x))); Apply Rle_monotony. -Left; Apply H. -Rewrite tech3. -Replace ``1-/2`` with ``/2``. -Unfold Rdiv; Rewrite Rinv_Rinv. -Pattern 3 ``2``; Rewrite <- Rmult_1r; Rewrite <- (Rmult_sym ``2``); Apply Rle_monotony. -Left; Sup0. -Left; Apply Rlt_anti_compatibility with ``(pow (/2) (S (minus x1 (S x))))``. -Replace ``(pow (/2) (S (minus x1 (S x))))+(1-(pow (/2) (S (minus x1 (S x)))))`` with R1; [Idtac | Ring]. -Rewrite <- (Rplus_sym ``1``); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility. -Apply pow_lt; Apply Rlt_Rinv; Sup0. -DiscrR. -Apply r_Rmult_mult with ``2``. -Rewrite Rminus_distr; Rewrite <- Rinv_r_sym. -Ring. -DiscrR. -DiscrR. -Pattern 3 R1; Replace R1 with ``/1``; [Apply tech7; DiscrR | Apply Rinv_R1]. -Replace (An (S x)) with (An (plus (S x) O)). -Apply (tech6 [i:nat](An (plus (S x) i)) ``/2``). -Left; Apply Rlt_Rinv; Sup0. -Intro; Cut (n:nat)(ge n x)->``(An (S n))</2*(An n)``. -Intro; Replace (plus (S x) (S i)) with (S (plus (S x) i)). -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 Rlt_monotony_contra with ``/(An n)``. -Apply Rlt_Rinv; Apply H. -Do 2 Rewrite (Rmult_sym ``/(An n)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-0))``. -Apply H2; Assumption. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_right. -Unfold Rdiv; Reflexivity. -Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply H]. -Red; Intro; Assert H8 := (H n); Rewrite H7 in H8; Elim (Rlt_antirefl ? H8). -Replace (plus (S x) O) with (S x); [Reflexivity | Ring]. -Symmetry; Apply tech2; Assumption. -Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity. -Intro; Elim X; Intros. -Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p]. +Lemma Alembert_C1 : + forall An:nat -> R, + (forall n:nat, 0 < An n) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros An H H0. +cut + (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). +intro; apply X. +apply completeness. +unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2); + [ intro | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H0 (/ 2) H1); intros. +exists (sum_f_R0 An x + 2 * An (S x)). +unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros. +rewrite H4; assert (H5 := lt_eq_lt_dec x1 x). +elim H5; intros. +elim a; intro. +replace (sum_f_R0 An x) with + (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)). +pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite Rplus_assoc; apply Rplus_le_compat_l. +left; apply Rplus_lt_0_compat. +apply tech1; intros; apply H. +apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. +symmetry in |- *; apply tech2; assumption. +rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. +replace (sum_f_R0 An x1) with + (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)). +apply Rplus_le_compat_l. +cut + (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <= + An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). +intro; + apply Rle_trans with + (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). +assumption. +rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l. +left; apply H. +rewrite tech3. +replace (1 - / 2) with (/ 2). +unfold Rdiv in |- *; rewrite Rinv_involutive. +pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2); + apply Rmult_le_compat_l. +left; prove_sup0. +left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)). +replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1; + [ idtac | ring ]. +rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l. +apply pow_lt; apply Rinv_0_lt_compat; prove_sup0. +discrR. +apply Rmult_eq_reg_l with 2. +rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym. +ring. +discrR. +discrR. +pattern 1 at 3 in |- *; replace 1 with (/ 1); + [ apply tech7; discrR | apply Rinv_1 ]. +replace (An (S x)) with (An (S x + 0)%nat). +apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)). +left; apply Rinv_0_lt_compat; prove_sup0. +intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n). +intro; replace (S x + S i)%nat with (S (S x + i)). +apply H6; unfold ge in |- *; apply tech8. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. +intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n). +apply Rinv_0_lt_compat; apply H. +do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; + replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)). +apply H2; assumption. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_Rabsolu; rewrite Rabs_right. +unfold Rdiv in |- *; reflexivity. +left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; + apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ]. +red in |- *; intro; assert (H8 := H n); rewrite H7 in H8; + elim (Rlt_irrefl _ H8). +replace (S x + 0)%nat with (S x); [ reflexivity | ring ]. +symmetry in |- *; apply tech2; assumption. +exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. +intro; elim X; intros. +apply existT with x; apply tech10; + [ unfold Un_growing in |- *; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; left; apply H + | apply p ]. Qed. -Lemma Alembert_C2 : (An:nat->R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intros. -Pose Vn := [i:nat]``(2*(Rabsolu (An i))+(An i))/2``. -Pose Wn := [i:nat]``(2*(Rabsolu (An i))-(An i))/2``. -Cut (n:nat)``0<(Vn n)``. -Intro; Cut (n:nat)``0<(Wn n)``. -Intro; Cut (Un_cv [n:nat](Rabsolu ``(Vn (S n))/(Vn n)``) ``0``). -Intro; Cut (Un_cv [n:nat](Rabsolu ``(Wn (S n))/(Wn n)``) ``0``). -Intro; Assert H5 := (Alembert_C1 Vn H1 H3). -Assert H6 := (Alembert_C1 Wn H2 H4). -Elim H5; Intros. -Elim H6; Intros. -Apply Specif.existT with ``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. -Pose N := (max x1 x2). -Exists N; Intros; Replace (sum_f_R0 An n) with (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)). -Unfold R_dist; Replace (Rminus (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)) (Rminus x x0)) with (Rplus (Rminus (sum_f_R0 Vn n) x) (Ropp (Rminus (sum_f_R0 Wn n) x0))); [Idtac | Ring]; Apply Rle_lt_trans with (Rplus (Rabsolu (Rminus (sum_f_R0 Vn n) x)) (Rabsolu (Ropp (Rminus (sum_f_R0 Wn n) x0)))). -Apply Rabsolu_triang. -Rewrite Rabsolu_Ropp; Apply Rlt_le_trans with ``eps/2+eps/2``. -Apply Rplus_lt. -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_sym ``/2``); Apply r_Rmult_mult with ``2``. -Rewrite Rminus_distr; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Ring. -DiscrR. -DiscrR. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Cut (n:nat)``/2*(Rabsolu (An n))<=(Wn n)<=(3*/2)*(Rabsolu (An n))``. -Intro; Cut (n:nat)``/(Wn n)<=2*/(Rabsolu (An n))``. -Intro; Cut (n:nat)``(Wn (S n))/(Wn n)<=3*(Rabsolu (An (S n))/(An n))``. -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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11; Rewrite Rabsolu_Rabsolu in H11; Rewrite Rabsolu_right. -Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``. -Apply H6. -Apply Rlt_monotony_contra with ``/3``. -Apply Rlt_Rinv; Sup0. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H11; Exact H11. -Left; Change ``0<(Wn (S n))/(Wn n)``; Unfold Rdiv; Apply Rmult_lt_pos. -Apply H2. -Apply Rlt_Rinv; Apply H2. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Intro; Unfold Rdiv; Rewrite Rabsolu_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*/(Rabsolu (An n))``. -Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply H2. -Apply H5. -Rewrite Rabsolu_Rinv. -Replace ``(Wn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Wn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony. -Left; Apply Rmult_lt_pos. -Sup0. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H. -Elim (H4 (S n)); Intros; Assumption. -Apply H. -Intro; Apply Rle_monotony_contra with (Wn n). -Apply H2. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with (Rabsolu (An n)). -Apply Rabsolu_pos_lt; Apply H. -Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Wn n)*(2*/(Rabsolu (An n))))`` with ``2*(Wn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``. -Apply Rlt_Rinv; Sup0. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Elim (H4 n); Intros; Assumption. -DiscrR. -Apply Rabsolu_no_R0; Apply H. -Red; Intro; Assert H6 := (H2 n); Rewrite H5 in H6; Elim (Rlt_antirefl ? H6). -Intro; Split. -Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony. -Left; Apply Rlt_Rinv; Sup0. -Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Unfold Rminus; Rewrite Rplus_assoc; Apply Rle_compatibility. -Apply Rle_anti_compatibility with (An n). -Rewrite Rplus_Or; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_Rabsolu. -Unfold Wn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply Rlt_Rinv; Sup0. -Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility. -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Cut (n:nat)``/2*(Rabsolu (An n))<=(Vn n)<=(3*/2)*(Rabsolu (An n))``. -Intro; Cut (n:nat)``/(Vn n)<=2*/(Rabsolu (An n))``. -Intro; Cut (n:nat)``(Vn (S n))/(Vn n)<=3*(Rabsolu (An (S n))/(An n))``. -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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H10; Unfold Rminus in H10; Rewrite Ropp_O in H10; Rewrite Rplus_Or in H10; Rewrite Rabsolu_Rabsolu in H10; Rewrite Rabsolu_right. -Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``. -Apply H5. -Apply Rlt_monotony_contra with ``/3``. -Apply Rlt_Rinv; Sup0. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H10; Exact H10. -Left; Change ``0<(Vn (S n))/(Vn n)``; Unfold Rdiv; Apply Rmult_lt_pos. -Apply H1. -Apply Rlt_Rinv; Apply H1. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Intro; Unfold Rdiv; Rewrite Rabsolu_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*/(Rabsolu (An n))``. -Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply H1. -Apply H4. -Rewrite Rabsolu_Rinv. -Replace ``(Vn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Vn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony. -Left; Apply Rmult_lt_pos. -Sup0. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H. -Elim (H3 (S n)); Intros; Assumption. -Apply H. -Intro; Apply Rle_monotony_contra with (Vn n). -Apply H1. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with (Rabsolu (An n)). -Apply Rabsolu_pos_lt; Apply H. -Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Vn n)*(2*/(Rabsolu (An n))))`` with ``2*(Vn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``. -Apply Rlt_Rinv; Sup0. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Elim (H3 n); Intros; Assumption. -DiscrR. -Apply Rabsolu_no_R0; Apply H. -Red; Intro; Assert H5 := (H1 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5). -Intro; Split. -Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony. -Left; Apply Rlt_Rinv; Sup0. -Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Rewrite Rplus_assoc; Apply Rle_compatibility. -Apply Rle_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Rewrite <- (Rplus_sym (An n)); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Unfold Vn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply Rlt_Rinv; Sup0. -Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility; Apply Rle_Rabsolu. -Intro; Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony. -Apply Rlt_Rinv; Sup0. -Apply Rlt_anti_compatibility with (An n); Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)). -Apply Rle_Rabsolu. -Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H. -Intro; Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony. -Apply Rlt_Rinv; Sup0. -Apply Rlt_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym ``-(An n)``); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H. +Lemma Alembert_C2 : + forall An:nat -> R, + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros. +pose (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2). +pose (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2). +cut (forall n:nat, 0 < Vn n). +intro; cut (forall n:nat, 0 < Wn n). +intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0). +intro; cut (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0). +intro; assert (H5 := Alembert_C1 Vn H1 H3). +assert (H6 := Alembert_C1 Wn H2 H4). +elim H5; intros. +elim H6; intros. +apply existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p; + unfold Un_cv in p0; intros; cut (0 < eps / 2). +intro; elim (p (eps / 2) H8); clear p; intros. +elim (p0 (eps / 2) H8); clear p0; intros. +pose (N := max x1 x2). +exists N; intros; + replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n). +unfold R_dist in |- *; + replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with + (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ]; + apply Rle_lt_trans with + (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))). +apply Rabs_triang. +rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2). +apply Rplus_lt_compat. +unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_l | assumption ]. +unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_r | assumption ]. +right; symmetry in |- *; apply double_var. +symmetry in |- *; apply tech11; intro; unfold Vn, Wn in |- *; + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); + apply Rmult_eq_reg_l with 2. +rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +ring. +discrR. +discrR. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)). +intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)). +intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)). +intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3). +intro; elim (H0 (eps / 3) H8); intros. +exists x; intros. +assert (H11 := H9 n H10). +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11; + unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11; + rewrite Rabs_Rabsolu in H11; rewrite Rabs_right. +apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). +apply H6. +apply Rmult_lt_reg_l with (/ 3). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11; + exact H11. +left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. +apply H2. +apply Rinv_0_lt_compat; apply H2. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + replace 3 with (2 * (3 * / 2)); + [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; + apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply H2. +apply H5. +rewrite Rabs_Rinv. +replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n)); + [ idtac | ring ]; + replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + [ idtac | ring ]; apply Rmult_le_compat_l. +left; apply Rmult_lt_0_compat. +prove_sup0. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. +elim (H4 (S n)); intros; assumption. +apply H. +intro; apply Rmult_le_reg_l with (Wn n). +apply H2. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (Rabs (An n)). +apply Rabs_pos_lt; apply H. +rewrite Rmult_1_r; + replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with + (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; elim (H4 n); intros; assumption. +discrR. +apply Rabs_no_R0; apply H. +red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6; + elim (Rlt_irrefl _ H6). +intro; split. +unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; + unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l. +apply Rplus_le_reg_l with (An n). +rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs. +unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); + repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +unfold Rminus in |- *; rewrite double; + replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); + [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. +rewrite <- Rabs_Ropp; apply RRle_abs. +cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)). +intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)). +intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)). +intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3). +intro; elim (H0 (eps / 3) H7); intros. +exists x; intros. +assert (H10 := H8 n H9). +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10; + unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10; + rewrite Rabs_Rabsolu in H10; rewrite Rabs_right. +apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). +apply H5. +apply Rmult_lt_reg_l with (/ 3). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10; + exact H10. +left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. +apply H1. +apply Rinv_0_lt_compat; apply H1. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + replace 3 with (2 * (3 * / 2)); + [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; + apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply H1. +apply H4. +rewrite Rabs_Rinv. +replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n)); + [ idtac | ring ]; + replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + [ idtac | ring ]; apply Rmult_le_compat_l. +left; apply Rmult_lt_0_compat. +prove_sup0. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. +elim (H3 (S n)); intros; assumption. +apply H. +intro; apply Rmult_le_reg_l with (Vn n). +apply H1. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (Rabs (An n)). +apply Rabs_pos_lt; apply H. +rewrite Rmult_1_r; + replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with + (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; elim (H3 n); intros; assumption. +discrR. +apply Rabs_no_R0; apply H. +red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5; + elim (Rlt_irrefl _ H5). +intro; split. +unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; + rewrite Rplus_assoc; apply Rplus_le_compat_l. +apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r; + rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; + apply RRle_abs. +unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); + repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +unfold Rminus in |- *; rewrite double; + replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); + [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l; + apply RRle_abs. +intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); + rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *; + rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply Rle_lt_trans with (Rabs (An n)). +apply RRle_abs. +rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. +intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); + rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *; + rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; + apply Rle_lt_trans with (Rabs (An n)). +rewrite <- Rabs_Ropp; apply RRle_abs. +rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. Qed. -Lemma AlembertC3_step1 : (An:nat->R;x:R) ``x<>0`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)). -Intros; Pose Bn := [i:nat]``(An i)*(pow x i)``. -Cut (n:nat)``(Bn n)<>0``. -Intro; Cut (Un_cv [n:nat](Rabsolu ``(Bn (S n))/(Bn n)``) ``0``). -Intro; Assert H4 := (Alembert_C2 Bn H2 H3). -Elim H4; Intros. -Apply Specif.existT with x0; Unfold Bn in p; Apply tech12; Assumption. -Unfold Un_cv; Intros; Unfold Un_cv in H1; Cut ``0<eps/(Rabsolu x)``. -Intro; Elim (H1 ``eps/(Rabsolu x)`` H4); Intros. -Exists x0; Intros; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Bn; Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``. -Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu x)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Rewrite <- (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H5; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``(R_dist (Rabsolu ((An (S n))*/(An n))) 0)``. -Apply H5; Assumption. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Rdiv; Reflexivity. -Apply Rabsolu_no_R0; Assumption. -Replace (S n) with (plus n (1)); [Idtac | Ring]; Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult. -Replace ``(An (plus n (S O)))*((pow x n)*(pow x (S O)))*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*(pow x (S O))*/(An n)*((pow x n)*/(pow x n))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym. -Simpl; Ring. -Apply pow_nonzero; Assumption. -Apply H0. -Apply pow_nonzero; Assumption. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption]. -Intro; Unfold Bn; Apply prod_neq_R0; [Apply H0 | Apply pow_nonzero; Assumption]. +Lemma AlembertC3_step1 : + forall (An:nat -> R) (x:R), + x <> 0 -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Pser An x l). +intros; pose (Bn := fun i:nat => An i * x ^ i). +cut (forall n:nat, Bn n <> 0). +intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0). +intro; assert (H4 := Alembert_C2 Bn H2 H3). +elim H4; intros. +apply existT with x0; unfold Bn in p; apply tech12; assumption. +unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). +intro; elim (H1 (eps / Rabs x) H4); intros. +exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + unfold Bn in |- *; + replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). +rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5; + replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0). +apply H5; assumption. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; + reflexivity. +apply Rabs_no_R0; assumption. +replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add; + unfold Rdiv in |- *; rewrite Rinv_mult_distr. +replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); + [ idtac | ring ]; rewrite <- Rinv_r_sym. +simpl in |- *; ring. +apply pow_nonzero; assumption. +apply H0. +apply pow_nonzero; assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. +intro; unfold Bn in |- *; apply prod_neq_R0; + [ apply H0 | apply pow_nonzero; assumption ]. Qed. -Lemma AlembertC3_step2 : (An:nat->R;x:R) ``x==0`` -> (SigT R [l:R](Pser An x l)). -Intros; Apply Specif.existT with (An O). -Unfold Pser; Unfold infinit_sum; Intros; Exists O; Intros; Replace (sum_f_R0 [n0:nat]``(An n0)*(pow x n0)`` n) with (An O). -Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Induction n. -Simpl; Ring. -Rewrite tech5; Rewrite Hrecn; [Rewrite H; Simpl; Ring | Unfold ge; Apply le_O_n]. +Lemma AlembertC3_step2 : + forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l). +intros; apply existT with (An 0%nat). +unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros; + replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat). +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; assumption. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5; rewrite Hrecn; + [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ]. Qed. (* An useful criterion of convergence for power series *) -Theorem Alembert_C3 : (An:nat->R;x:R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)). -Intros; Case (total_order_T x R0); Intro. -Elim s; Intro. -Cut ``x<>0``. -Intro; Apply AlembertC3_step1; Assumption. -Red; Intro; Rewrite H1 in a; Elim (Rlt_antirefl ? a). -Apply AlembertC3_step2; Assumption. -Cut ``x<>0``. -Intro; Apply AlembertC3_step1; Assumption. -Red; Intro; Rewrite H1 in r; Elim (Rlt_antirefl ? r). +Theorem Alembert_C3 : + forall (An:nat -> R) (x:R), + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Pser An x l). +intros; case (total_order_T x 0); intro. +elim s; intro. +cut (x <> 0). +intro; apply AlembertC3_step1; assumption. +red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a). +apply AlembertC3_step2; assumption. +cut (x <> 0). +intro; apply AlembertC3_step1; assumption. +red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r). Qed. -Lemma Alembert_C4 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intros An k Hyp H H0. -Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intro; Apply X. -Apply complet. -Assert H1 := (tech13 ? ? Hyp H0). -Elim H1; Intros. -Elim H2; Intros. -Elim H4; Intros. -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). -Elim H8; Intros. -Elim a; Intro. -Replace (sum_f_R0 An x0) with (Rplus (sum_f_R0 An x2) (sum_f_R0 [i:nat](An (plus (S x2) i)) (minus x0 (S x2)))). -Pattern 1 (sum_f_R0 An x2); Rewrite <- Rplus_Or. -Rewrite Rplus_assoc; Apply Rle_compatibility. -Left; Apply gt0_plus_gt0_is_gt0. -Apply tech1. -Intros; Apply H. -Apply Rmult_lt_pos. -Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring]. -Apply H. -Symmetry; Apply tech2; Assumption. -Rewrite b; Pattern 1 (sum_f_R0 An x0); Rewrite <- Rplus_Or; Apply Rle_compatibility. -Left; Apply Rmult_lt_pos. -Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring]. -Apply H. -Replace (sum_f_R0 An x2) with (Rplus (sum_f_R0 An x0) (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0)))). -Apply Rle_compatibility. -Cut (Rle (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0))) (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0))))). -Intro; Apply Rle_trans with (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0)))). -Assumption. -Rewrite <- (Rmult_sym (An (S x0))); Apply Rle_monotony. -Left; Apply H. -Rewrite tech3. -Unfold Rdiv; Apply Rle_monotony_contra with ``1-x``. -Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or. -Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring]. -Do 2 Rewrite (Rmult_sym ``1-x``). -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Apply Rle_anti_compatibility with ``(pow x (S (minus x2 (S x0))))``. -Replace ``(pow x (S (minus x2 (S x0))))+(1-(pow x (S (minus x2 (S x0)))))`` with R1; [Idtac | Ring]. -Rewrite <- (Rplus_sym R1); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility. -Left; Apply pow_lt. -Apply Rle_lt_trans with k. -Elim Hyp; Intros; Assumption. -Elim H3; Intros; Assumption. -Apply Rminus_eq_contra. -Red; Intro. -Elim H3; Intros. -Rewrite H10 in H12; Elim (Rlt_antirefl ? H12). -Red; Intro. -Elim H3; Intros. -Rewrite H10 in H12; Elim (Rlt_antirefl ? H12). -Replace (An (S x0)) with (An (plus (S x0) O)). -Apply (tech6 [i:nat](An (plus (S x0) i)) x). -Left; Apply Rle_lt_trans with k. -Elim Hyp; Intros; Assumption. -Elim H3; Intros; Assumption. -Intro. -Cut (n:nat)(ge n x0)->``(An (S n))<x*(An n)``. -Intro. -Replace (plus (S x0) (S i)) with (S (plus (S x0) i)). -Apply H9. -Unfold ge. -Apply tech8. - Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring. -Intros. -Apply Rlt_monotony_contra with ``/(An n)``. -Apply Rlt_Rinv; Apply H. -Do 2 Rewrite (Rmult_sym ``/(An n)``). -Rewrite Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r. -Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((An (S n))/(An n)))``. -Apply H5; Assumption. -Rewrite Rabsolu_right. -Unfold Rdiv; Reflexivity. -Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos. -Apply H. -Apply Rlt_Rinv; Apply H. -Red; Intro. -Assert H11 := (H n). -Rewrite H10 in H11; Elim (Rlt_antirefl ? H11). -Replace (plus (S x0) O) with (S x0); [Reflexivity | Ring]. -Symmetry; Apply tech2; Assumption. -Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity. -Intro; Elim X; Intros. -Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p]. +Lemma Alembert_C4 : + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + (forall n:nat, 0 < An n) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros An k Hyp H H0. +cut + (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). +intro; apply X. +apply completeness. +assert (H1 := tech13 _ _ Hyp H0). +elim H1; intros. +elim H2; intros. +elim H4; intros. +unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)). +unfold is_upper_bound in |- *; intros; unfold EUn in H6. +elim H6; intros. +rewrite H7. +assert (H8 := lt_eq_lt_dec x2 x0). +elim H8; intros. +elim a; intro. +replace (sum_f_R0 An x0) with + (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)). +pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r. +rewrite Rplus_assoc; apply Rplus_le_compat_l. +left; apply Rplus_lt_0_compat. +apply tech1. +intros; apply H. +apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. +apply H. +symmetry in |- *; apply tech2; assumption. +rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +left; apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. +apply H. +replace (sum_f_R0 An x2) with + (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)). +apply Rplus_le_compat_l. +cut + (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <= + An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). +intro; + apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). +assumption. +rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l. +left; apply H. +rewrite tech3. +unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x). +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. +replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. +do 2 rewrite (Rmult_comm (1 - x)). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)). +replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1; + [ idtac | ring ]. +rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +left; apply pow_lt. +apply Rle_lt_trans with k. +elim Hyp; intros; assumption. +elim H3; intros; assumption. +apply Rminus_eq_contra. +red in |- *; intro. +elim H3; intros. +rewrite H10 in H12; elim (Rlt_irrefl _ H12). +red in |- *; intro. +elim H3; intros. +rewrite H10 in H12; elim (Rlt_irrefl _ H12). +replace (An (S x0)) with (An (S x0 + 0)%nat). +apply (tech6 (fun i:nat => An (S x0 + i)%nat) x). +left; apply Rle_lt_trans with k. +elim Hyp; intros; assumption. +elim H3; intros; assumption. +intro. +cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n). +intro. +replace (S x0 + S i)%nat with (S (S x0 + i)). +apply H9. +unfold ge in |- *. +apply tech8. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; + ring. +intros. +apply Rmult_lt_reg_l with (/ An n). +apply Rinv_0_lt_compat; apply H. +do 2 rewrite (Rmult_comm (/ An n)). +rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +replace (An (S n) * / An n) with (Rabs (An (S n) / An n)). +apply H5; assumption. +rewrite Rabs_right. +unfold Rdiv in |- *; reflexivity. +left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; + apply Rmult_lt_0_compat. +apply H. +apply Rinv_0_lt_compat; apply H. +red in |- *; intro. +assert (H11 := H n). +rewrite H10 in H11; elim (Rlt_irrefl _ H11). +replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ]. +symmetry in |- *; apply tech2; assumption. +exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. +intro; elim X; intros. +apply existT with x; apply tech10; + [ unfold Un_growing in |- *; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; left; apply H + | apply p ]. Qed. -Lemma Alembert_C5 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intros. -Cut (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intro Hyp0; Apply Hyp0. -Apply cv_cauchy_2. -Apply cauchy_abs. -Apply cv_cauchy_1. -Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)). -Intro Hyp; Apply Hyp. -Apply (Alembert_C4 [i:nat](Rabsolu (An i)) k). -Assumption. -Intro; Apply Rabsolu_pos_lt; Apply H0. -Unfold Un_cv. -Unfold Un_cv in H1. -Unfold Rdiv. -Intros. -Elim (H1 eps H2); Intros. -Exists x; Intros. -Rewrite <- Rabsolu_Rinv. -Rewrite <- Rabsolu_mult. -Rewrite Rabsolu_Rabsolu. -Unfold Rdiv in H3; Apply H3; Assumption. -Apply H0. -Intro. -Elim X; Intros. -Apply existTT with x. -Assumption. -Intro. -Elim X; Intros. -Apply Specif.existT with x. -Assumption. +Lemma Alembert_C5 : + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros. +cut + (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). +intro Hyp0; apply Hyp0. +apply cv_cauchy_2. +apply cauchy_abs. +apply cv_cauchy_1. +cut + (sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) -> + sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)). +intro Hyp; apply Hyp. +apply (Alembert_C4 (fun i:nat => Rabs (An i)) k). +assumption. +intro; apply Rabs_pos_lt; apply H0. +unfold Un_cv in |- *. +unfold Un_cv in H1. +unfold Rdiv in |- *. +intros. +elim (H1 eps H2); intros. +exists x; intros. +rewrite <- Rabs_Rinv. +rewrite <- Rabs_mult. +rewrite Rabs_Rabsolu. +unfold Rdiv in H3; apply H3; assumption. +apply H0. +intro. +elim X; intros. +apply existT with x. +assumption. +intro. +elim X; intros. +apply existT with x. +assumption. Qed. (* Convergence of power series in D(O,1/k) *) (* k=0 is described in Alembert_C3 *) -Lemma Alembert_C6 : (An:nat->R;x,k:R) ``0<k`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> ``(Rabsolu x)</k`` -> (SigT R [l:R](Pser An x l)). -Intros. -Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l)). -Intro. -Elim X; Intros. -Apply Specif.existT with x0. -Apply tech12; Assumption. -Case (total_order_T x R0); Intro. -Elim s; Intro. -EApply Alembert_C5 with ``k*(Rabsolu x)``. -Split. -Unfold Rdiv; Apply Rmult_le_pos. -Left; Assumption. -Left; Apply Rabsolu_pos_lt. -Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a). -Apply Rlt_monotony_contra with ``/k``. -Apply Rlt_Rinv; Assumption. -Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite Rmult_1r; Assumption. -Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H). -Intro; Apply prod_neq_R0. -Apply H0. -Apply pow_nonzero. -Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a). -Unfold Un_cv; Unfold Un_cv in H1. -Intros. -Cut ``0<eps/(Rabsolu x)``. -Intro. -Elim (H1 ``eps/(Rabsolu x)`` H4); Intros. -Exists x0. -Intros. -Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``. -Unfold R_dist. -Rewrite Rabsolu_mult. -Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring]. -Rewrite Rabsolu_mult. -Rewrite Rabsolu_Rabsolu. -Apply Rlt_monotony_contra with ``/(Rabsolu x)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt. -Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a). -Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite <- (Rmult_sym eps). -Unfold R_dist in H5. -Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption. -Apply Rabsolu_no_R0. -Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a). -Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring]. -Rewrite pow_add. -Simpl. -Rewrite Rmult_1r. -Rewrite Rinv_Rmult. -Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Reflexivity. -Apply pow_nonzero. -Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a). -Apply H0. -Apply pow_nonzero. -Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a). -Unfold Rdiv; Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt. -Red; Intro H7; Rewrite H7 in a; Elim (Rlt_antirefl ? a). -Apply Specif.existT with (An O). -Unfold Un_cv. -Intros. -Exists O. -Intros. -Unfold R_dist. -Replace (sum_f_R0 [i:nat]``(An i)*(pow x i)`` n) with (An O). -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Induction n. -Simpl; Ring. -Rewrite tech5. -Rewrite <- Hrecn. -Rewrite b; Simpl; Ring. -Unfold ge; Apply le_O_n. -EApply Alembert_C5 with ``k*(Rabsolu x)``. -Split. -Unfold Rdiv; Apply Rmult_le_pos. -Left; Assumption. -Left; Apply Rabsolu_pos_lt. -Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r). -Apply Rlt_monotony_contra with ``/k``. -Apply Rlt_Rinv; Assumption. -Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite Rmult_1r; Assumption. -Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H). -Intro; Apply prod_neq_R0. -Apply H0. -Apply pow_nonzero. -Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r). -Unfold Un_cv; Unfold Un_cv in H1. -Intros. -Cut ``0<eps/(Rabsolu x)``. -Intro. -Elim (H1 ``eps/(Rabsolu x)`` H4); Intros. -Exists x0. -Intros. -Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``. -Unfold R_dist. -Rewrite Rabsolu_mult. -Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring]. -Rewrite Rabsolu_mult. -Rewrite Rabsolu_Rabsolu. -Apply Rlt_monotony_contra with ``/(Rabsolu x)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt. -Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r). -Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite <- (Rmult_sym eps). -Unfold R_dist in H5. -Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption. -Apply Rabsolu_no_R0. -Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r). -Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring]. -Rewrite pow_add. -Simpl. -Rewrite Rmult_1r. -Rewrite Rinv_Rmult. -Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Reflexivity. -Apply pow_nonzero. -Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r). -Apply H0. -Apply pow_nonzero. -Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r). -Unfold Rdiv; Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt. -Red; Intro H7; Rewrite H7 in r; Elim (Rlt_antirefl ? r). -Qed. +Lemma Alembert_C6 : + forall (An:nat -> R) (x k:R), + 0 < k -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + Rabs x < / k -> sigT (fun l:R => Pser An x l). +intros. +cut + (sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)). +intro. +elim X; intros. +apply existT with x0. +apply tech12; assumption. +case (total_order_T x 0); intro. +elim s; intro. +eapply Alembert_C5 with (k * Rabs x). +split. +unfold Rdiv in |- *; apply Rmult_le_pos. +left; assumption. +left; apply Rabs_pos_lt. +red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). +apply Rmult_lt_reg_l with (/ k). +apply Rinv_0_lt_compat; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rmult_1_r; assumption. +red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). +intro; apply prod_neq_R0. +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). +unfold Un_cv in |- *; unfold Un_cv in H1. +intros. +cut (0 < eps / Rabs x). +intro. +elim (H1 (eps / Rabs x) H4); intros. +exists x0. +intros. +replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). +unfold R_dist in |- *. +rewrite Rabs_mult. +replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with + (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. +rewrite Rabs_mult. +rewrite Rabs_Rabsolu. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite <- (Rmult_comm eps). +unfold R_dist in H5. +unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. +apply Rabs_no_R0. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add. +simpl in |- *. +rewrite Rmult_1_r. +rewrite Rinv_mult_distr. +replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a). +apply existT with (An 0%nat). +unfold Un_cv in |- *. +intros. +exists 0%nat. +intros. +unfold R_dist in |- *. +replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat). +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5. +rewrite <- Hrecn. +rewrite b; simpl in |- *; ring. +unfold ge in |- *; apply le_O_n. +eapply Alembert_C5 with (k * Rabs x). +split. +unfold Rdiv in |- *; apply Rmult_le_pos. +left; assumption. +left; apply Rabs_pos_lt. +red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). +apply Rmult_lt_reg_l with (/ k). +apply Rinv_0_lt_compat; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rmult_1_r; assumption. +red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). +intro; apply prod_neq_R0. +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). +unfold Un_cv in |- *; unfold Un_cv in H1. +intros. +cut (0 < eps / Rabs x). +intro. +elim (H1 (eps / Rabs x) H4); intros. +exists x0. +intros. +replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). +unfold R_dist in |- *. +rewrite Rabs_mult. +replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with + (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. +rewrite Rabs_mult. +rewrite Rabs_Rabsolu. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite <- (Rmult_comm eps). +unfold R_dist in H5. +unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. +apply Rabs_no_R0. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add. +simpl in |- *. +rewrite Rmult_1_r. +rewrite Rinv_mult_distr. +replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +apply H0. +apply pow_nonzero. +red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r). +Qed.
\ No newline at end of file diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v index c35f18a73..e9be3fc02 100644 --- a/theories/Reals/AltSeries.v +++ b/theories/Reals/AltSeries.v @@ -8,156 +8,204 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require SeqProp. -Require PartSum. -Require Max. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import SeqProp. +Require Import PartSum. +Require Import Max. Open Local Scope R_scope. (**********) -Definition tg_alt [Un:nat->R] : nat->R := [i:nat]``(pow (-1) i)*(Un i)``. -Definition positivity_seq [Un:nat->R] : Prop := (n:nat)``0<=(Un n)``. +Definition tg_alt (Un:nat -> R) (i:nat) : R := (-1) ^ i * Un i. +Definition positivity_seq (Un:nat -> R) : Prop := forall n:nat, 0 <= Un n. -Lemma CV_ALT_step0 : (Un:nat->R) (Un_decreasing Un) -> (Un_growing [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))). -Intros; Unfold Un_growing; Intro. -Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))). -Intro; Rewrite H0. -Do 4 Rewrite tech5; Repeat Rewrite Rplus_assoc; Apply Rle_compatibility. -Pattern 1 (tg_alt Un (S (mult (S (S O)) n))); Rewrite <- Rplus_Or. -Apply Rle_compatibility. -Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l. -Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S n))))``. -Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S n))))+((Un (mult (S (S O)) (S n)))+ -1*(Un (S (mult (S (S O)) (S n)))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring]. -Apply H. -Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring]. -Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring. +Lemma CV_ALT_step0 : + forall Un:nat -> R, + Un_decreasing Un -> + Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). +intros; unfold Un_growing in |- *; intro. +cut ((2 * S n)%nat = S (S (2 * n))). +intro; rewrite H0. +do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l. +pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + rewrite Rmult_1_l. +apply Rplus_le_reg_l with (Un (S (2 * S n))). +rewrite Rplus_0_r; + replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with + (Un (2 * S n)%nat); [ idtac | ring ]. +apply H. +cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. +rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. Qed. -Lemma CV_ALT_step1 : (Un:nat->R) (Un_decreasing Un) -> (Un_decreasing [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))). -Intros; Unfold Un_decreasing; Intro. -Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))). -Intro; Rewrite H0; Do 2 Rewrite tech5; Repeat Rewrite Rplus_assoc. -Pattern 2 (sum_f_R0 (tg_alt Un) (mult (S (S O)) n)); Rewrite <- Rplus_Or. -Apply Rle_compatibility. -Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l. -Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) n)))``. -Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) n)))+( -1*(Un (S (mult (S (S O)) n)))+(Un (mult (S (S O)) (S n))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring]. -Rewrite H0; Apply H. -Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring]. -Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring. +Lemma CV_ALT_step1 : + forall Un:nat -> R, + Un_decreasing Un -> + Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)). +intros; unfold Un_decreasing in |- *; intro. +cut ((2 * S n)%nat = S (S (2 * n))). +intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc. +pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + rewrite Rmult_1_l. +apply Rplus_le_reg_l with (Un (S (2 * n))). +rewrite Rplus_0_r; + replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with + (Un (2 * S n)%nat); [ idtac | ring ]. +rewrite H0; apply H. +cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. +rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. Qed. (**********) -Lemma CV_ALT_step2 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (2) N))) R0). -Intros; Induction N. -Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r. -Replace ``-1* -1*(Un (S (S O)))`` with (Un (S (S O))); [Idtac | Ring]. -Apply Rle_anti_compatibility with ``(Un (S O))``; Rewrite Rplus_Or. -Replace ``(Un (S O))+ (-1*(Un (S O))+(Un (S (S O))))`` with (Un (S (S O))); [Apply H | Ring]. -Cut (S (mult (2) (S N))) = (S (S (S (mult (2) N)))). -Intro; Rewrite H1; Do 2 Rewrite tech5. -Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))). -Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))); Rewrite <- Rplus_Or. -Rewrite Rplus_assoc; Apply Rle_compatibility. -Unfold tg_alt; Rewrite <- H1. -Rewrite pow_1_odd. -Cut (S (S (mult (2) (S N)))) = (mult (2) (S (S N))). -Intro; Rewrite H2; Rewrite pow_1_even; Rewrite Rmult_1l; Rewrite <- H2. -Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S N))))``. -Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S N))))+( -1*(Un (S (mult (S (S O)) (S N))))+(Un (S (S (mult (S (S O)) (S N))))))`` with ``(Un (S (S (mult (S (S O)) (S N)))))``; [Idtac | Ring]. -Apply H. -Apply INR_eq; Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply HrecN. -Apply INR_eq; Repeat Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. +Lemma CV_ALT_step2 : + forall (Un:nat -> R) (N:nat), + Un_decreasing Un -> + positivity_seq Un -> + sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. +intros; induction N as [| N HrecN]. +simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. +replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]. +apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r. +replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat); + [ apply H | ring ]. +cut (S (2 * S N) = S (S (S (2 * N)))). +intro; rewrite H1; do 2 rewrite tech5. +apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))). +pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *; + rewrite <- Rplus_0_r. +rewrite Rplus_assoc; apply Rplus_le_compat_l. +unfold tg_alt in |- *; rewrite <- H1. +rewrite pow_1_odd. +cut (S (S (2 * S N)) = (2 * S (S N))%nat). +intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2. +apply Rplus_le_reg_l with (Un (S (2 * S N))). +rewrite Rplus_0_r; + replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N))))) + with (Un (S (S (2 * S N)))); [ idtac | ring ]. +apply H. +apply INR_eq; rewrite mult_INR; repeat rewrite S_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +apply HrecN. +apply INR_eq; repeat rewrite S_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; ring. Qed. (* A more general inequality *) -Lemma CV_ALT_step3 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) N) R0). -Intros; Induction N. -Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r. -Apply Rle_anti_compatibility with (Un (S O)). -Rewrite Rplus_Or; Replace ``(Un (S O))+ -1*(Un (S O))`` with R0; [Apply H0 | Ring]. -Assert H1 := (even_odd_cor N). -Elim H1; Intros. -Elim H2; Intro. -Rewrite H3; Apply CV_ALT_step2; Assumption. -Rewrite H3; Rewrite tech5. -Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))). -Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))); Rewrite <- Rplus_Or. -Apply Rle_compatibility. -Unfold tg_alt; Simpl. -Replace (plus x (plus x O)) with (mult (2) x); [Idtac | Ring]. -Rewrite pow_1_even. -Replace `` -1*( -1*( -1*1))*(Un (S (S (S (mult (S (S O)) x)))))`` with ``-(Un (S (S (S (mult (S (S O)) x)))))``; [Idtac | Ring]. -Apply Rle_anti_compatibility with (Un (S (S (S (mult (S (S O)) x))))). -Rewrite Rplus_Or; Rewrite Rplus_Ropp_r. -Apply H0. -Apply CV_ALT_step2; Assumption. +Lemma CV_ALT_step3 : + forall (Un:nat -> R) (N:nat), + Un_decreasing Un -> + positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. +intros; induction N as [| N HrecN]. +simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. +apply Rplus_le_reg_l with (Un 1%nat). +rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0; + [ apply H0 | ring ]. +assert (H1 := even_odd_cor N). +elim H1; intros. +elim H2; intro. +rewrite H3; apply CV_ALT_step2; assumption. +rewrite H3; rewrite tech5. +apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))). +pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *; + rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +unfold tg_alt in |- *; simpl in |- *. +replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ]. +rewrite pow_1_even. +replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with + (- Un (S (S (S (2 * x))))); [ idtac | ring ]. +apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))). +rewrite Rplus_0_r; rewrite Rplus_opp_r. +apply H0. +apply CV_ALT_step2; assumption. Qed. (**********) -Lemma CV_ALT_step4 : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (has_ub [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))). -Intros; Unfold has_ub; Unfold bound. -Exists ``(Un O)``. -Unfold is_upper_bound; Intros; Elim H1; Intros. -Rewrite H2; Rewrite decomp_sum. -Replace (tg_alt Un O) with ``(Un O)``. -Pattern 2 ``(Un O)``; Rewrite <- Rplus_Or. -Apply Rle_compatibility. -Apply CV_ALT_step3; Assumption. -Unfold tg_alt; Simpl; Ring. -Apply lt_O_Sn. +Lemma CV_ALT_step4 : + forall Un:nat -> R, + Un_decreasing Un -> + positivity_seq Un -> + has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). +intros; unfold has_ub in |- *; unfold bound in |- *. +exists (Un 0%nat). +unfold is_upper_bound in |- *; intros; elim H1; intros. +rewrite H2; rewrite decomp_sum. +replace (tg_alt Un 0) with (Un 0%nat). +pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r. +apply Rplus_le_compat_l. +apply CV_ALT_step3; assumption. +unfold tg_alt in |- *; simpl in |- *; ring. +apply lt_O_Sn. Qed. (* This lemma gives an interesting result about alternated series *) -Lemma CV_ALT : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)). -Intros. -Assert H2 := (CV_ALT_step0 ? H). -Assert H3 := (CV_ALT_step4 ? H H0). -Assert X := (growing_cv ? H2 H3). -Elim X; Intros. -Apply existTT with x. -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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H1 ``eps/2`` H5); Intros N2 H6. -Elim (p ``eps/2`` H5); Intros N1 H7. -Pose N := (max (S (mult (2) N1)) N2). -Exists N; Intros. -Assert H9 := (even_odd_cor n). -Elim H9; Intros P H10. -Cut (le N1 P). -Intro; Elim H10; Intro. -Replace ``(sum_f_R0 (tg_alt Un) n)-x`` with ``((sum_f_R0 (tg_alt Un) (S n))-x)+(-(tg_alt Un (S n)))``. -Apply Rle_lt_trans with ``(Rabsolu ((sum_f_R0 (tg_alt Un) (S n))-x))+(Rabsolu (-(tg_alt Un (S n))))``. -Apply Rabsolu_triang. -Rewrite (double_var eps); Apply Rplus_lt. -Rewrite H12; Apply H7; Assumption. -Rewrite Rabsolu_Ropp; Unfold tg_alt; Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l; Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite <- (Rplus_Or (Un (S n))); Apply H6. -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; Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR]. -Rewrite RIneq.double. -Pattern 1 eps; Rewrite <- (Rplus_Or eps); Apply Rlt_compatibility; Assumption. -Elim H10; Intro; Apply le_double. -Rewrite <- H11; Apply le_trans with N. -Unfold N; Apply le_trans with (S (mult (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; Apply lt_le_trans with (S (mult (2) N1)). -Apply lt_n_Sn. -Apply le_max_l. -Assumption. +Lemma CV_ALT : + forall Un:nat -> R, + Un_decreasing Un -> + positivity_seq Un -> + Un_cv Un 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). +intros. +assert (H2 := CV_ALT_step0 _ H). +assert (H3 := CV_ALT_step4 _ H H0). +assert (X := growing_cv _ H2 H3). +elim X; intros. +apply existT with x. +unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p. +intros; cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H1 (eps / 2) H5); intros N2 H6. +elim (p (eps / 2) H5); intros N1 H7. +pose (N := max (S (2 * N1)) N2). +exists N; intros. +assert (H9 := even_odd_cor n). +elim H9; intros P H10. +cut (N1 <= P)%nat. +intro; elim H10; intro. +replace (sum_f_R0 (tg_alt Un) n - x) with + (sum_f_R0 (tg_alt Un) (S n) - x + - tg_alt Un (S n)). +apply Rle_lt_trans with + (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +rewrite H12; apply H7; assumption. +rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult; + rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6; + rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); + apply H6. +unfold ge in |- *; apply le_trans with n. +apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ]. +apply le_n_Sn. +rewrite tech5; ring. +rewrite H12; apply Rlt_trans with (eps / 2). +apply H7; assumption. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ rewrite Rmult_1_r | discrR ]. +rewrite double. +pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l; + assumption. +elim H10; intro; apply le_double. +rewrite <- H11; apply le_trans with N. +unfold N in |- *; apply le_trans with (S (2 * N1)); + [ apply le_n_Sn | apply le_max_l ]. +assumption. +apply lt_n_Sm_le. +rewrite <- H11. +apply lt_le_trans with N. +unfold N in |- *; apply lt_le_trans with (S (2 * N1)). +apply lt_n_Sn. +apply le_max_l. +assumption. Qed. (************************************************) @@ -165,198 +213,236 @@ Qed. (* *) (* Applications: PI, cos, sin *) (************************************************) -Theorem alternated_series : (Un:nat->R) (Un_decreasing Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)). -Intros; Apply CV_ALT. -Assumption. -Unfold positivity_seq; Apply decreasing_ineq; Assumption. -Assumption. +Theorem alternated_series : + forall Un:nat -> R, + Un_decreasing Un -> + Un_cv Un 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). +intros; apply CV_ALT. +assumption. +unfold positivity_seq in |- *; apply decreasing_ineq; assumption. +assumption. Qed. -Theorem alternated_series_ineq : (Un:nat->R;l:R;N:nat) (Un_decreasing Un) -> (Un_cv Un R0) -> (Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l) -> ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) N)))<=l<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) N))``. -Intros. -Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N)) l). -Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N))) l). -Intros; Split. -Apply (growing_ineq [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))). -Apply CV_ALT_step0; Assumption. -Assumption. -Apply (decreasing_ineq [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))). -Apply CV_ALT_step1; Assumption. -Assumption. -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; Apply le_trans with (mult (2) n). -Apply le_trans with n. -Assumption. -Assert H5 := (mult_O_le n (2)). -Elim H5; Intro. -Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate]. -Assumption. -Apply le_n_Sn. -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; Apply le_trans with n. -Assumption. -Assert H5 := (mult_O_le n (2)). -Elim H5; Intro. -Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate]. -Assumption. +Theorem alternated_series_ineq : + forall (Un:nat -> R) (l:R) (N:nat), + Un_decreasing Un -> + Un_cv Un 0 -> + Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l -> + sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N). +intros. +cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l). +cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l). +intros; split. +apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))). +apply CV_ALT_step0; assumption. +assumption. +apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))). +apply CV_ALT_step1; assumption. +assumption. +unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; intros. +elim (H1 eps H2); intros. +exists x; intros. +apply H3. +unfold ge in |- *; apply le_trans with (2 * n)%nat. +apply le_trans with n. +assumption. +assert (H5 := mult_O_le n 2). +elim H5; intro. +cut (0%nat <> 2%nat); + [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. +assumption. +apply le_n_Sn. +unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; intros. +elim (H1 eps H2); intros. +exists x; intros. +apply H3. +unfold ge in |- *; apply le_trans with n. +assumption. +assert (H5 := mult_O_le n 2). +elim H5; intro. +cut (0%nat <> 2%nat); + [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. +assumption. Qed. (************************************) (* Application : construction of PI *) (************************************) -Definition PI_tg := [n:nat]``/(INR (plus (mult (S (S O)) n) (S O)))``. +Definition PI_tg (n:nat) := / INR (2 * n + 1). -Lemma PI_tg_pos : (n:nat)``0<=(PI_tg n)``. -Intro; Unfold PI_tg; Left; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring]. +Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n. +intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0; + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. Qed. -Lemma PI_tg_decreasing : (Un_decreasing PI_tg). -Unfold PI_tg Un_decreasing; Intro. -Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``. -Apply lt_INR_0. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring]. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) (S n)) (S O)))``. -Apply lt_INR_0. -Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring]. -Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) (S n)) (S O)))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Do 2 Rewrite Rmult_1r; Apply le_INR. -Replace (plus (mult (2) (S n)) (1)) with (S (S (plus (mult (2) n) (1)))). -Apply le_trans with (S (plus (mult (2) n) (1))); Apply le_n_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring]. +Lemma PI_tg_decreasing : Un_decreasing PI_tg. +unfold PI_tg, Un_decreasing in |- *; intro. +apply Rmult_le_reg_l with (INR (2 * n + 1)). +apply lt_INR_0. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (2 * S n + 1)). +apply lt_INR_0. +replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ]. +rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply le_INR. +replace (2 * S n + 1)%nat with (S (S (2 * n + 1))). +apply le_trans with (S (2 * n + 1)); apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; + do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +apply not_O_INR; discriminate. +apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); + [ discriminate | ring ]. Qed. -Lemma PI_tg_cv : (Un_cv PI_tg R0). -Unfold Un_cv; Unfold R_dist; Intros. -Cut ``0<2*eps``; [Intro | Apply Rmult_lt_pos; [Sup0 | Assumption]]. -Assert H1 := (archimed ``/(2*eps)``). -Cut (Zle `0` ``(up (/(2*eps)))``). -Intro; Assert H3 := (IZN ``(up (/(2*eps)))`` H2). -Elim H3; Intros N H4. -Cut (lt O N). -Intro; Exists N; Intros. -Cut (lt O n). -Intro; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_right. -Unfold PI_tg; Apply Rlt_trans with ``/(INR (mult (S (S O)) n))``. -Apply Rlt_monotony_contra with ``(INR (mult (S (S O)) n))``. -Apply lt_INR_0. -Replace (mult (2) n) with (plus n n); [Idtac | Ring]. -Apply lt_le_trans with n. -Assumption. -Apply le_plus_l. -Rewrite <- Rinv_r_sym. -Apply Rlt_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``. -Apply lt_INR_0. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring]. -Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) n) (S O)))``). -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Do 2 Rewrite Rmult_1r; Apply lt_INR. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_n_Sn | Ring]. -Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring]. -Replace n with (S (pred n)). -Apply not_O_INR; Discriminate. -Symmetry; Apply S_pred with O. -Assumption. -Apply Rle_lt_trans with ``/(INR (mult (S (S O)) N))``. -Apply Rle_monotony_contra with ``(INR (mult (S (S O)) N))``. -Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption]. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with ``(INR (mult (S (S O)) n))``. -Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption]. -Rewrite (Rmult_sym (INR (mult (S (S O)) n))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Do 2 Rewrite Rmult_1r; Apply le_INR. -Apply mult_le; Assumption. -Replace n with (S (pred n)). -Apply not_O_INR; Discriminate. -Symmetry; Apply S_pred with O. -Assumption. -Replace N with (S (pred N)). -Apply not_O_INR; Discriminate. -Symmetry; Apply S_pred with O. -Assumption. -Rewrite mult_INR. -Rewrite Rinv_Rmult. -Replace (INR (S (S O))) with ``2``; [Idtac | Reflexivity]. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Idtac | DiscrR]. -Rewrite Rmult_1l; Apply Rlt_monotony_contra with (INR N). -Apply lt_INR_0; Assumption. -Rewrite <- Rinv_r_sym. -Apply Rlt_monotony_contra with ``/(2*eps)``. -Apply Rlt_Rinv; Assumption. -Rewrite Rmult_1r; Replace ``/(2*eps)*((INR N)*(2*eps))`` with ``(INR N)*((2*eps)*/(2*eps))``; [Idtac | Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Replace (INR N) with (IZR (INZ N)). -Rewrite <- H4. -Elim H1; Intros; Assumption. -Symmetry; Apply INR_IZR_INZ. -Apply prod_neq_R0; [DiscrR | Red; Intro; Rewrite H8 in H; Elim (Rlt_antirefl ? H)]. -Apply not_O_INR. -Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5). -Replace (INR (S (S O))) with ``2``; [DiscrR | Reflexivity]. -Apply not_O_INR. -Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5). -Apply Rle_sym1; Apply PI_tg_pos. -Apply lt_le_trans with N; Assumption. -Elim H1; Intros H5 _. -Assert H6 := (lt_eq_lt_dec O N). -Elim H6; Intro. -Elim a; Intro. -Assumption. -Rewrite <- b in H4. -Rewrite H4 in H5. -Simpl in H5. -Cut ``0</(2*eps)``; [Intro | Apply Rlt_Rinv; Assumption]. -Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H7 H5)). -Elim (lt_n_O ? b). -Apply le_IZR. -Simpl. -Left; Apply Rlt_trans with ``/(2*eps)``. -Apply Rlt_Rinv; Assumption. -Elim H1; Intros; Assumption. +Lemma PI_tg_cv : Un_cv PI_tg 0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < 2 * eps); + [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. +assert (H1 := archimed (/ (2 * eps))). +cut (0 <= up (/ (2 * eps)))%Z. +intro; assert (H3 := IZN (up (/ (2 * eps))) H2). +elim H3; intros N H4. +cut (0 < N)%nat. +intro; exists N; intros. +cut (0 < n)%nat. +intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_right. +unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)). +apply Rmult_lt_reg_l with (INR (2 * n)). +apply lt_INR_0. +replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ]. +apply lt_le_trans with n. +assumption. +apply le_plus_l. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (INR (2 * n + 1)). +apply lt_INR_0. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +rewrite (Rmult_comm (INR (2 * n + 1))). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply lt_INR. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ]. +apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); + [ discriminate | ring ]. +replace n with (S (pred n)). +apply not_O_INR; discriminate. +symmetry in |- *; apply S_pred with 0%nat. +assumption. +apply Rle_lt_trans with (/ INR (2 * N)). +apply Rmult_le_reg_l with (INR (2 * N)). +rewrite mult_INR; apply Rmult_lt_0_compat; + [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (2 * n)). +rewrite mult_INR; apply Rmult_lt_0_compat; + [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. +rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +do 2 rewrite Rmult_1_r; apply le_INR. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +replace n with (S (pred n)). +apply not_O_INR; discriminate. +symmetry in |- *; apply S_pred with 0%nat. +assumption. +replace N with (S (pred N)). +apply not_O_INR; discriminate. +symmetry in |- *; apply S_pred with 0%nat. +assumption. +rewrite mult_INR. +rewrite Rinv_mult_distr. +replace (INR 2) with 2; [ idtac | reflexivity ]. +apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ]. +rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N). +apply lt_INR_0; assumption. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (/ (2 * eps)). +apply Rinv_0_lt_compat; assumption. +rewrite Rmult_1_r; + replace (/ (2 * eps) * (INR N * (2 * eps))) with + (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)). +rewrite <- H4. +elim H1; intros; assumption. +symmetry in |- *; apply INR_IZR_INZ. +apply prod_neq_R0; + [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ]. +apply not_O_INR. +red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). +replace (INR 2) with 2; [ discrR | reflexivity ]. +apply not_O_INR. +red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). +apply Rle_ge; apply PI_tg_pos. +apply lt_le_trans with N; assumption. +elim H1; intros H5 _. +assert (H6 := lt_eq_lt_dec 0 N). +elim H6; intro. +elim a; intro. +assumption. +rewrite <- b in H4. +rewrite H4 in H5. +simpl in H5. +cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ]. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)). +elim (lt_n_O _ b). +apply le_IZR. +simpl in |- *. +left; apply Rlt_trans with (/ (2 * eps)). +apply Rinv_0_lt_compat; assumption. +elim H1; intros; assumption. Qed. -Lemma exist_PI : (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt PI_tg) N) l)). -Apply alternated_series. -Apply PI_tg_decreasing. -Apply PI_tg_cv. +Lemma exist_PI : + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l). +apply alternated_series. +apply PI_tg_decreasing. +apply PI_tg_cv. Qed. (* Now, PI is defined *) -Definition PI : R := (Rmult ``4`` (Cases exist_PI of (existTT a b) => a end)). +Definition PI : R := 4 * match exist_PI with + | existT a b => a + end. (* We can get an approximation of PI with the following inequality *) -Lemma PI_ineq : (N:nat) ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) N)))<=PI/4<=(sum_f_R0 (tg_alt PI_tg) (mult (S (S O)) N))``. -Intro; Apply alternated_series_ineq. -Apply PI_tg_decreasing. -Apply PI_tg_cv. -Unfold PI; Case exist_PI; Intro. -Replace ``(4*x)/4`` with x. -Trivial. -Unfold Rdiv; Rewrite (Rmult_sym ``4``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r; Reflexivity | DiscrR]. +Lemma PI_ineq : + forall N:nat, + sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <= + sum_f_R0 (tg_alt PI_tg) (2 * N). +intro; apply alternated_series_ineq. +apply PI_tg_decreasing. +apply PI_tg_cv. +unfold PI in |- *; case exist_PI; intro. +replace (4 * x / 4) with x. +trivial. +unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ]. Qed. -Lemma PI_RGT_0 : ``0<PI``. -Assert H := (PI_ineq O). -Apply Rlt_monotony_contra with ``/4``. -Apply Rlt_Rinv; Sup0. -Rewrite Rmult_Or; Rewrite Rmult_sym. -Elim H; Clear H; Intros H _. -Unfold Rdiv in H; Apply Rlt_le_trans with ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) O)))``. -Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1l; Rewrite Rmult_1r; Apply Rlt_anti_compatibility with ``(PI_tg (S O))``. -Rewrite Rplus_Or; Replace ``(PI_tg (S O))+((PI_tg O)+ -1*(PI_tg (S O)))`` with ``(PI_tg O)``; [Unfold PI_tg | Ring]. -Simpl; Apply Rinv_lt. -Rewrite Rmult_1l; Replace ``2+1`` with ``3``; [Sup0 | Ring]. -Rewrite Rplus_sym; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Sup0. -Assumption. -Qed. +Lemma PI_RGT_0 : 0 < PI. +assert (H := PI_ineq 0). +apply Rmult_lt_reg_l with (/ 4). +apply Rinv_0_lt_compat; prove_sup0. +rewrite Rmult_0_r; rewrite Rmult_comm. +elim H; clear H; intros H _. +unfold Rdiv in H; + apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))). +simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l; + rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1). +rewrite Rplus_0_r; + replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0); + [ unfold PI_tg in |- * | ring ]. +simpl in |- *; apply Rinv_lt_contravar. +rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ]. +rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; prove_sup0. +assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v index 7ec8ad1ed..72c99fc10 100644 --- a/theories/Reals/ArithProp.v +++ b/theories/Reals/ArithProp.v @@ -8,127 +8,171 @@ (*i $Id$ i*) -Require Rbase. -Require Rbasic_fun. -Require Even. -Require Div2. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rbasic_fun. +Require Import Even. +Require Import Div2. Open Local Scope Z_scope. Open Local Scope R_scope. -Lemma minus_neq_O : (n,i:nat) (lt i n) -> ~(minus n i)=O. -Intros; Red; Intro. -Cut (n,m:nat) (le m n) -> (minus n m)=O -> n=m. -Intro; Assert H2 := (H1 ? ? (lt_le_weak ? ? H) H0); Rewrite H2 in H; Elim (lt_n_n ? H). -Pose R := [n,m:nat](le m n)->(minus n m)=(0)->n=m. -Cut ((n,m:nat)(R n m)) -> ((n0,m:nat)(le m n0)->(minus n0 m)=(0)->n0=m). -Intro; Apply H1. -Apply nat_double_ind. -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; Intros; Apply H1; Assumption. +Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat. +intros; red in |- *; intro. +cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). +intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H; + elim (lt_irrefl _ H). +pose (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). +cut + ((forall n m:nat, R n m) -> + forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m). +intro; apply H1. +apply nat_double_ind. +unfold R in |- *; intros; inversion H2; reflexivity. +unfold R in |- *; intros; simpl in H3; assumption. +unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3); + assert (H6 := H2 H5 H4); rewrite H6; reflexivity. +unfold R in |- *; intros; apply H1; assumption. Qed. -Lemma le_minusni_n : (n,i:nat) (le i n)->(le (minus n i) n). -Pose R := [m,n:nat] (le n m) -> (le (minus m n) m). -Cut ((m,n:nat)(R m n)) -> ((n,i:nat)(le i n)->(le (minus n i) n)). -Intro; Apply H. -Apply nat_double_ind. -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; Intros; Apply H; Assumption. +Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat. +pose (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat). +cut + ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat). +intro; apply H. +apply nat_double_ind. +unfold R in |- *; intros; simpl in |- *; apply le_n. +unfold R in |- *; intros; simpl in |- *; apply le_n. +unfold R in |- *; intros; simpl in |- *; apply le_trans with n. +apply H0; apply le_S_n; assumption. +apply le_n_Sn. +unfold R in |- *; intros; apply H; assumption. Qed. -Lemma lt_minus_O_lt : (m,n:nat) (lt m n) -> (lt O (minus n m)). -Intros n m; Pattern n m; Apply nat_double_ind; [ - Intros; Rewrite <- minus_n_O; Assumption -| Intros; Elim (lt_n_O ? H) -| Intros; Simpl; Apply H; Apply lt_S_n; Assumption]. +Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat. +intros n m; pattern n, m in |- *; apply nat_double_ind; + [ intros; rewrite <- minus_n_O; assumption + | intros; elim (lt_n_O _ H) + | intros; simpl in |- *; apply H; apply lt_S_n; assumption ]. Qed. -Lemma even_odd_cor : (n:nat) (EX p : nat | n=(mult (2) p)\/n=(S (mult (2) p))). -Intro. -Assert H := (even_or_odd n). -Exists (div2 n). -Assert H0 := (even_odd_double n). -Elim H0; Intros. -Elim H1; Intros H3 _. -Elim H2; Intros H4 _. -Replace (mult (2) (div2 n)) with (Div2.double (div2 n)). -Elim H; Intro. -Left. -Apply H3; Assumption. -Right. -Apply H4; Assumption. -Unfold Div2.double; Ring. +Lemma even_odd_cor : + forall n:nat, exists p : nat | n = (2 * p)%nat \/ n = S (2 * p). +intro. +assert (H := even_or_odd n). +exists (div2 n). +assert (H0 := even_odd_double n). +elim H0; intros. +elim H1; intros H3 _. +elim H2; intros H4 _. +replace (2 * div2 n)%nat with (double (div2 n)). +elim H; intro. +left. +apply H3; assumption. +right. +apply H4; assumption. +unfold double in |- *; ring. Qed. (* 2m <= 2n => m<=n *) -Lemma le_double : (m,n:nat) (le (mult (2) m) (mult (2) n)) -> (le m n). -Intros; Apply INR_le. -Assert H1 := (le_INR ? ? H). -Do 2 Rewrite mult_INR in H1. -Apply Rle_monotony_contra with ``(INR (S (S O)))``. -Replace (INR (S (S O))) with ``2``; [Sup0 | Reflexivity]. -Assumption. +Lemma le_double : forall m n:nat, (2 * m <= 2 * n)%nat -> (m <= n)%nat. +intros; apply INR_le. +assert (H1 := le_INR _ _ H). +do 2 rewrite mult_INR in H1. +apply Rmult_le_reg_l with (INR 2). +replace (INR 2) with 2; [ prove_sup0 | reflexivity ]. +assumption. Qed. (* Here, we have the euclidian division *) (* This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *) -Lemma euclidian_division : (x,y:R) ``y<>0`` -> (EXT k:Z | (EXT r : R | ``x==(IZR k)*y+r``/\``0<=r<(Rabsolu y)``)). -Intros. -Pose k0 := Cases (case_Rabsolu y) of - (leftT _) => (Zminus `1` (up ``x/-y``)) - | (rightT _) => (Zminus (up ``x/y``) `1`) end. -Exists k0. -Exists ``x-(IZR k0)*y``. -Split. -Ring. -Unfold k0; Case (case_Rabsolu 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. -Apply Rle_monotony_contra with ``/-y``. -Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r. -Rewrite Rmult_Or; Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption]. -Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]. -Apply Rle_anti_compatibility with ``(IZR (up (x/( -y))))-x/( -y)``. -Rewrite Rplus_Or; Unfold Rdiv; Pattern 4 ``/-y``; Rewrite <- Ropp_Rinv; [Idtac | Assumption]. -Replace ``(IZR (up (x*/ -y)))-x* -/y+( -(x*/y)+ -((IZR (up (x*/ -y)))-1))`` with R1; [Idtac | Ring]. -Elim H0; Intros _ H1; Unfold Rdiv in H1; Exact H1. -Rewrite (Rabsolu_left ? r); Apply Rlt_monotony_contra with ``/-y``. -Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r. -Rewrite <- Rinv_l_sym. -Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption]. -Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/( -y))))-1)``. -Replace ``(IZR (up (x/( -y))))-1+1`` with ``(IZR (up (x/( -y))))``; [Idtac | Ring]. -Replace ``(IZR (up (x/( -y))))-1+( -(x*/y)+ -((IZR (up (x/( -y))))-1))`` with ``-(x*/y)``; [Idtac | Ring]. -Rewrite <- Ropp_mul3; Rewrite (Ropp_Rinv ? H); Elim H0; Unfold Rdiv; Intros H1 _; Exact H1. -Apply Ropp_neq; Assumption. -Assert H0 := (archimed ``x/y``); Rewrite <- Z_R_minus; Simpl; Cut ``0<y``. -Intro; Unfold Rminus; Replace ``-(((IZR (up (x/y)))+ -1)*y)`` with ``(1-(IZR (up (x/y))))*y``; [Idtac | Ring]. -Split. -Apply Rle_monotony_contra with ``/y``. -Apply Rlt_Rinv; Assumption. -Rewrite Rmult_Or; Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rle_anti_compatibility with ``(IZR (up (x/y)))-x/y``; Rewrite Rplus_Or; Unfold Rdiv; Replace ``(IZR (up (x*/y)))-x*/y+(x*/y+(1-(IZR (up (x*/y)))))`` with R1; [Idtac | Ring]; Elim H0; Intros _ H2; Unfold Rdiv in H2; Exact H2. -Rewrite (Rabsolu_right ? r); Apply Rlt_monotony_contra with ``/y``. -Apply Rlt_Rinv; Assumption. -Rewrite <- (Rinv_l_sym ? H); Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/y)))-1)``; Replace ``(IZR (up (x/y)))-1+1`` with ``(IZR (up (x/y)))``; [Idtac | Ring]; Replace ``(IZR (up (x/y)))-1+(x*/y+(1-(IZR (up (x/y)))))`` with ``x*/y``; [Idtac | Ring]; Elim H0; Unfold Rdiv; Intros H2 _; Exact H2. -Case (total_order_T R0 y); Intro. -Elim s; Intro. -Assumption. -Elim H; Symmetry; Exact b. -Assert H1 := (Rle_sym2 ? ? r); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r0)). +Lemma euclidian_division : + forall x y:R, + y <> 0 -> + exists k : Z | ( exists r : R | x = IZR k * y + r /\ 0 <= r < Rabs y). +intros. +pose + (k0 := + match Rcase_abs y with + | left _ => (1 - up (x / - y))%Z + | right _ => (up (x / y) - 1)%Z + end). +exists k0. +exists (x - IZR k0 * y). +split. +ring. +unfold k0 in |- *; case (Rcase_abs y); intro. +assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *; + unfold Rminus in |- *. +replace (- ((1 + - IZR (up (x / - y))) * y)) with + ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ]. +split. +apply Rmult_le_reg_l with (/ - y). +apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. +rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. +rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]. +apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y). +rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. +replace + (IZR (up (x * / - y)) - x * - / y + + (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; + [ idtac | ring ]. +elim H0; intros _ H1; unfold Rdiv in H1; exact H1. +rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y). +apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. +rewrite <- Rinv_l_sym. +rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. +rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]; + apply Rplus_lt_reg_r with (IZR (up (x / - y)) - 1). +replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y))); + [ idtac | ring ]. +replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1))) + with (- (x * / y)); [ idtac | ring ]. +rewrite <- Ropp_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0; + unfold Rdiv in |- *; intros H1 _; exact H1. +apply Ropp_neq_0_compat; assumption. +assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *; + cut (0 < y). +intro; unfold Rminus in |- *; + replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y); + [ idtac | ring ]. +split. +apply Rmult_le_reg_l with (/ y). +apply Rinv_0_lt_compat; assumption. +rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; + rewrite Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_r | assumption ]; + apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); + rewrite Rplus_0_r; unfold Rdiv in |- *; + replace + (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with + 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; + exact H2. +rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y). +apply Rinv_0_lt_compat; assumption. +rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y)); + rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_r | assumption ]; + apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1); + replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); + [ idtac | ring ]; + replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with + (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *; + intros H2 _; exact H2. +case (total_order_T 0 y); intro. +elim s; intro. +assumption. +elim H; symmetry in |- *; exact b. +assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)). Qed. -Lemma tech8 : (n,i:nat) (le n (plus (S n) i)). -Intros; Induction i. -Replace (plus (S n) O) with (S n); [Apply le_n_Sn | Ring]. -Replace (plus (S n) (S i)) with (S (plus (S n) i)). -Apply le_S; Assumption. -Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring. -Qed. +Lemma tech8 : forall n i:nat, (n <= S n + i)%nat. +intros; induction i as [| i Hreci]. +replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ]. +replace (S n + S i)%nat with (S (S n + i)). +apply le_S; assumption. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v index 5bbf8c7dd..e8173b82e 100644 --- a/theories/Reals/Binomial.v +++ b/theories/Reals/Binomial.v @@ -8,174 +8,197 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require PartSum. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import PartSum. Open Local Scope R_scope. -Definition C [n,p:nat] : R := ``(INR (fact n))/((INR (fact p))*(INR (fact (minus n p))))``. +Definition C (n p:nat) : R := + INR (fact n) / (INR (fact p) * INR (fact (n - p))). -Lemma pascal_step1 : (n,i:nat) (le i n) -> (C n i) == (C n (minus n i)). -Intros; Unfold C; Replace (minus n (minus n i)) with i. -Rewrite Rmult_sym. -Reflexivity. -Apply plus_minus; Rewrite plus_sym; Apply le_plus_minus; Assumption. +Lemma pascal_step1 : forall n i:nat, (i <= n)%nat -> C n i = C n (n - i). +intros; unfold C in |- *; replace (n - (n - i))%nat with i. +rewrite Rmult_comm. +reflexivity. +apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption. Qed. -Lemma pascal_step2 : (n,i:nat) (le i n) -> (C (S n) i) == ``(INR (S n))/(INR (minus (S n) i))*(C n i)``. -Intros; Unfold C; Replace (minus (S n) i) with (S (minus n i)). -Cut (n:nat) (fact (S n))=(mult (S n) (fact n)). -Intro; Repeat Rewrite H0. -Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult. -Ring. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply not_O_INR; Discriminate. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply prod_neq_R0. -Apply not_O_INR; Discriminate. -Apply INR_fact_neq_0. -Intro; Reflexivity. -Apply minus_Sn_m; Assumption. +Lemma pascal_step2 : + forall n i:nat, + (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i. +intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)). +cut (forall n:nat, fact (S n) = (S n * fact n)%nat). +intro; repeat rewrite H0. +unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. +ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply prod_neq_R0. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +intro; reflexivity. +apply minus_Sn_m; assumption. Qed. -Lemma pascal_step3 : (n,i:nat) (lt i n) -> (C n (S i)) == ``(INR (minus n i))/(INR (S i))*(C n i)``. -Intros; Unfold C. -Cut (n:nat) (fact (S n))=(mult (S n) (fact n)). -Intro. -Cut (minus n i) = (S (minus n (S i))). -Intro. -Pattern 2 (minus n i); Rewrite H1. -Repeat Rewrite H0; Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult. -Rewrite <- H1; Rewrite (Rmult_sym ``/(INR (minus n i))``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (minus n i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Ring. -Apply not_O_INR; Apply minus_neq_O; Assumption. -Apply not_O_INR; Discriminate. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0]. -Apply not_O_INR; Discriminate. -Apply INR_fact_neq_0. -Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0]. -Apply INR_fact_neq_0. -Rewrite minus_Sn_m. -Simpl; Reflexivity. -Apply lt_le_S; Assumption. -Intro; Reflexivity. +Lemma pascal_step3 : + forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i. +intros; unfold C in |- *. +cut (forall n:nat, fact (S n) = (S n * fact n)%nat). +intro. +cut ((n - i)%nat = S (n - S i)). +intro. +pattern (n - i)%nat at 2 in |- *; rewrite H1. +repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR; + repeat rewrite Rinv_mult_distr. +rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i))); + repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i))); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +ring. +apply not_O_INR; apply minus_neq_O; assumption. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +apply INR_fact_neq_0. +rewrite minus_Sn_m. +simpl in |- *; reflexivity. +apply lt_le_S; assumption. +intro; reflexivity. Qed. (**********) -Lemma pascal : (n,i:nat) (lt i n) -> ``(C n i)+(C n (S i))==(C (S n) (S i))``. -Intros. -Rewrite pascal_step3; [Idtac | Assumption]. -Replace ``(C n i)+(INR (minus n i))/(INR (S i))*(C n i)`` with ``(C n i)*(1+(INR (minus n i))/(INR (S i)))``; [Idtac | Ring]. -Replace ``1+(INR (minus n i))/(INR (S i))`` with ``(INR (S n))/(INR (S i))``. -Rewrite pascal_step1. -Rewrite Rmult_sym; Replace (S i) with (minus (S n) (minus n i)). -Rewrite <- pascal_step2. -Apply pascal_step1. -Apply le_trans with n. -Apply le_minusni_n. -Apply lt_le_weak; Assumption. -Apply le_n_Sn. -Apply le_minusni_n. -Apply lt_le_weak; Assumption. -Rewrite <- minus_Sn_m. -Cut (minus n (minus n i))=i. -Intro; Rewrite H0; Reflexivity. -Symmetry; Apply plus_minus. -Rewrite plus_sym; 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. -Repeat Rewrite S_INR. -Rewrite minus_INR. -Cut ``((INR i)+1)<>0``. -Intro. -Apply r_Rmult_mult with ``(INR i)+1``; [Idtac | Assumption]. -Rewrite Rmult_Rplus_distr. -Rewrite Rmult_1r. -Do 2 Rewrite (Rmult_sym ``(INR i)+1``). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym; [Idtac | Assumption]. -Ring. -Rewrite <- S_INR. -Apply not_O_INR; Discriminate. -Apply lt_le_weak; Assumption. +Lemma pascal : + forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i). +intros. +rewrite pascal_step3; [ idtac | assumption ]. +replace (C n i + INR (n - i) / INR (S i) * C n i) with + (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ]. +replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)). +rewrite pascal_step1. +rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat. +rewrite <- pascal_step2. +apply pascal_step1. +apply le_trans with n. +apply le_minusni_n. +apply lt_le_weak; assumption. +apply le_n_Sn. +apply le_minusni_n. +apply lt_le_weak; assumption. +rewrite <- minus_Sn_m. +cut ((n - (n - i))%nat = i). +intro; rewrite H0; reflexivity. +symmetry in |- *; apply plus_minus. +rewrite plus_comm; rewrite le_plus_minus_r. +reflexivity. +apply lt_le_weak; assumption. +apply le_minusni_n; apply lt_le_weak; assumption. +apply lt_le_weak; assumption. +unfold Rdiv in |- *. +repeat rewrite S_INR. +rewrite minus_INR. +cut (INR i + 1 <> 0). +intro. +apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ]. +rewrite Rmult_plus_distr_l. +rewrite Rmult_1_r. +do 2 rewrite (Rmult_comm (INR i + 1)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym; [ idtac | assumption ]. +ring. +rewrite <- S_INR. +apply not_O_INR; discriminate. +apply lt_le_weak; assumption. Qed. (*********************) (*********************) -Lemma binomial : (x,y:R;n:nat) ``(pow (x+y) n)``==(sum_f_R0 [i:nat]``(C n i)*(pow x i)*(pow y (minus n i))`` n). -Intros; Induction n. -Unfold C; Simpl; Unfold Rdiv; Repeat Rewrite Rmult_1r; Rewrite Rinv_R1; Ring. -Pattern 1 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring]. -Rewrite pow_add; Rewrite Hrecn. -Replace ``(pow (x+y) (S O))`` with ``x+y``; [Idtac | Simpl; Ring]. -Rewrite tech5. -Cut (p:nat)(C p p)==R1. -Cut (p:nat)(C p O)==R1. -Intros; Rewrite H0; Rewrite <- minus_n_n; Rewrite Rmult_1l. -Replace (pow y O) with R1; [Rewrite Rmult_1r | Simpl; Reflexivity]. -Induction n. -Simpl; Do 2 Rewrite H; Ring. +Lemma binomial : + forall (x y:R) (n:nat), + (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n. +intros; induction n as [| n Hrecn]. +unfold C in |- *; simpl in |- *; unfold Rdiv in |- *; + repeat rewrite Rmult_1_r; rewrite Rinv_1; ring. +pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; rewrite Hrecn. +replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ]. +rewrite tech5. +cut (forall p:nat, C p p = 1). +cut (forall p:nat, C p 0 = 1). +intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l. +replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ]. +induction n as [| n Hrecn0]. +simpl in |- *; do 2 rewrite H; ring. (* N >= 1 *) -Pose N := (S n). -Rewrite Rmult_Rplus_distr. -Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) x) with (sum_f_R0 [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))`` N). -Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) y) with (sum_f_R0 [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))`` N). -Rewrite (decomp_sum [i:nat]``(C (S N) i)*(pow x i)*(pow y (minus (S N) i))`` N). -Rewrite H; Replace (pow x O) with R1; [Idtac | Reflexivity]. -Do 2 Rewrite Rmult_1l. -Replace (minus (S N) O) with (S N); [Idtac | Reflexivity]. -Pose An := [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))``. -Pose Bn := [i:nat]``(C N (S i))*(pow x (S i))*(pow y (minus N i))``. -Replace (pred N) with n. -Replace (sum_f_R0 ([i:nat]``(C (S N) (S i))*(pow x (S i))*(pow y (minus (S N) (S i)))``) n) with (sum_f_R0 [i:nat]``(An i)+(Bn i)`` n). -Rewrite plus_sum. -Replace (pow x (S N)) with (An (S n)). -Rewrite (Rplus_sym (sum_f_R0 An n)). -Repeat Rewrite Rplus_assoc. -Rewrite <- tech5. -Fold N. -Pose Cn := [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))``. -Cut (i:nat) (lt i N)-> (Cn (S i))==(Bn i). -Intro; Replace (sum_f_R0 Bn n) with (sum_f_R0 [i:nat](Cn (S i)) n). -Replace (pow y (S N)) with (Cn O). -Rewrite <- Rplus_assoc; Rewrite (decomp_sum Cn N). -Replace (pred N) with n. -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; Apply le_lt_trans with n; [Assumption | Apply lt_n_Sn]. -Intros; Unfold Bn Cn. -Replace (minus (S N) (S i)) with (minus N i); Reflexivity. -Unfold An; Fold N; Rewrite <- minus_n_n; Rewrite H0; Simpl; Ring. -Apply sum_eq. -Intros; Unfold An Bn; Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity]. -Rewrite <- pascal; [Ring | Apply le_lt_trans with n; [Assumption | Unfold N; Apply lt_n_Sn]]. -Unfold N; Reflexivity. -Unfold N; Apply lt_O_Sn. -Rewrite <- (Rmult_sym y); Rewrite scal_sum; Apply sum_eq. -Intros; Replace (minus (S N) i) with (S (minus N i)). -Replace (S (minus N i)) with (plus (minus N i) (1)); [Idtac | Ring]. -Rewrite pow_add; Replace (pow y (S O)) with y; [Idtac | Simpl; Ring]; Ring. -Apply minus_Sn_m; Assumption. -Rewrite <- (Rmult_sym x); Rewrite scal_sum; Apply sum_eq. -Intros; Replace (S i) with (plus i (1)); [Idtac | Ring]; Rewrite pow_add; Replace (pow x (S O)) with x; [Idtac | Simpl; Ring]; Ring. -Intro; Unfold C. -Replace (INR (fact O)) with R1; [Idtac | Reflexivity]. -Replace (minus p O) with p; [Idtac | Apply minus_n_O]. -Rewrite Rmult_1l; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0]. -Intro; Unfold C. -Replace (minus p p) with O; [Idtac | Apply minus_n_n]. -Replace (INR (fact O)) with R1; [Idtac | Reflexivity]. -Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0]. -Qed. +pose (N := S n). +rewrite Rmult_plus_distr_l. +replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with + (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N). +replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with + (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N). +rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N). +rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ]. +do 2 rewrite Rmult_1_l. +replace (S N - 0)%nat with (S N); [ idtac | reflexivity ]. +pose (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)). +pose (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)). +replace (pred N) with n. +replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n) + with (sum_f_R0 (fun i:nat => An i + Bn i) n). +rewrite plus_sum. +replace (x ^ S N) with (An (S n)). +rewrite (Rplus_comm (sum_f_R0 An n)). +repeat rewrite Rplus_assoc. +rewrite <- tech5. +fold N in |- *. +pose (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)). +cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i). +intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n). +replace (y ^ S N) with (Cn 0%nat). +rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N). +replace (pred N) with n. +ring. +unfold N in |- *; simpl in |- *; reflexivity. +unfold N in |- *; apply lt_O_Sn. +unfold Cn in |- *; rewrite H; simpl in |- *; ring. +apply sum_eq. +intros; apply H1. +unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ]. +intros; unfold Bn, Cn in |- *. +replace (S N - S i)%nat with (N - i)%nat; reflexivity. +unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0; + simpl in |- *; ring. +apply sum_eq. +intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat; + [ idtac | reflexivity ]. +rewrite <- pascal; + [ ring + | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ]. +unfold N in |- *; reflexivity. +unfold N in |- *; apply lt_O_Sn. +rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq. +intros; replace (S N - i)%nat with (S (N - i)). +replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ]. +rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ]; + ring. +apply minus_Sn_m; assumption. +rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq. +intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add; + replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; + ring. +intro; unfold C in |- *. +replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. +replace (p - 0)%nat with p; [ idtac | apply minus_n_O ]. +rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; + [ reflexivity | apply INR_fact_neq_0 ]. +intro; unfold C in |- *. +replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ]. +replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. +rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; + [ reflexivity | apply INR_fact_neq_0 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v index a76307320..6cd5fa17f 100644 --- a/theories/Reals/Cauchy_prod.v +++ b/theories/Reals/Cauchy_prod.v @@ -8,340 +8,451 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require PartSum. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import PartSum. Open Local Scope R_scope. (**********) -Lemma sum_N_predN : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==``(sum_f_R0 An (pred N)) + (An N)``. -Intros. -Replace N with (S (pred N)). -Rewrite tech5. -Reflexivity. -Symmetry; Apply S_pred with O; Assumption. +Lemma sum_N_predN : + forall (An:nat -> R) (N:nat), + (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N. +intros. +replace N with (S (pred N)). +rewrite tech5. +reflexivity. +symmetry in |- *; apply S_pred with 0%nat; assumption. Qed. (**********) -Lemma sum_plus : (An,Bn:nat->R;N:nat) (sum_f_R0 [l:nat]``(An l)+(Bn l)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``. -Intros. -Induction N. -Reflexivity. -Do 3 Rewrite tech5. -Rewrite HrecN; Ring. +Lemma sum_plus : + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N. +intros. +induction N as [| N HrecN]. +reflexivity. +do 3 rewrite tech5. +rewrite HrecN; ring. Qed. (* The main result *) -Theorem cauchy_finite : (An,Bn:nat->R;N:nat) (lt O N) -> (Rmult (sum_f_R0 An N) (sum_f_R0 Bn N)) == (Rplus (sum_f_R0 [k:nat](sum_f_R0 [p:nat]``(An p)*(Bn (minus k p))`` k) N) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N))). -Intros; Induction N. -Elim (lt_n_n ? H). -Cut N=O\/(lt O N). -Intro; Elim H0; Intro. -Rewrite H1; Simpl; Ring. -Replace (pred (S N)) with (S (pred N)). -Do 5 Rewrite tech5. -Rewrite Rmult_Rplus_distrl; Rewrite Rmult_Rplus_distr; Rewrite (HrecN H1). -Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Replace (pred (minus (S N) (S (pred N)))) with (O). -Rewrite Rmult_Rplus_distr; Replace (sum_f_R0 [l:nat]``(An (S (plus l (S (pred N)))))*(Bn (minus (S N) l))`` O) with ``(An (S N))*(Bn (S N))``. -Repeat Rewrite <- Rplus_assoc; Do 2 Rewrite <- (Rplus_sym ``(An (S N))*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Rewrite <- minus_n_n; Cut N=(1)\/(le (2) N). -Intro; Elim H2; Intro. -Rewrite H3; Simpl; Ring. -Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))). -Replace (sum_f_R0 [p:nat]``(An p)*(Bn (minus (S N) p))`` N) with (Rplus (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)) ``(An O)*(Bn (S N))``). -Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) (Rmult (Bn (S N)) (sum_f_R0 [l:nat](An (S l)) (pred N)))). -Rewrite (decomp_sum An N H1); Rewrite Rmult_Rplus_distrl; Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym ``(An O)*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (Rmult (sum_f_R0 [i:nat](An (S i)) (pred N)) (Bn (S N)))); Rewrite <- (Rplus_sym (Rmult (Bn (S N)) (sum_f_R0 [i:nat](An (S i)) (pred N)))); Rewrite (Rmult_sym (Bn (S N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (Rmult (An (S N)) (sum_f_R0 [l:nat](Bn (S l)) (pred N)))). -Rewrite (decomp_sum Bn N H1); Rewrite Rmult_Rplus_distr. -Pose Z := (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))); Pose Z2 := (sum_f_R0 [i:nat](Bn (S i)) (pred N)); Ring. -Rewrite (sum_N_predN [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)). -Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred (pred N))) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) ``(An (S N))*(Bn (S k))``) (pred (pred N))). -Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))). -Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Replace (pred (minus N (pred N))) with O. -Simpl; Rewrite <- minus_n_O. -Replace (S (pred N)) with N. -Replace (sum_f_R0 [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))) with (sum_f_R0 [k:nat]``(Bn (S k))*(An (S N))`` (pred (pred N))). -Rewrite <- (scal_sum [l:nat](Bn (S l)) (pred (pred N)) (An (S N))); Rewrite (sum_N_predN [l:nat](Bn (S l)) (pred N)). -Replace (S (pred N)) with N. -Ring. -Apply S_pred with O; Assumption. -Apply lt_pred; Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption]. -Apply sum_eq; Intros; Apply Rmult_sym. -Apply S_pred with O; Assumption. -Replace (minus N (pred N)) with (1). -Reflexivity. -Pattern 1 N; Replace N with (S (pred N)). -Rewrite <- minus_Sn_m. -Rewrite <- minus_n_n; Reflexivity. -Apply le_n. -Symmetry; Apply S_pred with O; Assumption. -Apply sum_eq; Intros; Rewrite (sum_N_predN [l:nat]``(An (S (S (plus l i))))*(Bn (minus N l))`` (pred (minus N i))). -Replace (S (S (plus (pred (minus N i)) i))) with (S N). -Replace (minus N (pred (minus N i))) with (S i). -Ring. -Rewrite pred_of_minus; Apply INR_eq; Repeat Rewrite minus_INR. -Rewrite S_INR; Ring. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply INR_le; Rewrite minus_INR. -Apply Rle_anti_compatibility with ``(INR i)-1``. -Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring]. -Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring]. -Rewrite <- minus_INR. -Apply le_INR; Apply le_trans with (pred (pred N)). -Assumption. -Rewrite <- pred_of_minus; Apply le_pred_n. -Apply le_trans with (2). -Apply le_n_Sn. -Assumption. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Rewrite <- pred_of_minus. -Apply le_trans with (pred N). -Apply le_S_n. -Replace (S (pred N)) with N. -Replace (S (pred (minus N i))) with (minus N i). -Apply simpl_le_plus_l with i; Rewrite le_plus_minus_r. -Apply le_plus_r. -Apply le_trans with (pred (pred N)); [Assumption | Apply le_trans with (pred N); Apply le_pred_n]. -Apply S_pred with O. -Apply simpl_lt_plus_l with i; Rewrite le_plus_minus_r. -Replace (plus i O) with i; [Idtac | Ring]. -Apply le_lt_trans with (pred (pred N)); [Assumption | Apply lt_trans with (pred N); Apply lt_pred_n_n]. -Apply lt_S_n. -Replace (S (pred N)) with N. -Apply lt_le_trans with (2). -Apply lt_n_Sn. -Assumption. -Apply S_pred with O; Assumption. -Assumption. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply S_pred with O; Assumption. -Apply le_pred_n. -Apply INR_eq; Rewrite pred_of_minus; Do 3 Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite minus_INR. -Ring. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply INR_le. -Rewrite minus_INR. -Apply Rle_anti_compatibility with ``(INR i)-1``. -Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring]. -Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring]. -Rewrite <- minus_INR. -Apply le_INR. -Apply le_trans with (pred (pred N)). -Assumption. -Rewrite <- pred_of_minus. -Apply le_pred_n. -Apply le_trans with (2). -Apply le_n_Sn. -Assumption. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply lt_le_trans with (1). -Apply lt_O_Sn. -Apply INR_le. -Rewrite pred_of_minus. -Repeat Rewrite minus_INR. -Apply Rle_anti_compatibility with ``(INR i)-1``. -Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring]. -Replace ``(INR i)-1+((INR N)-(INR i)-(INR (S O)))`` with ``(INR N)-(INR (S O)) -(INR (S O))``. -Repeat Rewrite <- minus_INR. -Apply le_INR. -Apply le_trans with (pred (pred N)). -Assumption. -Do 2 Rewrite <- pred_of_minus. -Apply le_n. -Apply simpl_le_plus_l with (1). -Rewrite le_plus_minus_r. -Simpl; Assumption. -Apply le_trans with (2); [Apply le_n_Sn | Assumption]. -Apply le_trans with (2); [Apply le_n_Sn | Assumption]. -Ring. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply simpl_le_plus_l with i. -Rewrite le_plus_minus_r. -Replace (plus i (1)) with (S i). -Replace N with (S (pred N)). -Apply le_n_S. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_pred_n. -Symmetry; Apply S_pred with O; Assumption. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Reflexivity. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply lt_le_trans with (1). -Apply lt_O_Sn. -Apply le_S_n. -Replace (S (pred N)) with N. -Assumption. -Apply S_pred with O; Assumption. -Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) ``(An (S k))*(Bn (S N))``) (pred N)). -Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) [k:nat]``(An (S k))*(Bn (S N))``). -Apply Rplus_plus_r. -Rewrite scal_sum; Reflexivity. -Apply sum_eq; Intros; Rewrite Rplus_sym; Rewrite (decomp_sum [l:nat]``(An (S (plus l i)))*(Bn (minus (S N) l))`` (pred (minus (S N) i))). -Replace (plus O i) with i; [Idtac | Ring]. -Rewrite <- minus_n_O; Apply Rplus_plus_r. -Replace (pred (pred (minus (S N) i))) with (pred (minus N i)). -Apply sum_eq; Intros. -Replace (minus (S N) (S i0)) with (minus N i0); [Idtac | Reflexivity]. -Replace (plus (S i0) i) with (S (plus i0 i)). -Reflexivity. -Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring. -Cut (minus N i)=(pred (minus (S N) i)). -Intro; Rewrite H5; Reflexivity. -Rewrite pred_of_minus. -Apply INR_eq; Repeat Rewrite minus_INR. -Rewrite S_INR; Ring. -Apply le_trans with N. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply simpl_le_plus_l with i. -Rewrite le_plus_minus_r. -Replace (plus i (1)) with (S i). -Apply le_n_S. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_trans with N. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Replace (pred (minus (S N) i)) with (minus (S N) (S i)). -Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity]. -Apply simpl_lt_plus_l with i. -Rewrite le_plus_minus_r. -Replace (plus i O) with i; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n. -Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Rewrite pred_of_minus. -Apply INR_eq; Repeat Rewrite minus_INR. -Repeat Rewrite S_INR; Ring. -Apply le_trans with N. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply simpl_le_plus_l with i. -Rewrite le_plus_minus_r. -Replace (plus i (1)) with (S i). -Apply le_n_S. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_trans with N. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply le_n_S. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Rewrite Rplus_sym. -Rewrite (decomp_sum [p:nat]``(An p)*(Bn (minus (S N) p))`` N). -Rewrite <- minus_n_O. -Apply Rplus_plus_r. -Apply sum_eq; Intros. -Reflexivity. -Assumption. -Rewrite Rplus_sym. -Rewrite (decomp_sum [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)). -Rewrite <- minus_n_O. -Replace (sum_f_R0 [l:nat]``(An (S (plus l O)))*(Bn (minus N l))`` (pred N)) with (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)). -Apply Rplus_plus_r. -Apply sum_eq; Intros. -Replace (pred (minus N (S i))) with (pred (pred (minus N i))). -Apply sum_eq; Intros. -Replace (plus i0 (S i)) with (S (plus i0 i)). -Reflexivity. -Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring. -Cut (pred (minus N i))=(minus N (S i)). -Intro; Rewrite H5; Reflexivity. -Rewrite pred_of_minus. -Apply INR_eq. -Repeat Rewrite minus_INR. -Repeat Rewrite S_INR; Ring. -Apply le_trans with (S (pred (pred N))). -Apply le_n_S; Assumption. -Replace (S (pred (pred N))) with (pred N). -Apply le_pred_n. -Apply S_pred with O. -Apply lt_S_n. -Replace (S (pred N)) with N. -Apply lt_le_trans with (2). -Apply lt_n_Sn. -Assumption. -Apply S_pred with O; Assumption. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply simpl_le_plus_l with i. -Rewrite le_plus_minus_r. -Replace (plus i (1)) with (S i). -Replace N with (S (pred N)). -Apply le_n_S. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_pred_n. -Symmetry; Apply S_pred with O; Assumption. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_trans with (pred (pred N)). -Assumption. -Apply le_trans with (pred N); Apply le_pred_n. -Apply sum_eq; Intros. -Replace (plus i O) with i; [Reflexivity | Trivial]. -Apply lt_S_n. -Replace (S (pred N)) with N. -Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption]. -Apply S_pred with O; Assumption. -Inversion H1. -Left; Reflexivity. -Right; Apply le_n_S; Assumption. -Simpl. -Replace (S (pred N)) with N. -Reflexivity. -Apply S_pred with O; Assumption. -Simpl. -Cut (minus N (pred N))=(1). -Intro; Rewrite H2; Reflexivity. -Rewrite pred_of_minus. -Apply INR_eq; Repeat Rewrite minus_INR. -Ring. -Apply lt_le_S; Assumption. -Rewrite <- pred_of_minus; Apply le_pred_n. -Simpl; Symmetry; Apply S_pred with O; Assumption. -Inversion H. -Left; Reflexivity. -Right; Apply lt_le_trans with (1); [Apply lt_n_Sn | Exact H1]. -Qed. +Theorem cauchy_finite : + forall (An Bn:nat -> R) (N:nat), + (0 < N)%nat -> + sum_f_R0 An N * sum_f_R0 Bn N = + sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N + + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) + (pred (N - k))) (pred N). +intros; induction N as [| N HrecN]. +elim (lt_irrefl _ H). +cut (N = 0%nat \/ (0 < N)%nat). +intro; elim H0; intro. +rewrite H1; simpl in |- *; ring. +replace (pred (S N)) with (S (pred N)). +do 5 rewrite tech5. +rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1). +repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +replace (pred (S N - S (pred N))) with 0%nat. +rewrite Rmult_plus_distr_l; + replace + (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with + (An (S N) * Bn (S N)). +repeat rewrite <- Rplus_assoc; + do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N))); + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat). +intro; elim H2; intro. +rewrite H3; simpl in |- *; ring. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) + (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N)) + + sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). +replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with + (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) + + An 0%nat * Bn (S N)). +repeat rewrite <- Rplus_assoc; + rewrite <- + (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N))) + ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) + (pred (S N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N) + + Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)). +rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r; + repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N))); + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +repeat rewrite <- Rplus_assoc; + rewrite <- + (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N))) + ; + rewrite <- + (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N))) + ; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N)) + + An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)). +rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l. +pose + (Z := + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N))); + pose (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); + ring. +rewrite + (sum_N_predN + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N)). +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred (pred N))) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k))) + An (S N) * Bn (S k)) ( + pred (pred N))). +rewrite + (sum_plus + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k)) + (pred (pred N))). +repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. +replace (pred (N - pred N)) with 0%nat. +simpl in |- *; rewrite <- minus_n_O. +replace (S (pred N)) with N. +replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with + (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))). +rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N))); + rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)). +replace (S (pred N)) with N. +ring. +apply S_pred with 0%nat; assumption. +apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. +apply sum_eq; intros; apply Rmult_comm. +apply S_pred with 0%nat; assumption. +replace (N - pred N)%nat with 1%nat. +reflexivity. +pattern N at 1 in |- *; replace N with (S (pred N)). +rewrite <- minus_Sn_m. +rewrite <- minus_n_n; reflexivity. +apply le_n. +symmetry in |- *; apply S_pred with 0%nat; assumption. +apply sum_eq; intros; + rewrite + (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat) + (pred (N - i))). +replace (S (S (pred (N - i) + i))) with (S N). +replace (N - pred (N - i))%nat with (S i). +ring. +rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR. +rewrite S_INR; ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply INR_le; rewrite minus_INR. +apply Rplus_le_reg_l with (INR i - 1). +replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. +rewrite <- minus_INR. +apply le_INR; apply le_trans with (pred (pred N)). +assumption. +rewrite <- pred_of_minus; apply le_pred_n. +apply le_trans with 2%nat. +apply le_n_Sn. +assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +rewrite <- pred_of_minus. +apply le_trans with (pred N). +apply le_S_n. +replace (S (pred N)) with N. +replace (S (pred (N - i))) with (N - i)%nat. +apply (fun p n m:nat => plus_le_reg_l n m p) with i; rewrite le_plus_minus_r. +apply le_plus_r. +apply le_trans with (pred (pred N)); + [ assumption | apply le_trans with (pred N); apply le_pred_n ]. +apply S_pred with 0%nat. +apply plus_lt_reg_l with i; rewrite le_plus_minus_r. +replace (i + 0)%nat with i; [ idtac | ring ]. +apply le_lt_trans with (pred (pred N)); + [ assumption | apply lt_trans with (pred N); apply lt_pred_n_n ]. +apply lt_S_n. +replace (S (pred N)) with N. +apply lt_le_trans with 2%nat. +apply lt_n_Sn. +assumption. +apply S_pred with 0%nat; assumption. +assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply S_pred with 0%nat; assumption. +apply le_pred_n. +apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR; + repeat rewrite minus_INR. +ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply INR_le. +rewrite minus_INR. +apply Rplus_le_reg_l with (INR i - 1). +replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. +rewrite <- minus_INR. +apply le_INR. +apply le_trans with (pred (pred N)). +assumption. +rewrite <- pred_of_minus. +apply le_pred_n. +apply le_trans with 2%nat. +apply le_n_Sn. +assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply INR_le. +rewrite pred_of_minus. +repeat rewrite minus_INR. +apply Rplus_le_reg_l with (INR i - 1). +replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. +replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1). +repeat rewrite <- minus_INR. +apply le_INR. +apply le_trans with (pred (pred N)). +assumption. +do 2 rewrite <- pred_of_minus. +apply le_n. +apply (fun p n m:nat => plus_le_reg_l n m p) with 1%nat. +rewrite le_plus_minus_r. +simpl in |- *; assumption. +apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. +apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. +ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +replace N with (S (pred N)). +apply le_n_S. +apply le_trans with (pred (pred N)). +assumption. +apply le_pred_n. +symmetry in |- *; apply S_pred with 0%nat; assumption. +apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply le_S_n. +replace (S (pred N)) with N. +assumption. +apply S_pred with 0%nat; assumption. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) + (pred (S N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k)) + An (S k) * Bn (S N)) (pred N)). +rewrite + (sum_plus + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))) + . +apply Rplus_eq_compat_l. +rewrite scal_sum; reflexivity. +apply sum_eq; intros; rewrite Rplus_comm; + rewrite + (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat) + (pred (S N - i))). +replace (0 + i)%nat with i; [ idtac | ring ]. +rewrite <- minus_n_O; apply Rplus_eq_compat_l. +replace (pred (pred (S N - i))) with (pred (N - i)). +apply sum_eq; intros. +replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ]. +replace (S i0 + i)%nat with (S (i0 + i)). +reflexivity. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. +cut ((N - i)%nat = pred (S N - i)). +intro; rewrite H5; reflexivity. +rewrite pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +rewrite S_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +apply le_n_S. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +replace (pred (S N - i)) with (S N - S i)%nat. +replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ]. +apply plus_lt_reg_l with i. +rewrite le_plus_minus_r. +replace (i + 0)%nat with i; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n. +assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +repeat rewrite S_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +apply le_n_S. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply le_trans with N. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply le_n_S. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite Rplus_comm. +rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N). +rewrite <- minus_n_O. +apply Rplus_eq_compat_l. +apply sum_eq; intros. +reflexivity. +assumption. +rewrite Rplus_comm. +rewrite + (decomp_sum + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) + (pred N)). +rewrite <- minus_n_O. +replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N)) + with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). +apply Rplus_eq_compat_l. +apply sum_eq; intros. +replace (pred (N - S i)) with (pred (pred (N - i))). +apply sum_eq; intros. +replace (i0 + S i)%nat with (S (i0 + i)). +reflexivity. +apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. +cut (pred (N - i) = (N - S i)%nat). +intro; rewrite H5; reflexivity. +rewrite pred_of_minus. +apply INR_eq. +repeat rewrite minus_INR. +repeat rewrite S_INR; ring. +apply le_trans with (S (pred (pred N))). +apply le_n_S; assumption. +replace (S (pred (pred N))) with (pred N). +apply le_pred_n. +apply S_pred with 0%nat. +apply lt_S_n. +replace (S (pred N)) with N. +apply lt_le_trans with 2%nat. +apply lt_n_Sn. +assumption. +apply S_pred with 0%nat; assumption. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply (fun p n m:nat => plus_le_reg_l n m p) with i. +rewrite le_plus_minus_r. +replace (i + 1)%nat with (S i). +replace N with (S (pred N)). +apply le_n_S. +apply le_trans with (pred (pred N)). +assumption. +apply le_pred_n. +symmetry in |- *; apply S_pred with 0%nat; assumption. +apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. +apply le_trans with (pred (pred N)). +assumption. +apply le_trans with (pred N); apply le_pred_n. +apply sum_eq; intros. +replace (i + 0)%nat with i; [ reflexivity | trivial ]. +apply lt_S_n. +replace (S (pred N)) with N. +apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. +apply S_pred with 0%nat; assumption. +inversion H1. +left; reflexivity. +right; apply le_n_S; assumption. +simpl in |- *. +replace (S (pred N)) with N. +reflexivity. +apply S_pred with 0%nat; assumption. +simpl in |- *. +cut ((N - pred N)%nat = 1%nat). +intro; rewrite H2; reflexivity. +rewrite pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +ring. +apply lt_le_S; assumption. +rewrite <- pred_of_minus; apply le_pred_n. +simpl in |- *; symmetry in |- *; apply S_pred with 0%nat; assumption. +inversion H. +left; reflexivity. +right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v index 41815fc20..d29193ad7 100644 --- a/theories/Reals/Cos_plus.v +++ b/theories/Reals/Cos_plus.v @@ -8,1010 +8,1054 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo_def. -Require Cos_rel. -Require Max. -V7only [Import nat_scope.]. Open Local Scope nat_scope. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_def. +Require Import Cos_rel. +Require Import Max. Open Local Scope nat_scope. Open Local Scope R_scope. -Definition Majxy [x,y:R] : nat->R := [n:nat](Rdiv (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (4) (S n))) (INR (fact n))). +Definition Majxy (x y:R) (n:nat) : R := + Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n). -Lemma Majxy_cv_R0 : (x,y:R) (Un_cv (Majxy x y) R0). -Intros. -Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))). -Pose C0 := (pow C (4)). -Cut ``0<C``. -Intro. -Cut ``0<C0``. -Intro. -Assert H1 := (cv_speed_pow_fact C0). -Unfold Un_cv in H1; Unfold R_dist in H1. -Unfold Un_cv; Unfold R_dist; Intros. -Cut ``0<eps/C0``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]]. -Elim (H1 ``eps/C0`` H3); Intros N0 H4. -Exists N0; Intros. -Replace (Majxy x y n) with ``(pow C0 (S n))/(INR (fact n))``. -Simpl. -Apply Rlt_monotony_contra with ``(Rabsolu (/C0))``. -Apply Rabsolu_pos_lt. -Apply Rinv_neq_R0. -Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0). -Rewrite <- Rabsolu_mult. -Unfold Rminus; Rewrite Rmult_Rplus_distr. -Rewrite Ropp_O; Rewrite Rmult_Or. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite (Rabsolu_right ``/C0``). -Rewrite <- (Rmult_sym eps). -Replace ``(pow C0 n)*/(INR (fact n))+0`` with ``(pow C0 n)*/(INR (fact n))-0``; [Idtac | Ring]. -Unfold Rdiv in H4; Apply H4; Assumption. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Assumption. -Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0). -Unfold Majxy. -Unfold C0. -Rewrite pow_mult. -Unfold C; Reflexivity. -Unfold C0; Apply pow_lt; Assumption. -Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C. -Apply RmaxLess1. +Lemma Majxy_cv_R0 : forall x y:R, Un_cv (Majxy x y) 0. +intros. +pose (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). +pose (C0 := C ^ 4). +cut (0 < C). +intro. +cut (0 < C0). +intro. +assert (H1 := cv_speed_pow_fact C0). +unfold Un_cv in H1; unfold R_dist in H1. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / C0); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ] ]. +elim (H1 (eps / C0) H3); intros N0 H4. +exists N0; intros. +replace (Majxy x y n) with (C0 ^ S n / INR (fact n)). +simpl in |- *. +apply Rmult_lt_reg_l with (Rabs (/ C0)). +apply Rabs_pos_lt. +apply Rinv_neq_0_compat. +red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). +rewrite <- Rabs_mult. +unfold Rminus in |- *; rewrite Rmult_plus_distr_l. +rewrite Ropp_0; rewrite Rmult_0_r. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite (Rabs_right (/ C0)). +rewrite <- (Rmult_comm eps). +replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0); + [ idtac | ring ]. +unfold Rdiv in H4; apply H4; assumption. +apply Rle_ge; left; apply Rinv_0_lt_compat; assumption. +red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). +unfold Majxy in |- *. +unfold C0 in |- *. +rewrite pow_mult. +unfold C in |- *; reflexivity. +unfold C0 in |- *; apply pow_lt; assumption. +apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *. +apply RmaxLess1. Qed. -Lemma reste1_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste1 x y N))<=(Majxy x y (pred N))``. -Intros. -Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))). -Unfold Reste1. -Apply Rle_trans with (sum_f_R0 - [k:nat] - (Rabsolu (sum_f_R0 - [l:nat] - ``(pow ( -1) (S (plus l k)))/ - (INR (fact (mult (S (S O)) (S (plus l k)))))* - (pow x (mult (S (S O)) (S (plus l k))))* - (pow ( -1) (minus N l))/ - (INR (fact (mult (S (S O)) (minus N l))))* - (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k)))) - (pred N)). -Apply (sum_Rabsolu [k:nat] - (sum_f_R0 - [l:nat] - ``(pow ( -1) (S (plus l k)))/ - (INR (fact (mult (S (S O)) (S (plus l k)))))* - (pow x (mult (S (S O)) (S (plus l k))))* - (pow ( -1) (minus N l))/ - (INR (fact (mult (S (S O)) (minus N l))))* - (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)). -Apply Rle_trans with (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - (Rabsolu (``(pow ( -1) (S (plus l k)))/ - (INR (fact (mult (S (S O)) (S (plus l k)))))* - (pow x (mult (S (S O)) (S (plus l k))))* - (pow ( -1) (minus N l))/ - (INR (fact (mult (S (S O)) (minus N l))))* - (pow y (mult (S (S O)) (minus N l)))``)) (pred (minus N k))) - (pred N)). -Apply sum_Rle. -Intros. -Apply (sum_Rabsolu [l:nat] - ``(pow ( -1) (S (plus l n)))/ - (INR (fact (mult (S (S O)) (S (plus l n)))))* - (pow x (mult (S (S O)) (S (plus l n))))* - (pow ( -1) (minus N l))/ - (INR (fact (mult (S (S O)) (minus N l))))* - (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N n))). -Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (mult (S (S O)) (S (plus l k)))) (fact (mult (S (S O)) (minus N l)))))*(pow C (mult (S (S O)) (S (plus N k))))`` (pred (minus N k))) (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Unfold Rdiv; Repeat Rewrite Rabsolu_mult. -Do 2 Rewrite pow_1_abs. -Do 2 Rewrite Rmult_1l. -Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (S (plus n0 n)))))``). -Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (minus N n0))))``). -Rewrite mult_INR. -Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Rewrite <- Rmult_assoc. -Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (minus N n0))))``). -Rewrite Rmult_assoc. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Do 2 Rewrite <- Pow_Rabsolu. -Apply Rle_trans with ``(pow (Rabsolu x) (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``. -Apply Rle_monotony. -Apply pow_le; Apply Rabsolu_pos. -Apply pow_incr. -Split. -Apply Rabsolu_pos. -Unfold C. -Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2. -Apply Rle_trans with ``(pow C (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``. -Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S O)) (minus N n0)))``). -Apply Rle_monotony. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Apply pow_incr. -Split. -Apply Rabsolu_pos. -Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)). -Apply RmaxLess1. -Apply RmaxLess2. -Right. -Replace (mult (2) (S (plus N n))) with (plus (mult (2) (minus N n0)) (mult (2) (S (plus n0 n)))). -Rewrite pow_add. -Apply Rmult_sym. -Apply INR_eq; Rewrite plus_INR; Do 3 Rewrite mult_INR. -Rewrite minus_INR. -Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring. -Apply le_trans with (pred (minus N n)). -Exact H1. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_trans with (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - ``/(INR - (mult (fact (mult (S (S O)) (S (plus l k)))) - (fact (mult (S (S O)) (minus N l)))))* - (pow C (mult (S (S (S (S O)))) N))`` (pred (minus N k))) - (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Apply Rle_monotony. -Left; Apply Rlt_Rinv. -Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0. -Apply Rle_pow. -Unfold C; Apply RmaxLess1. -Replace (mult (4) N) with (mult (2) (mult (2) N)); [Idtac | Ring]. -Apply mult_le. -Replace (mult (2) N) with (S (plus N (pred N))). -Apply le_n_S. -Apply le_reg_l; Assumption. -Rewrite pred_of_minus. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Rewrite minus_INR. -Repeat Rewrite S_INR; Ring. -Apply lt_le_S; Assumption. -Apply Rle_trans with (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - ``(pow C (mult (S (S (S (S O)))) N))*(Rsqr (/(INR (fact (S (plus N k))))))`` (pred (minus N k))) - (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``). -Apply Rle_monotony. -Apply pow_le. -Left; Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Replace ``/(INR - (mult (fact (mult (S (S O)) (S (plus n0 n)))) - (fact (mult (S (S O)) (minus N n0)))))`` with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (mult (S (S O)) (S (plus n0 n))))/(INR (fact (mult (S (S O)) (S (plus N n)))))``. -Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (S (plus N n)))/(INR (fact (mult (S (S O)) (S (plus N n)))))``. -Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (plus N n)))))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply C_maj. -Apply mult_le. -Apply le_n_S. -Apply le_reg_r. -Apply le_trans with (pred (minus N n)). -Assumption. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Right. -Unfold Rdiv; Rewrite Rmult_sym. -Unfold Binomial.C. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Replace (minus (mult (2) (S (plus N n))) (S (plus N n))) with (S (plus N n)). -Rewrite Rinv_Rmult. -Unfold Rsqr; Reflexivity. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_eq; Rewrite S_INR; Rewrite minus_INR. -Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_n_2n. -Apply INR_fact_neq_0. -Unfold Rdiv; Rewrite Rmult_sym. -Unfold Binomial.C. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Replace (minus (mult (2) (S (plus N n))) (mult (2) (S (plus n0 n)))) with (mult (2) (minus N n0)). -Rewrite mult_INR. -Reflexivity. -Apply INR_eq; Rewrite minus_INR. -Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR. -Ring. -Apply le_trans with (pred (minus N n)). -Assumption. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply mult_le. -Apply le_n_S. -Apply le_reg_r. -Apply le_trans with (pred (minus N n)). -Assumption. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_fact_neq_0. -Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S N)))*(pow C (mult (S (S (S (S O)))) N))`` (pred N)). -Apply sum_Rle; Intros. -Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) N))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (plus N n))))))``). -Rewrite sum_cte. -Rewrite <- Rmult_assoc. -Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``). -Rewrite Rmult_assoc. -Apply Rle_monotony. -Apply pow_le. -Left; Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Apply Rle_trans with ``(Rsqr (/(INR (fact (S (plus N n))))))*(INR N)``. -Apply Rle_monotony. -Apply pos_Rsqr. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_INR. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony. -Apply pos_INR. -Apply Rle_trans with ``/(INR (fact (S (plus N n))))``. -Pattern 2 ``/(INR (fact (S (plus N n))))``; Rewrite <- Rmult_1r. -Unfold Rsqr. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``. -Apply INR_fact_lt_0. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r. -Replace R1 with (INR (S O)). -Apply le_INR. -Apply lt_le_S. -Apply INR_lt; Apply INR_fact_lt_0. -Reflexivity. -Apply INR_fact_neq_0. -Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``. -Apply INR_fact_lt_0. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with ``(INR (fact (S N)))``. -Apply INR_fact_lt_0. -Rewrite Rmult_1r. -Rewrite (Rmult_sym (INR (fact (S N)))). -Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Apply le_INR. -Apply fact_growing. -Apply le_n_S. -Apply le_plus_l. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Rewrite sum_cte. -Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) N))/(INR (fact (pred N)))``. -Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``). -Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony. -Apply pow_le. -Left; Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Cut (S (pred N)) = N. -Intro; Rewrite H0. -Pattern 2 N; Rewrite <- H0. -Do 2 Rewrite fact_simpl. -Rewrite H0. -Repeat Rewrite mult_INR. -Repeat Rewrite Rinv_Rmult. -Rewrite (Rmult_sym ``/(INR (S N))``). -Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l. -Pattern 2 ``/(INR (fact (pred N)))``; Rewrite <- Rmult_1r. -Rewrite Rmult_assoc. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_monotony_contra with (INR (S N)). -Apply lt_INR_0; Apply lt_O_Sn. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Rewrite Rmult_1l. -Apply le_INR; Apply le_n_Sn. -Apply not_O_INR; Discriminate. -Apply not_O_INR. -Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H). -Apply not_O_INR. -Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H). -Apply INR_fact_neq_0. -Apply not_O_INR; Discriminate. -Apply prod_neq_R0. -Apply not_O_INR. -Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H). -Apply INR_fact_neq_0. -Symmetry; Apply S_pred with O; Assumption. -Right. -Unfold Majxy. -Unfold C. -Replace (S (pred N)) with N. -Reflexivity. -Apply S_pred with O; Assumption. +Lemma reste1_maj : + forall (x y:R) (N:nat), + (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N). +intros. +pose (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). +unfold Reste1 in |- *. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k)))) ( + pred N)). +apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k))) (pred N)). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l)))) (pred (N - k))) ( + pred N)). +apply sum_Rle. +intros. +apply + (Rsum_abs + (fun l:nat => + (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - n))). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * + C ^ (2 * S (N + k))) (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +unfold Rdiv in |- *; repeat rewrite Rabs_mult. +do 2 rewrite pow_1_abs. +do 2 rewrite Rmult_1_l. +rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))). +rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))). +rewrite mult_INR. +rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +do 2 rewrite <- RPow_abs. +apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. +apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). +do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))). +apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess1. +apply RmaxLess2. +right. +replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat. +rewrite pow_add. +apply Rmult_comm. +apply INR_eq; rewrite plus_INR; do 3 rewrite mult_INR. +rewrite minus_INR. +repeat rewrite S_INR; do 2 rewrite plus_INR; ring. +apply le_trans with (pred (N - n)). +exact H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N)) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat. +rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. +apply Rle_pow. +unfold C in |- *; apply RmaxLess1. +replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ]. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (2 * N)%nat with (S (N + pred N)). +apply le_n_S. +apply plus_le_compat_l; assumption. +rewrite pred_of_minus. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + rewrite minus_INR. +repeat rewrite S_INR; ring. +apply lt_le_S; assumption. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k))))) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +rewrite <- (Rmult_comm (C ^ (4 * N))). +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with + (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))). +apply Rle_trans with + (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))). +unfold Rdiv in |- *; + do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply C_maj. +apply (fun m n p:nat => mult_le_compat_l p n m). +apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +right. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)). +rewrite Rinv_mult_distr. +unfold Rsqr in |- *; reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; rewrite S_INR; rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. +apply le_n_2n. +apply INR_fact_neq_0. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat. +rewrite mult_INR. +reflexivity. +apply INR_eq; rewrite minus_INR. +do 3 rewrite mult_INR; repeat rewrite S_INR; do 2 rewrite plus_INR; + rewrite minus_INR. +ring. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply (fun m n p:nat => mult_le_compat_l p n m). +apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)). +apply sum_Rle; intros. +rewrite <- + (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n)) + (Rsqr (/ INR (fact (S (N + n)))))). +rewrite sum_cte. +rewrite <- Rmult_assoc. +do 2 rewrite <- (Rmult_comm (C ^ (4 * N))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N). +apply Rmult_le_compat_l. +apply Rle_0_sqr. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_INR. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. +apply pos_INR. +apply Rle_trans with (/ INR (fact (S (N + n)))). +pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r. +unfold Rsqr in |- *. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (fact (S (N + n)))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +replace 1 with (INR 1). +apply le_INR. +apply lt_le_S. +apply INR_lt; apply INR_fact_lt_0. +reflexivity. +apply INR_fact_neq_0. +apply Rmult_le_reg_l with (INR (fact (S (N + n)))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (fact (S N))). +apply INR_fact_lt_0. +rewrite Rmult_1_r. +rewrite (Rmult_comm (INR (fact (S N)))). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +apply le_INR. +apply fact_le. +apply le_n_S. +apply le_plus_l. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +rewrite sum_cte. +apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))). +rewrite <- (Rmult_comm (C ^ (4 * N))). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +cut (S (pred N) = N). +intro; rewrite H0. +pattern N at 2 in |- *; rewrite <- H0. +do 2 rewrite fact_simpl. +rewrite H0. +repeat rewrite mult_INR. +repeat rewrite Rinv_mult_distr. +rewrite (Rmult_comm (/ INR (S N))). +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r. +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (S N)). +apply lt_INR_0; apply lt_O_Sn. +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rmult_1_l. +apply le_INR; apply le_n_Sn. +apply not_O_INR; discriminate. +apply not_O_INR. +red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). +apply not_O_INR. +red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply prod_neq_R0. +apply not_O_INR. +red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). +apply INR_fact_neq_0. +symmetry in |- *; apply S_pred with 0%nat; assumption. +right. +unfold Majxy in |- *. +unfold C in |- *. +replace (S (pred N)) with N. +reflexivity. +apply S_pred with 0%nat; assumption. Qed. -Lemma reste2_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste2 x y N))<=(Majxy x y N)``. -Intros. -Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))). -Unfold Reste2. -Apply Rle_trans with (sum_f_R0 - [k:nat] - (Rabsolu (sum_f_R0 - [l:nat] - ``(pow ( -1) (S (plus l k)))/ - (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))* - (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))* - (pow ( -1) (minus N l))/ - (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))* - (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k)))) - (pred N)). -Apply (sum_Rabsolu [k:nat] - (sum_f_R0 - [l:nat] - ``(pow ( -1) (S (plus l k)))/ - (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))* - (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))* - (pow ( -1) (minus N l))/ - (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))* - (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)). -Apply Rle_trans with (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - (Rabsolu (``(pow ( -1) (S (plus l k)))/ - (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))* - (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))* - (pow ( -1) (minus N l))/ - (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))* - (pow y (plus (mult (S (S O)) (minus N l)) (S O)))``)) (pred (minus N k))) - (pred N)). -Apply sum_Rle. -Intros. -Apply (sum_Rabsolu [l:nat] - ``(pow ( -1) (S (plus l n)))/ - (INR (fact (plus (mult (S (S O)) (S (plus l n))) (S O))))* - (pow x (plus (mult (S (S O)) (S (plus l n))) (S O)))* - (pow ( -1) (minus N l))/ - (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))* - (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N n))). -Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O))) (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*(pow C (mult (S (S O)) (S (S (plus N k)))))`` (pred (minus N k))) (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Unfold Rdiv; Repeat Rewrite Rabsolu_mult. -Do 2 Rewrite pow_1_abs. -Do 2 Rewrite Rmult_1l. -Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O))))``). -Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``). -Rewrite mult_INR. -Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Rewrite <- Rmult_assoc. -Rewrite <- (Rmult_sym ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``). -Rewrite Rmult_assoc. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Do 2 Rewrite <- Pow_Rabsolu. -Apply Rle_trans with ``(pow (Rabsolu x) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``. -Apply Rle_monotony. -Apply pow_le; Apply Rabsolu_pos. -Apply pow_incr. -Split. -Apply Rabsolu_pos. -Unfold C. -Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2. -Apply Rle_trans with ``(pow C (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``. -Do 2 Rewrite <- (Rmult_sym ``(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``). -Apply Rle_monotony. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Apply pow_incr. -Split. -Apply Rabsolu_pos. -Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)). -Apply RmaxLess1. -Apply RmaxLess2. -Right. -Replace (mult (2) (S (S (plus N n)))) with (plus (plus (mult (2) (minus N n0)) (S O)) (plus (mult (2) (S (plus n0 n))) (S O))). -Repeat Rewrite pow_add. -Ring. -Apply INR_eq; Repeat Rewrite plus_INR; Do 3 Rewrite mult_INR. -Rewrite minus_INR. -Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring. -Apply le_trans with (pred (minus N n)). -Exact H1. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply Rle_sym1; Left; Apply Rlt_Rinv. -Apply INR_fact_lt_0. -Apply Rle_sym1; Left; Apply Rlt_Rinv. -Apply INR_fact_lt_0. -Apply Rle_trans with (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - ``/(INR - (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O))) - (fact (plus (mult (S (S O)) (minus N l)) (S O)))))* - (pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N k))) - (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Apply Rle_monotony. -Left; Apply Rlt_Rinv. -Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0. -Apply Rle_pow. -Unfold C; Apply RmaxLess1. -Replace (mult (4) (S N)) with (mult (2) (mult (2) (S N))); [Idtac | Ring]. -Apply mult_le. -Replace (mult (2) (S N)) with (S (S (plus N N))). -Repeat Apply le_n_S. -Apply le_reg_l. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_eq; Do 2Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR. -Repeat Rewrite S_INR; Ring. -Apply Rle_trans with (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - ``(pow C (mult (S (S (S (S O)))) (S N)))*(Rsqr (/(INR (fact (S (S (plus N k)))))))`` (pred (minus N k))) - (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``). -Apply Rle_monotony. -Apply pow_le. -Left; Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Replace ``/(INR - (mult (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O))) - (fact (plus (mult (S (S O)) (minus N n0)) (S O)))))`` with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``. -Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (S (S (plus N n))))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``. -Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply C_maj. -Apply le_trans with (mult (2) (S (S (plus n0 n)))). -Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))). -Apply le_n_Sn. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring. -Apply mult_le. -Repeat Apply le_n_S. -Apply le_reg_r. -Apply le_trans with (pred (minus N n)). -Assumption. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Right. -Unfold Rdiv; Rewrite Rmult_sym. -Unfold Binomial.C. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Replace (minus (mult (2) (S (S (plus N n)))) (S (S (plus N n)))) with (S (S (plus N n))). -Rewrite Rinv_Rmult. -Unfold Rsqr; Reflexivity. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_eq; Do 2 Rewrite S_INR; Rewrite minus_INR. -Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_n_2n. -Apply INR_fact_neq_0. -Unfold Rdiv; Rewrite Rmult_sym. -Unfold Binomial.C. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Replace (minus (mult (2) (S (S (plus N n)))) (plus (mult (2) (S (plus n0 n))) (S O))) with (plus (mult (2) (minus N n0)) (S O)). -Rewrite mult_INR. -Reflexivity. -Apply INR_eq; Rewrite minus_INR. -Do 2 Rewrite plus_INR; Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR. -Ring. -Apply le_trans with (pred (minus N n)). -Assumption. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_trans with (mult (2) (S (S (plus n0 n)))). -Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))). -Apply le_n_Sn. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring. -Apply mult_le. -Repeat Apply le_n_S. -Apply le_reg_r. -Apply le_trans with (pred (minus N n)). -Assumption. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply INR_fact_neq_0. -Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S (S N))))*(pow C (mult (S (S (S (S O)))) (S N)))`` (pred N)). -Apply sum_Rle; Intros. -Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (S (plus N n)))))))``). -Rewrite sum_cte. -Rewrite <- Rmult_assoc. -Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``). -Rewrite Rmult_assoc. -Apply Rle_monotony. -Apply pow_le. -Left; Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Apply Rle_trans with ``(Rsqr (/(INR (fact (S (S (plus N n)))))))*(INR N)``. -Apply Rle_monotony. -Apply pos_Rsqr. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_INR. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n O) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Assumption. -Apply lt_pred_n_n; Assumption. -Apply le_trans with (pred N). -Assumption. -Apply le_pred_n. -Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony. -Apply pos_INR. -Apply Rle_trans with ``/(INR (fact (S (S (plus N n)))))``. -Pattern 2 ``/(INR (fact (S (S (plus N n)))))``; Rewrite <- Rmult_1r. -Unfold Rsqr. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``. -Apply INR_fact_lt_0. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r. -Replace R1 with (INR (S O)). -Apply le_INR. -Apply lt_le_S. -Apply INR_lt; Apply INR_fact_lt_0. -Reflexivity. -Apply INR_fact_neq_0. -Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``. -Apply INR_fact_lt_0. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with ``(INR (fact (S (S N))))``. -Apply INR_fact_lt_0. -Rewrite Rmult_1r. -Rewrite (Rmult_sym (INR (fact (S (S N))))). -Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Apply le_INR. -Apply fact_growing. -Repeat Apply le_n_S. -Apply le_plus_l. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Rewrite sum_cte. -Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) (S N)))/(INR (fact N))``. -Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``). -Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony. -Apply pow_le. -Left; Apply Rlt_le_trans with R1. -Apply Rlt_R0_R1. -Unfold C; Apply RmaxLess1. -Cut (S (pred N)) = N. -Intro; Rewrite H0. -Do 2 Rewrite fact_simpl. -Repeat Rewrite mult_INR. -Repeat Rewrite Rinv_Rmult. -Apply Rle_trans with ``(INR (S (S N)))*(/(INR (S (S N)))*(/(INR (S N))*/(INR (fact N))))* - (INR N)``. -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym (INR N)). -Rewrite (Rmult_sym (INR (S (S N)))). -Apply Rle_monotony. -Repeat Apply Rmult_le_pos. -Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn. -Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn. -Left; Apply Rlt_Rinv. -Apply INR_fact_lt_0. -Apply pos_INR. -Apply le_INR. -Apply le_trans with (S N); Apply le_n_Sn. -Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l. -Apply Rle_trans with ``/(INR (S N))*/(INR (fact N))*(INR (S N))``. -Repeat Rewrite Rmult_assoc. -Repeat Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply le_INR; Apply le_n_Sn. -Rewrite (Rmult_sym ``/(INR (S N))``). -Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Right; Reflexivity. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Discriminate. -Apply INR_fact_neq_0. -Apply not_O_INR; Discriminate. -Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0]. -Symmetry; Apply S_pred with O; Assumption. -Right. -Unfold Majxy. -Unfold C. -Reflexivity. +Lemma reste2_maj : + forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N. +intros. +pose (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). +unfold Reste2 in |- *. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k)))) ( + pred N)). +apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k))) ( + pred N)). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1))) (pred (N - k))) ( + pred N)). +apply sum_Rle. +intros. +apply + (Rsum_abs + (fun l:nat => + (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) * + x ^ (2 * S (l + n) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - n))). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * + C ^ (2 * S (S (N + k)))) (pred (N - k))) ( + pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +unfold Rdiv in |- *; repeat rewrite Rabs_mult. +do 2 rewrite pow_1_abs. +do 2 rewrite Rmult_1_l. +rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))). +rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))). +rewrite mult_INR. +rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +do 2 rewrite <- RPow_abs. +apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. +apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). +do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))). +apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply pow_incr. +split. +apply Rabs_pos. +unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess1. +apply RmaxLess2. +right. +replace (2 * S (S (N + n)))%nat with + (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat. +repeat rewrite pow_add. +ring. +apply INR_eq; repeat rewrite plus_INR; do 3 rewrite mult_INR. +rewrite minus_INR. +repeat rewrite S_INR; do 2 rewrite plus_INR; ring. +apply le_trans with (pred (N - n)). +exact H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rle_ge; left; apply Rinv_0_lt_compat. +apply INR_fact_lt_0. +apply Rle_ge; left; apply Rinv_0_lt_compat. +apply INR_fact_lt_0. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * + C ^ (4 * S N)) (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat. +rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. +apply Rle_pow. +unfold C in |- *; apply RmaxLess1. +replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ]. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (2 * S N)%nat with (S (S (N + N))). +repeat apply le_n_S. +apply plus_le_compat_l. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_eq; do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR. +repeat rewrite S_INR; ring. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k)))))) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +rewrite <- (Rmult_comm (C ^ (4 * S N))). +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with + (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) / + INR (fact (2 * S (S (N + n))))). +apply Rle_trans with + (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) / + INR (fact (2 * S (S (N + n))))). +unfold Rdiv in |- *; + do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply C_maj. +apply le_trans with (2 * S (S (n0 + n)))%nat. +replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). +apply le_n_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; rewrite plus_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m). +repeat apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +right. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))). +rewrite Rinv_mult_distr. +unfold Rsqr in |- *; reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; do 2 rewrite S_INR; rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. +apply le_n_2n. +apply INR_fact_neq_0. +unfold Rdiv in |- *; rewrite Rmult_comm. +unfold Binomial.C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with + (2 * (N - n0) + 1)%nat. +rewrite mult_INR. +reflexivity. +apply INR_eq; rewrite minus_INR. +do 2 rewrite plus_INR; do 3 rewrite mult_INR; repeat rewrite S_INR; + do 2 rewrite plus_INR; rewrite minus_INR. +ring. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_trans with (2 * S (S (n0 + n)))%nat. +replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). +apply le_n_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; rewrite plus_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m). +repeat apply le_n_S. +apply plus_le_compat_r. +apply le_trans with (pred (N - n)). +assumption. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply INR_fact_neq_0. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N)) + (pred N)). +apply sum_Rle; intros. +rewrite <- + (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n)) + (Rsqr (/ INR (fact (S (S (N + n))))))). +rewrite sum_cte. +rewrite <- Rmult_assoc. +do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N). +apply Rmult_le_compat_l. +apply Rle_0_sqr. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_INR. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +assumption. +apply lt_pred_n_n; assumption. +apply le_trans with (pred N). +assumption. +apply le_pred_n. +rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. +apply pos_INR. +apply Rle_trans with (/ INR (fact (S (S (N + n))))). +pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r. +unfold Rsqr in |- *. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +replace 1 with (INR 1). +apply le_INR. +apply lt_le_S. +apply INR_lt; apply INR_fact_lt_0. +reflexivity. +apply INR_fact_neq_0. +apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with (INR (fact (S (S N)))). +apply INR_fact_lt_0. +rewrite Rmult_1_r. +rewrite (Rmult_comm (INR (fact (S (S N))))). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +apply le_INR. +apply fact_le. +repeat apply le_n_S. +apply le_plus_l. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +rewrite sum_cte. +apply Rle_trans with (C ^ (4 * S N) / INR (fact N)). +rewrite <- (Rmult_comm (C ^ (4 * S N))). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le. +left; apply Rlt_le_trans with 1. +apply Rlt_0_1. +unfold C in |- *; apply RmaxLess1. +cut (S (pred N) = N). +intro; rewrite H0. +do 2 rewrite fact_simpl. +repeat rewrite mult_INR. +repeat rewrite Rinv_mult_distr. +apply Rle_trans with + (INR (S (S N)) * (/ INR (S (S N)) * (/ INR (S N) * / INR (fact N))) * INR N). +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (INR N)). +rewrite (Rmult_comm (INR (S (S N)))). +apply Rmult_le_compat_l. +repeat apply Rmult_le_pos. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +left; apply Rinv_0_lt_compat. +apply INR_fact_lt_0. +apply pos_INR. +apply le_INR. +apply le_trans with (S N); apply le_n_Sn. +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)). +repeat rewrite Rmult_assoc. +repeat apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply le_INR; apply le_n_Sn. +rewrite (Rmult_comm (/ INR (S N))). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; right; reflexivity. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +symmetry in |- *; apply S_pred with 0%nat; assumption. +right. +unfold Majxy in |- *. +unfold C in |- *. +reflexivity. Qed. -Lemma reste1_cv_R0 : (x,y:R) (Un_cv (Reste1 x y) R0). -Intros. -Assert H := (Majxy_cv_R0 x y). -Unfold Un_cv in H; Unfold R_dist in H. -Unfold Un_cv; Unfold R_dist; Intros. -Elim (H eps H0); Intros N0 H1. -Exists (S N0); Intros. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or. -Apply Rle_lt_trans with (Rabsolu (Majxy x y (pred n))). -Rewrite (Rabsolu_right (Majxy x y (pred n))). -Apply reste1_maj. -Apply lt_le_trans with (S N0). -Apply lt_O_Sn. -Assumption. -Apply Rle_sym1. -Unfold Majxy. -Unfold Rdiv; Apply Rmult_le_pos. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Apply RmaxLess1. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Replace (Majxy x y (pred n)) with ``(Majxy x y (pred n))-0``; [Idtac | Ring]. -Apply H1. -Unfold ge; Apply le_S_n. -Replace (S (pred n)) with n. -Assumption. -Apply S_pred with O. -Apply lt_le_trans with (S N0); [Apply lt_O_Sn | Assumption]. +Lemma reste1_cv_R0 : forall x y:R, Un_cv (Reste1 x y) 0. +intros. +assert (H := Majxy_cv_R0 x y). +unfold Un_cv in H; unfold R_dist in H. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros N0 H1. +exists (S N0); intros. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. +apply Rle_lt_trans with (Rabs (Majxy x y (pred n))). +rewrite (Rabs_right (Majxy x y (pred n))). +apply reste1_maj. +apply lt_le_trans with (S N0). +apply lt_O_Sn. +assumption. +apply Rle_ge. +unfold Majxy in |- *. +unfold Rdiv in |- *; apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ]. +apply H1. +unfold ge in |- *; apply le_S_n. +replace (S (pred n)) with n. +assumption. +apply S_pred with 0%nat. +apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ]. Qed. -Lemma reste2_cv_R0 : (x,y:R) (Un_cv (Reste2 x y) R0). -Intros. -Assert H := (Majxy_cv_R0 x y). -Unfold Un_cv in H; Unfold R_dist in H. -Unfold Un_cv; Unfold R_dist; Intros. -Elim (H eps H0); Intros N0 H1. -Exists (S N0); Intros. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or. -Apply Rle_lt_trans with (Rabsolu (Majxy x y n)). -Rewrite (Rabsolu_right (Majxy x y n)). -Apply reste2_maj. -Apply lt_le_trans with (S N0). -Apply lt_O_Sn. -Assumption. -Apply Rle_sym1. -Unfold Majxy. -Unfold Rdiv; Apply Rmult_le_pos. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Apply RmaxLess1. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Replace (Majxy x y n) with ``(Majxy x y n)-0``; [Idtac | Ring]. -Apply H1. -Unfold ge; Apply le_trans with (S N0). -Apply le_n_Sn. -Exact H2. +Lemma reste2_cv_R0 : forall x y:R, Un_cv (Reste2 x y) 0. +intros. +assert (H := Majxy_cv_R0 x y). +unfold Un_cv in H; unfold R_dist in H. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros N0 H1. +exists (S N0); intros. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. +apply Rle_lt_trans with (Rabs (Majxy x y n)). +rewrite (Rabs_right (Majxy x y n)). +apply reste2_maj. +apply lt_le_trans with (S N0). +apply lt_O_Sn. +assumption. +apply Rle_ge. +unfold Majxy in |- *. +unfold Rdiv in |- *; apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ]. +apply H1. +unfold ge in |- *; apply le_trans with (S N0). +apply le_n_Sn. +exact H2. Qed. -Lemma reste_cv_R0 : (x,y:R) (Un_cv (Reste x y) R0). -Intros. -Unfold Reste. -Pose An := [n:nat](Reste2 x y n). -Pose Bn := [n:nat](Reste1 x y (S n)). -Cut (Un_cv [n:nat]``(An n)-(Bn n)`` ``0-0``) -> (Un_cv [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))`` ``0``). -Intro. -Apply H. -Apply CV_minus. -Unfold An. -Replace [n:nat](Reste2 x y n) with (Reste2 x y). -Apply reste2_cv_R0. -Reflexivity. -Unfold Bn. -Assert H0 := (reste1_cv_R0 x y). -Unfold Un_cv in H0; Unfold R_dist in H0. -Unfold Un_cv; Unfold R_dist; Intros. -Elim (H0 eps H1); Intros N0 H2. -Exists N0; Intros. -Apply H2. -Unfold ge; Apply le_trans with (S N0). -Apply le_n_Sn. -Apply le_n_S; Assumption. -Unfold An Bn. -Intro. -Replace R0 with ``0-0``; [Idtac | Ring]. -Exact H. +Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0. +intros. +unfold Reste in |- *. +pose (An := fun n:nat => Reste2 x y n). +pose (Bn := fun n:nat => Reste1 x y (S n)). +cut + (Un_cv (fun n:nat => An n - Bn n) (0 - 0) -> + Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0). +intro. +apply H. +apply CV_minus. +unfold An in |- *. +replace (fun n:nat => Reste2 x y n) with (Reste2 x y). +apply reste2_cv_R0. +reflexivity. +unfold Bn in |- *. +assert (H0 := reste1_cv_R0 x y). +unfold Un_cv in H0; unfold R_dist in H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H0 eps H1); intros N0 H2. +exists N0; intros. +apply H2. +unfold ge in |- *; apply le_trans with (S N0). +apply le_n_Sn. +apply le_n_S; assumption. +unfold An, Bn in |- *. +intro. +replace 0 with (0 - 0); [ idtac | ring ]. +exact H. Qed. -Theorem cos_plus : (x,y:R) ``(cos (x+y))==(cos x)*(cos y)-(sin x)*(sin y)``. -Intros. -Cut (Un_cv (C1 x y) ``(cos x)*(cos y)-(sin x)*(sin y)``). -Cut (Un_cv (C1 x y) ``(cos (x+y))``). -Intros. -Apply UL_sequence with (C1 x y); Assumption. -Apply C1_cvg. -Unfold Un_cv; Unfold R_dist. -Intros. -Assert H0 := (A1_cvg x). -Assert H1 := (A1_cvg y). -Assert H2 := (B1_cvg x). -Assert H3 := (B1_cvg y). -Assert H4 := (CV_mult ? ? ? ? H0 H1). -Assert H5 := (CV_mult ? ? ? ? H2 H3). -Assert H6 := (reste_cv_R0 x y). -Unfold Un_cv in H4; Unfold Un_cv in H5; Unfold Un_cv in H6. -Unfold R_dist in H4; Unfold R_dist in H5; Unfold R_dist in H6. -Cut ``0<eps/3``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H4 ``eps/3`` H7); Intros N1 H8. -Elim (H5 ``eps/3`` H7); Intros N2 H9. -Elim (H6 ``eps/3`` H7); Intros N3 H10. -Pose N := (S (S (max (max N1 N2) N3))). -Exists N. -Intros. -Cut n = (S (pred n)). -Intro; Rewrite H12. -Rewrite <- cos_plus_form. -Rewrite <- H12. -Apply Rle_lt_trans with ``(Rabsolu ((A1 x n)*(A1 y n)-(cos x)*(cos y)))+(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n))))``. -Replace ``(A1 x n)*(A1 y n)-(B1 x (pred n))*(B1 y (pred n))+ - (Reste x y (pred n))-((cos x)*(cos y)-(sin x)*(sin y))`` with ``((A1 x n)*(A1 y n)-(cos x)*(cos y))+((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n)))``; [Apply Rabsolu_triang | Ring]. -Replace ``eps`` with ``eps/3+(eps/3+eps/3)``. -Apply Rplus_lt. -Apply H8. -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). -Apply le_max_l. -Apply le_trans with (S (max (max N1 N2) N3)); Apply le_n_Sn. -Assumption. -Apply Rle_lt_trans with ``(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))))+(Rabsolu (Reste x y (pred n)))``. -Apply Rabsolu_triang. -Apply Rplus_lt. -Rewrite <- Rabsolu_Ropp. -Rewrite Ropp_distr2. -Apply H9. -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. -Apply le_n_S. -Apply le_trans with (max (max N1 N2) N3). -Apply le_max_l. -Apply le_n_Sn. -Assumption. -Replace (Reste x y (pred n)) with ``(Reste x y (pred n))-0``. -Apply H10. -Unfold ge. -Apply le_S_n. -Rewrite <- H12. -Apply le_trans with N. -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 4 eps; Replace eps with ``3*eps/3``. -Ring. -Unfold Rdiv. -Rewrite <- Rmult_assoc. -Apply Rinv_r_simpl_m. -DiscrR. -Apply lt_le_trans with (pred N). -Unfold N; Simpl; Apply lt_O_Sn. -Apply le_S_n. -Rewrite <- H12. -Replace (S (pred N)) with N. -Assumption. -Unfold N; Simpl; Reflexivity. -Cut (lt O N). -Intro. -Cut (lt O n). -Intro. -Apply S_pred with O; Assumption. -Apply lt_le_trans with N; Assumption. -Unfold N; Apply lt_O_Sn. -Qed. +Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y. +intros. +cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). +cut (Un_cv (C1 x y) (cos (x + y))). +intros. +apply UL_sequence with (C1 x y); assumption. +apply C1_cvg. +unfold Un_cv in |- *; unfold R_dist in |- *. +intros. +assert (H0 := A1_cvg x). +assert (H1 := A1_cvg y). +assert (H2 := B1_cvg x). +assert (H3 := B1_cvg y). +assert (H4 := CV_mult _ _ _ _ H0 H1). +assert (H5 := CV_mult _ _ _ _ H2 H3). +assert (H6 := reste_cv_R0 x y). +unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6. +unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6. +cut (0 < eps / 3); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H4 (eps / 3) H7); intros N1 H8. +elim (H5 (eps / 3) H7); intros N2 H9. +elim (H6 (eps / 3) H7); intros N3 H10. +pose (N := S (S (max (max N1 N2) N3))). +exists N. +intros. +cut (n = S (pred n)). +intro; rewrite H12. +rewrite <- cos_plus_form. +rewrite <- H12. +apply Rle_lt_trans with + (Rabs (A1 x n * A1 y n - cos x * cos y) + + Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). +replace + (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) - + (cos x * cos y - sin x * sin y)) with + (A1 x n * A1 y n - cos x * cos y + + (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 3 + (eps / 3 + eps / 3)). +apply Rplus_lt_compat. +apply H8. +unfold ge in |- *; apply le_trans with N. +unfold N in |- *. +apply le_trans with (max N1 N2). +apply le_max_l. +apply le_trans with (max (max N1 N2) N3). +apply le_max_l. +apply le_trans with (S (max (max N1 N2) N3)); apply le_n_Sn. +assumption. +apply Rle_lt_trans with + (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) + + Rabs (Reste x y (pred n))). +apply Rabs_triang. +apply Rplus_lt_compat. +rewrite <- Rabs_Ropp. +rewrite Ropp_minus_distr. +apply H9. +unfold ge in |- *; apply le_trans with (max N1 N2). +apply le_max_r. +apply le_S_n. +rewrite <- H12. +apply le_trans with N. +unfold N in |- *. +apply le_n_S. +apply le_trans with (max (max N1 N2) N3). +apply le_max_l. +apply le_n_Sn. +assumption. +replace (Reste x y (pred n)) with (Reste x y (pred n) - 0). +apply H10. +unfold ge in |- *. +apply le_S_n. +rewrite <- H12. +apply le_trans with N. +unfold N in |- *. +apply le_n_S. +apply le_trans with (max (max N1 N2) N3). +apply le_max_r. +apply le_n_Sn. +assumption. +ring. +pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). +ring. +unfold Rdiv in |- *. +rewrite <- Rmult_assoc. +apply Rinv_r_simpl_m. +discrR. +apply lt_le_trans with (pred N). +unfold N in |- *; simpl in |- *; apply lt_O_Sn. +apply le_S_n. +rewrite <- H12. +replace (S (pred N)) with N. +assumption. +unfold N in |- *; simpl in |- *; reflexivity. +cut (0 < N)%nat. +intro. +cut (0 < n)%nat. +intro. +apply S_pred with 0%nat; assumption. +apply lt_le_trans with N; assumption. +unfold N in |- *; apply lt_O_Sn. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v index 0bc58169c..5e9d26001 100644 --- a/theories/Reals/Cos_rel.v +++ b/theories/Reals/Cos_rel.v @@ -8,353 +8,413 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo_def. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_def. Open Local Scope R_scope. -Definition A1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))`` N). +Definition A1 (x:R) (N:nat) : R := + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N. -Definition B1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))`` N). +Definition B1 (x:R) (N:nat) : R := + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) + N. -Definition C1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))`` N). +Definition C1 (x y:R) (N:nat) : R := + sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) N. -Definition Reste1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (mult (S (S O)) (S (plus l k)))))*(pow x (mult (S (S O)) (S (plus l k))))*(pow (-1) (minus N l))/(INR (fact (mult (S (S O)) (minus N l))))*(pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)). +Definition Reste1 (x y:R) (N:nat) : R := + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k))) (pred N). -Definition Reste2 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*(pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*(pow (-1) (minus N l))/(INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*(pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)). +Definition Reste2 (x y:R) (N:nat) : R := + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k))) ( + pred N). -Definition Reste [x,y:R] : nat -> R := [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))``. +Definition Reste (x y:R) (N:nat) : R := Reste2 x y N - Reste1 x y (S N). (* Here is the main result that will be used to prove that (cos (x+y))=(cos x)(cos y)-(sin x)(sin y) *) -Theorem cos_plus_form : (x,y:R;n:nat) (lt O n) -> ``(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. -Rewrite (cauchy_finite [k:nat] - ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))* - (pow x (mult (S (S O)) k))`` [k:nat] - ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))* - (pow y (mult (S (S O)) k))`` (S n)). -Rewrite (cauchy_finite [k:nat] - ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))* - (pow x (plus (mult (S (S O)) k) (S O)))`` [k:nat] - ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))* - (pow y (plus (mult (S (S O)) k) (S O)))`` n H). -Unfold Reste. -Replace (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - ``(pow ( -1) (S (plus l k)))/ - (INR (fact (mult (S (S O)) (S (plus l k)))))* - (pow x (mult (S (S O)) (S (plus l k))))* - ((pow ( -1) (minus (S n) l))/ - (INR (fact (mult (S (S O)) (minus (S n) l))))* - (pow y (mult (S (S O)) (minus (S n) l))))`` - (pred (minus (S n) k))) (pred (S n))) with (Reste1 x y (S n)). -Replace (sum_f_R0 - [k:nat] - (sum_f_R0 - [l:nat] - ``(pow ( -1) (S (plus l k)))/ - (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))* - (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))* - ((pow ( -1) (minus n l))/ - (INR (fact (plus (mult (S (S O)) (minus n l)) (S O))))* - (pow y (plus (mult (S (S O)) (minus n l)) (S O))))`` - (pred (minus n k))) (pred n)) with (Reste2 x y n). -Ring. -Replace (sum_f_R0 - [k:nat] - (sum_f_R0 - [p:nat] - ``(pow ( -1) p)/(INR (fact (mult (S (S O)) p)))* - (pow x (mult (S (S O)) p))*((pow ( -1) (minus k p))/ - (INR (fact (mult (S (S O)) (minus k p))))* - (pow y (mult (S (S O)) (minus k p))))`` k) (S n)) with (sum_f_R0 [k:nat](Rmult ``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) k) (mult (S (S O)) l))*(pow x (mult (S (S O)) l))*(pow y (mult (S (S O)) (minus k l)))`` k)) (S n)). -Pose sin_nnn := [n:nat]Cases n of O => R0 | (S p) => (Rmult ``(pow (-1) (S p))/(INR (fact (mult (S (S O)) (S p))))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) (S p)) (S (mult (S (S O)) l)))*(pow x (S (mult (S (S O)) l)))*(pow y (S (mult (S (S O)) (minus p l))))`` p)) end. -Replace (Ropp (sum_f_R0 - [k:nat] - (sum_f_R0 - [p:nat] - ``(pow ( -1) p)/ - (INR (fact (plus (mult (S (S O)) p) (S O))))* - (pow x (plus (mult (S (S O)) p) (S O)))* - ((pow ( -1) (minus k p))/ - (INR (fact (plus (mult (S (S O)) (minus k p)) (S O))))* - (pow y (plus (mult (S (S O)) (minus k p)) (S O))))`` k) - n)) with (sum_f_R0 sin_nnn (S n)). -Rewrite <- sum_plus. -Unfold C1. -Apply sum_eq; Intros. -Induction i. -Simpl. -Rewrite Rplus_Ol. -Replace (C O O) with R1. -Unfold Rdiv; Rewrite Rinv_R1. -Ring. -Unfold C. -Rewrite <- minus_n_n. -Simpl. -Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rinv_R1; Ring. -Unfold sin_nnn. -Rewrite <- Rmult_Rplus_distr. -Apply Rmult_mult_r. -Rewrite binomial. -Pose Wn := [i0:nat]``(C (mult (S (S O)) (S i)) i0)*(pow x i0)* - (pow y (minus (mult (S (S O)) (S i)) i0))``. -Replace (sum_f_R0 - [l:nat] - ``(C (mult (S (S O)) (S i)) (mult (S (S O)) l))* - (pow x (mult (S (S O)) l))* - (pow y (mult (S (S O)) (minus (S i) l)))`` (S i)) with (sum_f_R0 [l:nat](Wn (mult (2) l)) (S i)). -Replace (sum_f_R0 - [l:nat] - ``(C (mult (S (S O)) (S i)) (S (mult (S (S O)) l)))* - (pow x (S (mult (S (S O)) l)))* - (pow y (S (mult (S (S O)) (minus i l))))`` i) with (sum_f_R0 [l:nat](Wn (S (mult (2) l))) i). -Rewrite Rplus_sym. -Apply sum_decomposition. -Apply sum_eq; Intros. -Unfold Wn. -Apply Rmult_mult_r. -Replace (minus (mult (2) (S i)) (S (mult (2) i0))) with (S (mult (2) (minus i i0))). -Reflexivity. -Apply INR_eq. -Rewrite S_INR; Rewrite mult_INR. -Repeat Rewrite minus_INR. -Rewrite mult_INR; Repeat Rewrite S_INR. -Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Replace (mult (2) (S i)) with (S (S (mult (2) i))). -Apply le_n_S. -Apply le_trans with (mult (2) i). -Apply mult_le; Assumption. -Apply le_n_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Assumption. -Apply sum_eq; Intros. -Unfold Wn. -Apply Rmult_mult_r. -Replace (minus (mult (2) (S i)) (mult (2) i0)) with (mult (2) (minus (S i) i0)). -Reflexivity. -Apply INR_eq. -Rewrite mult_INR. -Repeat Rewrite minus_INR. -Rewrite mult_INR; Repeat Rewrite S_INR. -Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply mult_le; Assumption. -Assumption. -Rewrite <- (Ropp_Ropp (sum_f_R0 sin_nnn (S n))). -Apply eq_Ropp. -Replace ``-(sum_f_R0 sin_nnn (S n))`` with ``-1*(sum_f_R0 sin_nnn (S n))``; [Idtac | Ring]. -Rewrite scal_sum. -Rewrite decomp_sum. -Replace (sin_nnn O) with R0. -Rewrite Rmult_Ol; Rewrite Rplus_Ol. -Replace (pred (S n)) with n; [Idtac | Reflexivity]. -Apply sum_eq; Intros. -Rewrite Rmult_sym. -Unfold sin_nnn. -Rewrite scal_sum. -Rewrite scal_sum. -Apply sum_eq; Intros. -Unfold Rdiv. -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``). -Repeat Rewrite <- Rmult_assoc. -Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``). -Repeat Rewrite <- Rmult_assoc. -Replace ``/(INR (fact (mult (S (S O)) (S i))))* - (C (mult (S (S O)) (S i)) (S (mult (S (S O)) i0)))`` with ``/(INR (fact (plus (mult (S (S O)) i0) (S O))))*/(INR (fact (plus (mult (S (S O)) (minus i i0)) (S O))))``. -Replace (S (mult (2) i0)) with (plus (mult (2) i0) (1)); [Idtac | Ring]. -Replace (S (mult (2) (minus i i0))) with (plus (mult (2) (minus i i0)) (1)); [Idtac | Ring]. -Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i0)*(pow (-1) (minus i i0))``. -Ring. -Simpl. -Pattern 2 i; Replace i with (plus i0 (minus i i0)). -Rewrite pow_add. -Ring. -Symmetry; Apply le_plus_minus; Assumption. -Unfold C. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite Rinv_Rmult. -Replace (S (mult (S (S O)) i0)) with (plus (mult (2) i0) (1)); [Apply Rmult_mult_r | Ring]. -Replace (minus (mult (2) (S i)) (plus (mult (2) i0) (1))) with (plus (mult (2) (minus i i0)) (1)). -Reflexivity. -Apply INR_eq. -Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite minus_INR. -Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Replace (plus (mult (2) i0) (1)) with (S (mult (2) i0)). -Replace (mult (2) (S i)) with (S (S (mult (2) i))). -Apply le_n_S. -Apply le_trans with (mult (2) i). -Apply mult_le; Assumption. -Apply le_n_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Assumption. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Reflexivity. -Apply lt_O_Sn. -Apply sum_eq; Intros. -Rewrite scal_sum. -Apply sum_eq; Intros. -Unfold Rdiv. -Repeat Rewrite <- Rmult_assoc. -Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) i)))``). -Repeat Rewrite <- Rmult_assoc. -Replace ``/(INR (fact (mult (S (S O)) i)))* - (C (mult (S (S O)) i) (mult (S (S O)) i0))`` with ``/(INR (fact (mult (S (S O)) i0)))*/(INR (fact (mult (S (S O)) (minus i i0))))``. -Replace ``(pow (-1) i)`` with ``(pow (-1) i0)*(pow (-1) (minus i i0))``. -Ring. -Pattern 2 i; Replace i with (plus i0 (minus i i0)). -Rewrite pow_add. -Ring. -Symmetry; Apply le_plus_minus; Assumption. -Unfold C. -Unfold Rdiv; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Rewrite Rinv_Rmult. -Replace (minus (mult (2) i) (mult (2) i0)) with (mult (2) (minus i i0)). -Reflexivity. -Apply INR_eq. -Rewrite mult_INR; Repeat Rewrite minus_INR. -Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply mult_le; Assumption. -Assumption. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Unfold Reste2; Apply sum_eq; Intros. -Apply sum_eq; Intros. -Unfold Rdiv; Ring. -Unfold Reste1; Apply sum_eq; Intros. -Apply sum_eq; Intros. -Unfold Rdiv; Ring. -Apply lt_O_Sn. +Theorem cos_plus_form : + forall (x y:R) (n:nat), + (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 |- *. +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)) ( + S n)). +rewrite + (cauchy_finite + (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 |- *. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (S n - l) / INR (fact (2 * (S n - l))) * + y ^ (2 * (S n - l)))) (pred (S n - k))) ( + pred (S n))) with (Reste1 x y (S n)). +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) * + y ^ (2 * (n - l) + 1))) (pred (n - k))) ( + pred n)) with (Reste2 x y n). +ring. +replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p)) * x ^ (2 * p) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p))) * y ^ (2 * (k - p)))) + k) (S n)) with + (sum_f_R0 + (fun k:nat => + (-1) ^ k / INR (fact (2 * k)) * + sum_f_R0 + (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k) + (S n)). +pose + (sin_nnn := + fun n:nat => + match n with + | O => 0 + | S p => + (-1) ^ S p / INR (fact (2 * S p)) * + sum_f_R0 + (fun l:nat => + C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p + end). +replace + (- + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * + y ^ (2 * (k - p) + 1))) k) n) with (sum_f_R0 sin_nnn (S n)). +rewrite <- sum_plus. +unfold C1 in |- *. +apply sum_eq; intros. +induction i as [| i Hreci]. +simpl in |- *. +rewrite Rplus_0_l. +replace (C 0 0) with 1. +unfold Rdiv in |- *; rewrite Rinv_1. +ring. +unfold C in |- *. +rewrite <- minus_n_n. +simpl in |- *. +unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rinv_1; ring. +unfold sin_nnn in |- *. +rewrite <- Rmult_plus_distr_l. +apply Rmult_eq_compat_l. +rewrite binomial. +pose (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). +replace + (sum_f_R0 + (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l))) + (S i)) with (sum_f_R0 (fun l:nat => Wn (2 * l)%nat) (S i)). +replace + (sum_f_R0 + (fun l:nat => + C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with + (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i). +rewrite Rplus_comm. +apply sum_decomposition. +apply sum_eq; intros. +unfold Wn in |- *. +apply Rmult_eq_compat_l. +replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))). +reflexivity. +apply INR_eq. +rewrite S_INR; rewrite mult_INR. +repeat rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR. +rewrite mult_INR; repeat rewrite S_INR; ring. +replace (2 * S i)%nat with (S (S (2 * i))). +apply le_n_S. +apply le_trans with (2 * i)%nat. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +assumption. +apply sum_eq; intros. +unfold Wn in |- *. +apply Rmult_eq_compat_l. +replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat. +reflexivity. +apply INR_eq. +rewrite mult_INR. +repeat rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR. +rewrite mult_INR; repeat rewrite S_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +assumption. +rewrite <- (Ropp_involutive (sum_f_R0 sin_nnn (S n))). +apply Ropp_eq_compat. +replace (- sum_f_R0 sin_nnn (S n)) with (-1 * sum_f_R0 sin_nnn (S n)); + [ idtac | ring ]. +rewrite scal_sum. +rewrite decomp_sum. +replace (sin_nnn 0%nat) with 0. +rewrite Rmult_0_l; rewrite Rplus_0_l. +replace (pred (S n)) with n; [ idtac | reflexivity ]. +apply sum_eq; intros. +rewrite Rmult_comm. +unfold sin_nnn in |- *. +rewrite scal_sum. +rewrite scal_sum. +apply sum_eq; intros. +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (/ INR (fact (2 * S i)))). +repeat rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * S i)))). +repeat rewrite <- Rmult_assoc. +replace (/ INR (fact (2 * S i)) * C (2 * S i) (S (2 * i0))) with + (/ INR (fact (2 * i0 + 1)) * / INR (fact (2 * (i - i0) + 1))). +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. +rewrite pow_add. +ring. +symmetry in |- *; apply le_plus_minus; assumption. +unfold C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rinv_mult_distr. +replace (S (2 * i0)) with (2 * i0 + 1)%nat; + [ apply Rmult_eq_compat_l | ring ]. +replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat. +reflexivity. +apply INR_eq. +rewrite plus_INR; rewrite mult_INR; repeat rewrite minus_INR. +rewrite plus_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +replace (2 * i0 + 1)%nat with (S (2 * i0)). +replace (2 * S i)%nat with (S (S (2 * i))). +apply le_n_S. +apply le_trans with (2 * i)%nat. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +assumption. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +reflexivity. +apply lt_O_Sn. +apply sum_eq; intros. +rewrite scal_sum. +apply sum_eq; intros. +unfold Rdiv in |- *. +repeat rewrite <- Rmult_assoc. +rewrite <- (Rmult_comm (/ INR (fact (2 * i)))). +repeat rewrite <- Rmult_assoc. +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. +rewrite pow_add. +ring. +symmetry in |- *; apply le_plus_minus; assumption. +unfold C in |- *. +unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +rewrite Rinv_mult_distr. +replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat. +reflexivity. +apply INR_eq. +rewrite mult_INR; repeat rewrite minus_INR. +do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +apply (fun m n p:nat => mult_le_compat_l p n m); assumption. +assumption. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold Reste2 in |- *; apply sum_eq; intros. +apply sum_eq; intros. +unfold Rdiv in |- *; ring. +unfold Reste1 in |- *; apply sum_eq; intros. +apply sum_eq; intros. +unfold Rdiv in |- *; ring. +apply lt_O_Sn. Qed. -Lemma pow_sqr : (x:R;i:nat) (pow x (mult (2) i))==(pow ``x*x`` i). -Intros. -Assert H := (pow_Rsqr x i). -Unfold Rsqr in H; Exact H. +Lemma pow_sqr : forall (x:R) (i:nat), x ^ (2 * i) = (x * x) ^ i. +intros. +assert (H := pow_Rsqr x i). +unfold Rsqr in H; exact H. Qed. -Lemma A1_cvg : (x:R) (Un_cv (A1 x) (cos x)). -Intro. -Assert H := (exist_cos ``x*x``). -Elim H; Intros. -Assert p_i := p. -Unfold cos_in in p. -Unfold cos_n infinit_sum in p. -Unfold R_dist in p. -Cut ``(cos x)==x0``. -Intro. -Rewrite H0. -Unfold Un_cv; Unfold R_dist; Intros. -Elim (p eps H1); Intros. -Exists x1; Intros. -Unfold A1. -Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow (x*x) i)``) n). -Apply H2; Assumption. -Apply sum_eq. -Intros. -Replace ``(pow (x*x) i)`` with ``(pow x (mult (S (S O)) i))``. -Reflexivity. -Apply pow_sqr. -Unfold cos. -Case (exist_cos (Rsqr x)). -Unfold Rsqr; Intros. -Unfold cos_in in p_i. -Unfold cos_in in c. -Apply unicity_sum with [i:nat]``(cos_n i)*(pow (x*x) i)``; Assumption. +Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x). +intro. +assert (H := exist_cos (x * x)). +elim H; intros. +assert (p_i := p). +unfold cos_in in p. +unfold cos_n, infinit_sum in p. +unfold R_dist in p. +cut (cos x = x0). +intro. +rewrite H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (p eps H1); intros. +exists x1; intros. +unfold A1 in |- *. +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). +apply H2; assumption. +apply sum_eq. +intros. +replace ((x * x) ^ i) with (x ^ (2 * i)). +reflexivity. +apply pow_sqr. +unfold cos in |- *. +case (exist_cos (Rsqr x)). +unfold Rsqr in |- *; 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. Qed. -Lemma C1_cvg : (x,y:R) (Un_cv (C1 x y) (cos (Rplus x y))). -Intros. -Assert H := (exist_cos ``(x+y)*(x+y)``). -Elim H; Intros. -Assert p_i := p. -Unfold cos_in in p. -Unfold cos_n infinit_sum in p. -Unfold R_dist in p. -Cut ``(cos (x+y))==x0``. -Intro. -Rewrite H0. -Unfold Un_cv; Unfold R_dist; Intros. -Elim (p eps H1); Intros. -Exists x1; Intros. -Unfold C1. -Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow ((x+y)*(x+y)) i)``) n). -Apply H2; Assumption. -Apply sum_eq. -Intros. -Replace ``(pow ((x+y)*(x+y)) i)`` with ``(pow (x+y) (mult (S (S O)) i))``. -Reflexivity. -Apply pow_sqr. -Unfold cos. -Case (exist_cos (Rsqr ``x+y``)). -Unfold Rsqr; Intros. -Unfold cos_in in p_i. -Unfold cos_in in c. -Apply unicity_sum with [i:nat]``(cos_n i)*(pow ((x+y)*(x+y)) i)``; Assumption. +Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)). +intros. +assert (H := exist_cos ((x + y) * (x + y))). +elim H; intros. +assert (p_i := p). +unfold cos_in in p. +unfold cos_n, infinit_sum in p. +unfold R_dist in p. +cut (cos (x + y) = x0). +intro. +rewrite H0. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (p eps H1); intros. +exists x1; intros. +unfold C1 in |- *. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n) + with + (sum_f_R0 + (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n). +apply H2; assumption. +apply sum_eq. +intros. +replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)). +reflexivity. +apply pow_sqr. +unfold cos in |- *. +case (exist_cos (Rsqr (x + y))). +unfold Rsqr in |- *; 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); + assumption. Qed. -Lemma B1_cvg : (x:R) (Un_cv (B1 x) (sin x)). -Intro. -Case (Req_EM x R0); Intro. -Rewrite H. -Rewrite sin_0. -Unfold B1. -Unfold Un_cv; Unfold R_dist; Intros; Exists O; Intros. -Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (plus (mult (S (S O)) k) (S O)))``) n) with R0. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Induction n. -Simpl; Ring. -Rewrite tech5; Rewrite <- Hrecn. -Simpl; Ring. -Unfold ge; Apply le_O_n. -Assert H0 := (exist_sin ``x*x``). -Elim H0; Intros. -Assert p_i := p. -Unfold sin_in in p. -Unfold sin_n infinit_sum in p. -Unfold R_dist in p. -Cut ``(sin x)==x*x0``. -Intro. -Rewrite H1. -Unfold Un_cv; Unfold R_dist; Intros. -Cut ``0<eps/(Rabsolu x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption]]. -Elim (p ``eps/(Rabsolu x)`` H3); Intros. -Exists x1; Intros. -Unfold B1. -Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))``) n) with (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)). -Replace (Rminus (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)) (Rmult x x0)) with (Rmult x (Rminus (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n) x0)); [Idtac | Ring]. -Rewrite Rabsolu_mult. -Apply Rlt_monotony_contra with ``/(Rabsolu x)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H4; Apply H4; Assumption. -Apply Rabsolu_no_R0; Assumption. -Rewrite scal_sum. -Apply sum_eq. -Intros. -Rewrite pow_add. -Rewrite pow_sqr. -Simpl. -Ring. -Unfold sin. -Case (exist_sin (Rsqr x)). -Unfold Rsqr; Intros. -Unfold sin_in in p_i. -Unfold sin_in in s. -Assert H1 := (unicity_sum [i:nat]``(sin_n i)*(pow (x*x) i)`` x0 x1 p_i s). -Rewrite H1; Reflexivity. -Qed. +Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x). +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. +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. +induction n as [| n Hrecn]. +simpl in |- *; ring. +rewrite tech5; rewrite <- Hrecn. +simpl in |- *; ring. +unfold ge in |- *; apply le_O_n. +assert (H0 := exist_sin (x * x)). +elim H0; intros. +assert (p_i := p). +unfold sin_in in p. +unfold sin_n, infinit_sum in p. +unfold R_dist in p. +cut (sin x = x * x0). +intro. +rewrite H1. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / Rabs x); + [ intro + | unfold Rdiv in |- *; 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 |- *. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) + n) with + (x * + sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n). +replace + (x * + sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - + x * x0) with + (x * + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - + x0)); [ idtac | ring ]. +rewrite Rabs_mult. +apply Rmult_lt_reg_l with (/ Rabs x). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H4; apply H4; + assumption. +apply Rabs_no_R0; assumption. +rewrite scal_sum. +apply sum_eq. +intros. +rewrite pow_add. +rewrite pow_sqr. +simpl in |- *. +ring. +unfold sin in |- *. +case (exist_sin (Rsqr x)). +unfold Rsqr in |- *; intros. +unfold sin_in in p_i. +unfold sin_in in s. +assert + (H1 := uniqueness_sum (fun i:nat => sin_n i * (x * x) ^ i) x0 x1 p_i s). +rewrite H1; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v index 3f0986480..474451903 100644 --- a/theories/Reals/DiscrR.v +++ b/theories/Reals/DiscrR.v @@ -8,51 +8,90 @@ (*i $Id$ i*) -Require RIneq. -Require Omega. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import RIneq. +Require Import Omega. Open Local Scope R_scope. -Lemma Rlt_R0_R2 : ``0<2``. -Replace ``2`` with (INR (2)); [Apply lt_INR_0; Apply lt_O_Sn | Reflexivity]. +Lemma Rlt_R0_R2 : 0 < 2. +replace 2 with (INR 2); [ apply lt_INR_0; apply lt_O_Sn | reflexivity ]. Qed. -Lemma Rplus_lt_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``. -Intros. -Apply Rlt_trans with x. -Assumption. -Pattern 1 x; Rewrite <- Rplus_Or. -Apply Rlt_compatibility. -Assumption. +Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y. +intros. +apply Rlt_trans with x. +assumption. +pattern x at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l. +assumption. Qed. -Lemma IZR_eq : (z1,z2:Z) z1=z2 -> (IZR z1)==(IZR z2). -Intros; Rewrite H; Reflexivity. +Lemma IZR_eq : forall z1 z2:Z, z1 = z2 -> IZR z1 = IZR z2. +intros; rewrite H; reflexivity. Qed. -Lemma IZR_neq : (z1,z2:Z) `z1<>z2` -> ``(IZR z1)<>(IZR z2)``. -Intros; Red; Intro; Elim H; Apply eq_IZR; Assumption. +Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2. +intros; red in |- *; intro; elim H; apply eq_IZR; assumption. Qed. -Tactic Definition DiscrR := - Try Match Context With - | [ |- ~(?1==?2) ] -> Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_neq; Try Discriminate | Reflexivity] | Reflexivity] | Reflexivity]. +Ltac discrR := + try + match goal with + | |- (?X1 <> ?X2) => + replace 2 with (IZR 2); + [ replace 1 with (IZR 1); + [ replace 0 with (IZR 0); + [ repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_neq; try discriminate + | reflexivity ] + | reflexivity ] + | reflexivity ] + end. -Recursive Tactic Definition Sup0 := - Match Context With - | [ |- ``0<1`` ] -> Apply Rlt_R0_R1 - | [ |- ``0<?1`` ] -> Repeat (Apply Rmult_lt_pos Orelse Apply Rplus_lt_pos; Try Apply Rlt_R0_R1 Orelse Apply Rlt_R0_R2) - | [ |- ``?1>0`` ] -> Change ``0<?1``; Sup0. +Ltac prove_sup0 := + match goal with + | |- (0 < 1) => apply Rlt_0_1 + | |- (0 < ?X1) => + 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 + end. -Tactic Definition SupOmega := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_lt; Omega | Reflexivity] | Reflexivity] | Reflexivity]. +Ltac omega_sup := + replace 2 with (IZR 2); + [ replace 1 with (IZR 1); + [ replace 0 with (IZR 0); + [ repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_lt; omega + | reflexivity ] + | reflexivity ] + | reflexivity ]. -Recursive Tactic Definition Sup := - Match Context With - | [ |- (Rgt ?1 ?2) ] -> Change ``?2<?1``; Sup - | [ |- ``0<?1`` ] -> Sup0 - | [ |- (Rlt (Ropp ?1) R0) ] -> Rewrite <- Ropp_O; Sup - | [ |- (Rlt (Ropp ?1) (Ropp ?2)) ] -> Apply Rlt_Ropp; Sup - | [ |- (Rlt (Ropp ?1) ?2) ] -> Apply Rlt_trans with ``0``; Sup - | [ |- (Rlt ?1 ?2) ] -> SupOmega - | _ -> Idtac. - -Tactic Definition RCompute := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_eq; Try Reflexivity | Reflexivity] | Reflexivity] | Reflexivity]. +Ltac prove_sup := + match goal with + | |- (?X1 > ?X2) => change (X2 < X1) in |- *; prove_sup + | |- (0 < ?X1) => prove_sup0 + | |- (- ?X1 < 0) => rewrite <- Ropp_0; prove_sup + | |- (- ?X1 < - ?X2) => apply Ropp_lt_gt_contravar; prove_sup + | |- (- ?X1 < ?X2) => apply Rlt_trans with 0; prove_sup + | |- (?X1 < ?X2) => omega_sup + | _ => idtac + end. + +Ltac Rcompute := + replace 2 with (IZR 2); + [ replace 1 with (IZR 1); + [ replace 0 with (IZR 0); + [ repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_eq; try reflexivity + | reflexivity ] + | reflexivity ] + | reflexivity ].
\ No newline at end of file diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v index 5c06af34a..c424b9e14 100644 --- a/theories/Reals/Exp_prop.v +++ b/theories/Reals/Exp_prop.v @@ -8,883 +8,1004 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require Ranalysis1. -Require PSeries_reg. -Require Div2. -Require Even. -Require Max. -V7only [Import R_scope.]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import PSeries_reg. +Require Import Div2. +Require Import Even. +Require Import Max. Open Local Scope nat_scope. -V7only [Import nat_scope.]. Open Local Scope R_scope. -Definition E1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``/(INR (fact k))*(pow x k)`` N). +Definition E1 (x:R) (N:nat) : R := + sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N. -Lemma E1_cvg : (x:R) (Un_cv (E1 x) (exp x)). -Intro; Unfold exp; Unfold projT1. -Case (exist_exp x); Intro. -Unfold exp_in Un_cv; Unfold infinit_sum E1; Trivial. +Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x). +intro; unfold exp in |- *; unfold projT1 in |- *. +case (exist_exp x); intro. +unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial. Qed. -Definition Reste_E [x,y:R] : nat->R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)). +Definition Reste_E (x y:R) (N:nat) : R := + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k))) (pred N). -Lemma exp_form : (x,y:R;n:nat) (lt O n) -> ``(E1 x n)*(E1 y n)-(Reste_E x y n)==(E1 (x+y) n)``. -Intros; Unfold E1. -Rewrite cauchy_finite. -Unfold Reste_E; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply sum_eq; Intros. -Rewrite binomial. -Rewrite scal_sum; Apply sum_eq; Intros. -Unfold C; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (fact i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite Rinv_Rmult. -Ring. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply H. +Lemma exp_form : + forall (x y:R) (n:nat), + (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n. +intros; unfold E1 in |- *. +rewrite cauchy_finite. +unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; + intros. +rewrite binomial. +rewrite scal_sum; apply sum_eq; intros. +unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite Rinv_mult_distr. +ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply H. Qed. -Definition maj_Reste_E [x,y:R] : nat->R := [N:nat]``4*(pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) N))/(Rsqr (INR (fact (div2 (pred N)))))``. +Definition maj_Reste_E (x y:R) (N:nat) : R := + 4 * + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) / + Rsqr (INR (fact (div2 (pred N))))). -Lemma Rle_Rinv : (x,y:R) ``0<x`` -> ``0<y`` -> ``x<=y`` -> ``/y<=/x``. -Intros; Apply Rle_monotony_contra with x. -Apply H. -Rewrite <- Rinv_r_sym. -Apply Rle_monotony_contra with y. -Apply H0. -Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Apply H1. -Red; Intro; Rewrite H2 in H0; Elim (Rlt_antirefl ? H0). -Red; Intro; Rewrite H2 in H; Elim (Rlt_antirefl ? H). +Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x. +intros; apply Rmult_le_reg_l with x. +apply H. +rewrite <- Rinv_r_sym. +apply Rmult_le_reg_l with y. +apply H0. +rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; apply H1. +red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0). +red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H). Qed. (**********) -Lemma div2_double : (N:nat) (div2 (mult (2) N))=N. -Intro; Induction N. -Reflexivity. -Replace (mult (2) (S N)) with (S (S (mult (2) N))). -Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. +Lemma div2_double : forall N:nat, div2 (2 * N) = N. +intro; induction N as [| N HrecN]. +reflexivity. +replace (2 * S N)%nat with (S (S (2 * N))). +simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. Qed. -Lemma div2_S_double : (N:nat) (div2 (S (mult (2) N)))=N. -Intro; Induction N. -Reflexivity. -Replace (mult (2) (S N)) with (S (S (mult (2) N))). -Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. +Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N. +intro; induction N as [| N HrecN]. +reflexivity. +replace (2 * S N)%nat with (S (S (2 * N))). +simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. Qed. -Lemma div2_not_R0 : (N:nat) (lt (1) N) -> (lt O (div2 N)). -Intros; Induction N. -Elim (lt_n_O ? H). -Cut (lt (1) N)\/N=(1). -Intro; Elim H0; Intro. -Assert H2 := (even_odd_dec N). -Elim H2; Intro. -Rewrite <- (even_div2 ? a); Apply HrecN; Assumption. -Rewrite <- (odd_div2 ? b); Apply lt_O_Sn. -Rewrite H1; Simpl; Apply lt_O_Sn. -Inversion H. -Right; Reflexivity. -Left; Apply lt_le_trans with (2); [Apply lt_n_Sn | Apply H1]. +Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat. +intros; induction N as [| N HrecN]. +elim (lt_n_O _ H). +cut ((1 < N)%nat \/ N = 1%nat). +intro; elim H0; intro. +assert (H2 := even_odd_dec N). +elim H2; intro. +rewrite <- (even_div2 _ a); apply HrecN; assumption. +rewrite <- (odd_div2 _ b); apply lt_O_Sn. +rewrite H1; simpl in |- *; apply lt_O_Sn. +inversion H. +right; reflexivity. +left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ]. Qed. -Lemma Reste_E_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste_E x y N))<=(maj_Reste_E x y N)``. -Intros; Pose M := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))). -Apply Rle_trans with (Rmult (pow M (mult (2) N)) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(Rsqr (INR (fact (div2 (S N)))))`` (pred (minus N k))) (pred N))). -Unfold Reste_E. -Apply Rle_trans with (sum_f_R0 [k:nat](Rabsolu (sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k)))) (pred N)). -Apply (sum_Rabsolu [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)). -Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(Rabsolu (/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))))`` (pred (minus N k))) (pred N)). -Apply sum_Rle; Intros. -Apply (sum_Rabsolu [l:nat]``/(INR (fact (S (plus l n))))*(pow x (S (plus l n)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))``). -Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow M (mult (S (S O)) N))*/(INR (fact (S l)))*/(INR (fact (minus N l)))`` (pred (minus N k))) (pred N)). -Apply sum_Rle; Intros. -Apply sum_Rle; Intros. -Repeat Rewrite Rabsolu_mult. -Do 2 Rewrite <- Pow_Rabsolu. -Rewrite (Rabsolu_right ``/(INR (fact (S (plus n0 n))))``). -Rewrite (Rabsolu_right ``/(INR (fact (minus N n0)))``). -Replace ``/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))* - (/(INR (fact (minus N n0)))*(pow (Rabsolu y) (minus N n0)))`` with ``/(INR (fact (minus N n0)))*/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``; [Idtac | Ring]. -Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``). -Repeat Rewrite Rmult_assoc. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_trans with ``/(INR (fact (S n0)))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``. -Rewrite (Rmult_sym ``/(INR (fact (S (plus n0 n))))``); Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony. -Apply pow_le; Apply Rabsolu_pos. -Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Apply Rle_monotony. -Apply pow_le; Apply Rabsolu_pos. -Apply Rle_Rinv. -Apply INR_fact_lt_0. -Apply INR_fact_lt_0. -Apply le_INR; Apply fact_growing; Apply le_n_S. -Apply le_plus_l. -Rewrite (Rmult_sym ``(pow M (mult (S (S O)) N))``); Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``. -Do 2 Rewrite <- (Rmult_sym ``(pow (Rabsolu y) (minus N n0))``). -Apply Rle_monotony. -Apply pow_le; Apply Rabsolu_pos. -Apply pow_incr; Split. -Apply Rabsolu_pos. -Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)). -Apply RmaxLess1. -Unfold M; Apply RmaxLess2. -Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow M (minus N n0))``. -Apply Rle_monotony. -Apply pow_le; Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Unfold M; Apply RmaxLess1. -Apply pow_incr; Split. -Apply Rabsolu_pos. -Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)). -Apply RmaxLess2. -Unfold M; Apply RmaxLess2. -Rewrite <- pow_add; Replace (plus (S (plus n0 n)) (minus N n0)) with (plus N (S n)). -Apply Rle_pow. -Unfold M; Apply RmaxLess1. -Replace (mult (2) N) with (plus N N); [Idtac | Ring]. -Apply le_reg_l. -Replace N with (S (pred N)). -Apply le_n_S; Apply H0. -Symmetry; Apply S_pred with O; Apply H. -Apply INR_eq; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite minus_INR. -Ring. -Apply le_trans with (pred (minus N n)). -Apply H1. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n (0)) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Apply H0. -Apply lt_pred_n_n. -Apply H. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Rewrite scal_sum. -Apply sum_Rle; Intros. -Rewrite <- Rmult_sym. -Rewrite scal_sum. -Apply sum_Rle; Intros. -Rewrite (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``). -Rewrite Rmult_assoc; Apply Rle_monotony. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Unfold M; Apply RmaxLess1. -Assert H2 := (even_odd_cor N). -Elim H2; Intros N0 H3. -Elim H3; Intro. -Apply Rle_trans with ``/(INR (fact n0))*/(INR (fact (minus N n0)))``. -Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_Rinv. -Apply INR_fact_lt_0. -Apply INR_fact_lt_0. -Apply le_INR. -Apply fact_growing. -Apply le_n_Sn. -Replace ``/(INR (fact n0))*/(INR (fact (minus N n0)))`` with ``(C N n0)/(INR (fact N))``. -Pattern 1 N; Rewrite H4. -Apply Rle_trans with ``(C N N0)/(INR (fact N))``. -Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact N))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Rewrite H4. -Apply C_maj. -Rewrite <- H4; Apply le_trans with (pred (minus N n)). -Apply H1. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n (0)) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Apply H0. -Apply lt_pred_n_n. -Apply H. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Replace ``(C N N0)/(INR (fact N))`` with ``/(Rsqr (INR (fact N0)))``. -Rewrite H4; Rewrite div2_S_double; Right; Reflexivity. -Unfold Rsqr C Rdiv. -Repeat Rewrite Rinv_Rmult. -Rewrite (Rmult_sym (INR (fact N))). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Replace (minus N N0) with N0. -Ring. -Replace N with (plus N0 N0). -Symmetry; Apply minus_plus. -Rewrite H4. -Apply INR_eq; Rewrite plus_INR; Rewrite mult_INR; Do 2 Rewrite S_INR; Ring. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Unfold C Rdiv. -Rewrite (Rmult_sym (INR (fact N))). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rinv_Rmult. -Rewrite Rmult_1r; Ring. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Replace ``/(INR (fact (S n0)))*/(INR (fact (minus 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; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S N)))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Cut (S N) = (mult (2) (S N0)). -Intro; Rewrite H5; Apply C_maj. -Rewrite <- H5; Apply le_n_S. -Apply le_trans with (pred (minus N n)). -Apply H1. -Apply le_S_n. -Replace (S (pred (minus N n))) with (minus N n). -Apply le_trans with N. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Apply le_n_Sn. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n (0)) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Apply H0. -Apply lt_pred_n_n. -Apply H. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Apply INR_eq; Rewrite H4. -Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Cut (S N) = (mult (2) (S N0)). -Intro. -Replace ``(C (S N) (S N0))/(INR (fact (S N)))`` with ``/(Rsqr (INR (fact (S N0))))``. -Rewrite H5; Rewrite div2_double. -Right; Reflexivity. -Unfold Rsqr C Rdiv. -Repeat Rewrite Rinv_Rmult. -Replace (minus (S N) (S N0)) with (S N0). -Rewrite (Rmult_sym (INR (fact (S N)))). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Reflexivity. -Apply INR_fact_neq_0. -Replace (S N) with (plus (S N0) (S N0)). -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. -Apply INR_eq; Rewrite H4; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Unfold C Rdiv. -Rewrite (Rmult_sym (INR (fact (S N)))). -Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Rewrite Rinv_Rmult. -Reflexivity. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Unfold maj_Reste_E. -Unfold Rdiv; Rewrite (Rmult_sym ``4``). -Rewrite Rmult_assoc. -Apply Rle_monotony. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Apply RmaxLess1. -Apply Rle_trans with (sum_f_R0 [k:nat]``(INR (minus N k))*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)). -Apply sum_Rle; Intros. -Rewrite sum_cte. -Replace (S (pred (minus N n))) with (minus N n). -Right; Apply Rmult_sym. -Apply S_pred with O. -Apply simpl_lt_plus_l with n. -Rewrite <- le_plus_minus. -Replace (plus n (0)) with n; [Idtac | Ring]. -Apply le_lt_trans with (pred N). -Apply H0. -Apply lt_pred_n_n. -Apply H. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)). -Apply sum_Rle; Intros. -Do 2 Rewrite <- (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt. -Apply INR_fact_neq_0. -Apply le_INR. -Apply simpl_le_plus_l with n. -Rewrite <- le_plus_minus. -Apply le_plus_r. -Apply le_trans with (pred N). -Apply H0. -Apply le_pred_n. -Rewrite sum_cte; Replace (S (pred N)) with N. -Cut (div2 (S N)) = (S (div2 (pred N))). -Intro; Rewrite H0. -Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rsqr_times. -Rewrite Rinv_Rmult. -Rewrite (Rmult_sym (INR N)); Repeat Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0. -Rewrite <- H0. -Cut ``(INR N)<=(INR (mult (S (S O)) (div2 (S N))))``. -Intro; Apply Rle_monotony_contra with ``(Rsqr (INR (div2 (S N))))``. -Apply Rsqr_pos_lt. -Apply not_O_INR; Red; Intro. -Cut (lt (1) (S N)). -Intro; Assert H4 := (div2_not_R0 ? H3). -Rewrite H2 in H4; Elim (lt_n_O ? H4). -Apply lt_n_S; Apply H. -Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l. -Replace ``(INR N)*(INR N)`` with (Rsqr (INR N)); [Idtac | Reflexivity]. -Rewrite Rmult_assoc. -Rewrite Rmult_sym. -Replace ``4`` with (Rsqr ``2``); [Idtac | SqRing]. -Rewrite <- Rsqr_times. -Apply Rsqr_incr_1. -Replace ``2`` with (INR (2)). -Rewrite <- mult_INR; Apply H1. -Reflexivity. -Left; Apply lt_INR_0; Apply H. -Left; Apply Rmult_lt_pos. -Sup0. -Apply lt_INR_0; Apply div2_not_R0. -Apply lt_n_S; Apply H. -Cut (lt (1) (S N)). -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 2 N; Rewrite H3. -Rewrite div2_S_double. -Right; Rewrite H3; Reflexivity. -Pattern 2 N; Rewrite H3. -Replace (S (S (mult (2) N0))) with (mult (2) (S N0)). -Rewrite div2_double. -Rewrite H3. -Rewrite S_INR; Do 2 Rewrite mult_INR. -Rewrite (S_INR N0). -Rewrite Rmult_Rplus_distr. -Apply Rle_compatibility. -Rewrite Rmult_1r. -Simpl. -Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -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. -Cut (lt O N0). -Intro; Rewrite H2. -Rewrite div2_S_double. -Replace (mult (2) N0) with (S (S (mult (2) (pred N0)))). -Replace (pred (S (S (mult (2) (pred N0))))) with (S (mult (2) (pred N0))). -Rewrite div2_S_double. -Apply S_pred with O; Apply H3. -Reflexivity. -Replace N0 with (S (pred N0)). -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Symmetry; Apply S_pred with O; Apply H3. -Rewrite H2 in H. -Apply neq_O_lt. -Red; Intro. -Rewrite <- H3 in H. -Simpl in H. -Elim (lt_n_O ? H). -Rewrite H2. -Replace (pred (S (mult (2) N0))) with (mult (2) N0); [Idtac | Reflexivity]. -Replace (S (S (mult (2) N0))) with (mult (2) (S N0)). -Do 2 Rewrite div2_double. -Reflexivity. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply S_pred with O; Apply H. +Lemma Reste_E_maj : + forall (x y:R) (N:nat), + (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N. +intros; pose (M := Rmax 1 (Rmax (Rabs x) (Rabs y))). +apply Rle_trans with + (M ^ (2 * N) * + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N))))) + (pred (N - k))) (pred N)). +unfold Reste_E in |- *. +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k)))) (pred N)). +apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k))) (pred N)). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + (/ INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l)))) ( + pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply + (Rsum_abs + (fun l:nat => + / INR (fact (S (l + n))) * x ^ S (l + n) * + (/ INR (fact (N - l)) * y ^ (N - l)))). +apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l))) + (pred (N - k))) (pred N)). +apply sum_Rle; intros. +apply sum_Rle; intros. +repeat rewrite Rabs_mult. +do 2 rewrite <- RPow_abs. +rewrite (Rabs_right (/ INR (fact (S (n0 + n))))). +rewrite (Rabs_right (/ INR (fact (N - n0)))). +replace + (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * + (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with + (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * + Rabs y ^ (N - n0)); [ idtac | ring ]. +rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). +repeat rewrite Rmult_assoc. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with + (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)). +rewrite (Rmult_comm (/ INR (fact (S (n0 + n))))); + rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc; + apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply Rle_Rinv. +apply INR_fact_lt_0. +apply INR_fact_lt_0. +apply le_INR; apply fact_le; apply le_n_S. +apply le_plus_l. +rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc; + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)). +do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +apply pow_incr; split. +apply Rabs_pos. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess1. +unfold M in |- *; apply RmaxLess2. +apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)). +apply Rmult_le_compat_l. +apply pow_le; apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold M in |- *; apply RmaxLess1. +apply pow_incr; split. +apply Rabs_pos. +apply Rle_trans with (Rmax (Rabs x) (Rabs y)). +apply RmaxLess2. +unfold M in |- *; apply RmaxLess2. +rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat. +apply Rle_pow. +unfold M in |- *; apply RmaxLess1. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. +apply plus_le_compat_l. +replace N with (S (pred N)). +apply le_n_S; apply H0. +symmetry in |- *; apply S_pred with 0%nat; apply H. +apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; + rewrite minus_INR. +ring. +apply le_trans with (pred (N - n)). +apply H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite scal_sum. +apply sum_Rle; intros. +rewrite <- Rmult_comm. +rewrite scal_sum. +apply sum_Rle; intros. +rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +unfold M in |- *; apply RmaxLess1. +assert (H2 := even_odd_cor N). +elim H2; intros N0 H3. +elim H3; intro. +apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))). +do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_Rinv. +apply INR_fact_lt_0. +apply INR_fact_lt_0. +apply le_INR. +apply fact_le. +apply le_n_Sn. +replace (/ INR (fact n0) * / INR (fact (N - n0))) with + (C N n0 / INR (fact N)). +pattern N at 1 in |- *; rewrite H4. +apply Rle_trans with (C N N0 / INR (fact N)). +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +rewrite H4. +apply C_maj. +rewrite <- H4; apply le_trans with (pred (N - n)). +apply H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))). +rewrite H4; rewrite div2_S_double; right; reflexivity. +unfold Rsqr, C, Rdiv in |- *. +repeat rewrite Rinv_mult_distr. +rewrite (Rmult_comm (INR (fact N))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace (N - N0)%nat with N0. +ring. +replace N with (N0 + N0)%nat. +symmetry in |- *; apply minus_plus. +rewrite H4. +apply INR_eq; rewrite plus_INR; rewrite mult_INR; do 2 rewrite S_INR; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold C, Rdiv in |- *. +rewrite (Rmult_comm (INR (fact N))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rinv_mult_distr. +rewrite Rmult_1_r; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with + (C (S N) (S n0) / INR (fact (S N))). +apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))). +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +cut (S N = (2 * S N0)%nat). +intro; rewrite H5; apply C_maj. +rewrite <- H5; apply le_n_S. +apply le_trans with (pred (N - n)). +apply H1. +apply le_S_n. +replace (S (pred (N - n))) with (N - n)%nat. +apply le_trans with N. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply le_n_Sn. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply INR_eq; rewrite H4. +do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +cut (S N = (2 * S N0)%nat). +intro. +replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))). +rewrite H5; rewrite div2_double. +right; reflexivity. +unfold Rsqr, C, Rdiv in |- *. +repeat rewrite Rinv_mult_distr. +replace (S N - S N0)%nat with (S N0). +rewrite (Rmult_comm (INR (fact (S N)))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply INR_fact_neq_0. +replace (S N) with (S N0 + S N0)%nat. +symmetry in |- *; apply minus_plus. +rewrite H5; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; rewrite H4; do 2 rewrite S_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; ring. +unfold C, Rdiv in |- *. +rewrite (Rmult_comm (INR (fact (S N)))). +rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rinv_mult_distr. +reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold maj_Reste_E in |- *. +unfold Rdiv in |- *; rewrite (Rmult_comm 4). +rewrite Rmult_assoc. +apply Rmult_le_compat_l. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N))))) + (pred N)). +apply sum_Rle; intros. +rewrite sum_cte. +replace (S (pred (N - n))) with (N - n)%nat. +right; apply Rmult_comm. +apply S_pred with 0%nat. +apply plus_lt_reg_l with n. +rewrite <- le_plus_minus. +replace (n + 0)%nat with n; [ idtac | ring ]. +apply le_lt_trans with (pred N). +apply H0. +apply lt_pred_n_n. +apply H. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)). +apply sum_Rle; intros. +do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt. +apply INR_fact_neq_0. +apply le_INR. +apply (fun p n m:nat => plus_le_reg_l n m p) with n. +rewrite <- le_plus_minus. +apply le_plus_r. +apply le_trans with (pred N). +apply H0. +apply le_pred_n. +rewrite sum_cte; replace (S (pred N)) with N. +cut (div2 (S N) = S (div2 (pred N))). +intro; rewrite H0. +rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; rewrite Rsqr_mult. +rewrite Rinv_mult_distr. +rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc; + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. +rewrite <- H0. +cut (INR N <= INR (2 * div2 (S N))). +intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))). +apply Rsqr_pos_lt. +apply not_O_INR; red in |- *; intro. +cut (1 < S N)%nat. +intro; assert (H4 := div2_not_R0 _ H3). +rewrite H2 in H4; elim (lt_n_O _ H4). +apply lt_n_S; apply H. +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ]. +rewrite Rmult_assoc. +rewrite Rmult_comm. +replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. +rewrite <- Rsqr_mult. +apply Rsqr_incr_1. +replace 2 with (INR 2). +rewrite <- mult_INR; apply H1. +reflexivity. +left; apply lt_INR_0; apply H. +left; apply Rmult_lt_0_compat. +prove_sup0. +apply lt_INR_0; apply div2_not_R0. +apply lt_n_S; apply H. +cut (1 < S N)%nat. +intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro; + assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; + elim (lt_n_O _ H4). +apply lt_n_S; apply H. +assert (H1 := even_odd_cor N). +elim H1; intros N0 H2. +elim H2; intro. +pattern N at 2 in |- *; rewrite H3. +rewrite div2_S_double. +right; rewrite H3; reflexivity. +pattern N at 2 in |- *; rewrite H3. +replace (S (S (2 * N0))) with (2 * S N0)%nat. +rewrite div2_double. +rewrite H3. +rewrite S_INR; do 2 rewrite mult_INR. +rewrite (S_INR N0). +rewrite Rmult_plus_distr_l. +apply Rplus_le_compat_l. +rewrite Rmult_1_r. +simpl in |- *. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0. +unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate. +assert (H0 := even_odd_cor N). +elim H0; intros N0 H1. +elim H1; intro. +cut (0 < N0)%nat. +intro; rewrite H2. +rewrite div2_S_double. +replace (2 * N0)%nat with (S (S (2 * pred N0))). +replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)). +rewrite div2_S_double. +apply S_pred with 0%nat; apply H3. +reflexivity. +replace N0 with (S (pred N0)). +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +symmetry in |- *; apply S_pred with 0%nat; apply H3. +rewrite H2 in H. +apply neq_O_lt. +red in |- *; intro. +rewrite <- H3 in H. +simpl in H. +elim (lt_n_O _ H). +rewrite H2. +replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ]. +replace (S (S (2 * N0))) with (2 * S N0)%nat. +do 2 rewrite div2_double. +reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply S_pred with 0%nat; apply H. Qed. -Lemma maj_Reste_cv_R0 : (x,y:R) (Un_cv (maj_Reste_E x y) ``0``). -Intros; Assert H := (Majxy_cv_R0 x y). -Unfold Un_cv in H; Unfold Un_cv; Intros. -Cut ``0<eps/4``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H ? H1); Intros N0 H2. -Exists (max (mult (2) (S N0)) (2)); Intros. -Unfold R_dist in H2; Unfold R_dist; Rewrite minus_R0; Unfold Majxy in H2; Unfold maj_Reste_E. -Rewrite Rabsolu_right. -Apply Rle_lt_trans with ``4*(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))``. -Apply Rle_monotony. -Left; Sup0. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult. -Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``); Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))``); Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Rle_trans with ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``. -Rewrite Rmult_sym; Pattern 2 (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (2) n)); Rewrite <- Rmult_1r; Apply Rle_monotony. -Apply pow_le; Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Apply RmaxLess1. -Apply Rle_monotony_contra with ``(INR (fact (div2 (pred n))))``. -Apply INR_fact_lt_0. -Rewrite Rmult_1r; Rewrite <- Rinv_r_sym. -Replace R1 with (INR (1)); [Apply le_INR | Reflexivity]. -Apply lt_le_S. -Apply INR_lt. -Apply INR_fact_lt_0. -Apply INR_fact_neq_0. -Apply Rle_pow. -Apply RmaxLess1. -Assert H4 := (even_odd_cor n). -Elim H4; Intros N1 H5. -Elim H5; Intro. -Cut (lt O N1). -Intro. -Rewrite H6. -Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))). -Rewrite div2_S_double. -Replace (S (pred N1)) with N1. -Apply INR_le. -Right. -Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply S_pred with O; Apply H7. -Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))). -Reflexivity. -Pattern 2 N1; Replace N1 with (S (pred N1)). -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Symmetry ; Apply S_pred with O; Apply H7. -Apply INR_lt. -Apply Rlt_monotony_contra with (INR (2)). -Simpl; Sup0. -Rewrite Rmult_Or; Rewrite <- mult_INR. -Apply lt_INR_0. -Rewrite <- H6. -Apply lt_le_trans with (2). -Apply lt_O_Sn. -Apply le_trans with (max (mult (2) (S N0)) (2)). -Apply le_max_r. -Apply H3. -Rewrite H6. -Replace (pred (S (mult (2) N1))) with (mult (2) N1). -Rewrite div2_double. -Replace (mult (4) (S N1)) with (mult (2) (mult (2) (S N1))). -Apply mult_le. -Replace (mult (2) (S N1)) with (S (S (mult (2) N1))). -Apply le_n_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Ring. -Reflexivity. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply Rlt_monotony_contra with ``/4``. -Apply Rlt_Rinv; Sup0. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite Rmult_sym. -Replace ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))`` with ``(Rabsolu ((pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))-0))``. -Apply H2; Unfold ge. -Cut (le (mult (2) (S N0)) n). -Intro; Apply le_S_n. -Apply INR_le; Apply Rle_monotony_contra with (INR (2)). -Simpl; Sup0. -Do 2 Rewrite <- mult_INR; Apply le_INR. -Apply le_trans with n. -Apply H4. -Assert H5 := (even_odd_cor n). -Elim H5; Intros N1 H6. -Elim H6; Intro. -Cut (lt O N1). -Intro. -Rewrite H7. -Apply mult_le. -Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))). -Rewrite div2_S_double. -Replace (S (pred N1)) with N1. -Apply le_n. -Apply S_pred with O; Apply H8. -Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))). -Reflexivity. -Pattern 2 N1; Replace N1 with (S (pred N1)). -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Symmetry; Apply S_pred with O; Apply H8. -Apply INR_lt. -Apply Rlt_monotony_contra with (INR (2)). -Simpl; Sup0. -Rewrite Rmult_Or; Rewrite <- mult_INR. -Apply lt_INR_0. -Rewrite <- H7. -Apply lt_le_trans with (2). -Apply lt_O_Sn. -Apply le_trans with (max (mult (2) (S N0)) (2)). -Apply le_max_r. -Apply H3. -Rewrite H7. -Replace (pred (S (mult (2) N1))) with (mult (2) N1). -Rewrite div2_double. -Replace (mult (2) (S N1)) with (S (S (mult (2) N1))). -Apply le_n_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Reflexivity. -Apply le_trans with (max (mult (2) (S N0)) (2)). -Apply le_max_l. -Apply H3. -Rewrite minus_R0; Apply Rabsolu_right. -Apply Rle_sym1. -Unfold Rdiv; Repeat Apply Rmult_le_pos. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Apply RmaxLess1. -Left; Apply Rlt_Rinv; Apply INR_fact_lt_0. -DiscrR. -Apply Rle_sym1. -Unfold Rdiv; Apply Rmult_le_pos. -Left; Sup0. -Apply Rmult_le_pos. -Apply pow_le. -Apply Rle_trans with R1. -Left; Apply Rlt_R0_R1. -Apply RmaxLess1. -Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0. +Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0. +intros; assert (H := Majxy_cv_R0 x y). +unfold Un_cv in H; unfold Un_cv in |- *; intros. +cut (0 < eps / 4); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H _ H1); intros N0 H2. +exists (max (2 * S N0) 2); intros. +unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r; + unfold Majxy in H2; unfold maj_Reste_E in |- *. +rewrite Rabs_right. +apply Rle_lt_trans with + (4 * + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n))))). +apply Rmult_le_compat_l. +left; prove_sup0. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n))); + rewrite + (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))))) + ; rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)). +rewrite Rmult_comm; + pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *; + rewrite <- Rmult_1_r; apply Rmult_le_compat_l. +apply pow_le; apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))). +apply INR_fact_lt_0. +rewrite Rmult_1_r; rewrite <- Rinv_r_sym. +replace 1 with (INR 1); [ apply le_INR | reflexivity ]. +apply lt_le_S. +apply INR_lt. +apply INR_fact_lt_0. +apply INR_fact_neq_0. +apply Rle_pow. +apply RmaxLess1. +assert (H4 := even_odd_cor n). +elim H4; intros N1 H5. +elim H5; intro. +cut (0 < N1)%nat. +intro. +rewrite H6. +replace (pred (2 * N1)) with (S (2 * pred N1)). +rewrite div2_S_double. +replace (S (pred N1)) with N1. +apply INR_le. +right. +do 3 rewrite mult_INR; repeat rewrite S_INR; ring. +apply S_pred with 0%nat; apply H7. +replace (2 * N1)%nat with (S (S (2 * pred N1))). +reflexivity. +pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +symmetry in |- *; apply S_pred with 0%nat; apply H7. +apply INR_lt. +apply Rmult_lt_reg_l with (INR 2). +simpl in |- *; prove_sup0. +rewrite Rmult_0_r; rewrite <- mult_INR. +apply lt_INR_0. +rewrite <- H6. +apply lt_le_trans with 2%nat. +apply lt_O_Sn. +apply le_trans with (max (2 * S N0) 2). +apply le_max_r. +apply H3. +rewrite H6. +replace (pred (S (2 * N1))) with (2 * N1)%nat. +rewrite div2_double. +replace (4 * S N1)%nat with (2 * (2 * S N1))%nat. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (2 * S N1)%nat with (S (S (2 * N1))). +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +ring. +reflexivity. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rmult_lt_reg_l with (/ 4). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite Rmult_comm. +replace + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n)))) with + (Rabs + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n))) - 0)). +apply H2; unfold ge in |- *. +cut (2 * S N0 <= n)%nat. +intro; apply le_S_n. +apply INR_le; apply Rmult_le_reg_l with (INR 2). +simpl in |- *; prove_sup0. +do 2 rewrite <- mult_INR; apply le_INR. +apply le_trans with n. +apply H4. +assert (H5 := even_odd_cor n). +elim H5; intros N1 H6. +elim H6; intro. +cut (0 < N1)%nat. +intro. +rewrite H7. +apply (fun m n p:nat => mult_le_compat_l p n m). +replace (pred (2 * N1)) with (S (2 * pred N1)). +rewrite div2_S_double. +replace (S (pred N1)) with N1. +apply le_n. +apply S_pred with 0%nat; apply H8. +replace (2 * N1)%nat with (S (S (2 * pred N1))). +reflexivity. +pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +symmetry in |- *; apply S_pred with 0%nat; apply H8. +apply INR_lt. +apply Rmult_lt_reg_l with (INR 2). +simpl in |- *; prove_sup0. +rewrite Rmult_0_r; rewrite <- mult_INR. +apply lt_INR_0. +rewrite <- H7. +apply lt_le_trans with 2%nat. +apply lt_O_Sn. +apply le_trans with (max (2 * S N0) 2). +apply le_max_r. +apply H3. +rewrite H7. +replace (pred (S (2 * N1))) with (2 * N1)%nat. +rewrite div2_double. +replace (2 * S N1)%nat with (S (S (2 * N1))). +apply le_n_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +reflexivity. +apply le_trans with (max (2 * S N0) 2). +apply le_max_l. +apply H3. +rewrite Rminus_0_r; apply Rabs_right. +apply Rle_ge. +unfold Rdiv in |- *; repeat apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. +discrR. +apply Rle_ge. +unfold Rdiv in |- *; apply Rmult_le_pos. +left; prove_sup0. +apply Rmult_le_pos. +apply pow_le. +apply Rle_trans with 1. +left; apply Rlt_0_1. +apply RmaxLess1. +left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. Qed. (**********) -Lemma Reste_E_cv : (x,y:R) (Un_cv (Reste_E x y) R0). -Intros; Assert H := (maj_Reste_cv_R0 x y). -Unfold Un_cv in H; Unfold Un_cv; Intros; Elim (H ? H0); Intros. -Exists (max x0 (1)); Intros. -Unfold R_dist; Rewrite minus_R0. -Apply Rle_lt_trans with (maj_Reste_E x y n). -Apply Reste_E_maj. -Apply lt_le_trans with (1). -Apply lt_O_Sn. -Apply le_trans with (max x0 (1)). -Apply le_max_r. -Apply H2. -Replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) R0). -Apply H1. -Unfold ge; Apply le_trans with (max x0 (1)). -Apply le_max_l. -Apply H2. -Unfold R_dist; Rewrite minus_R0; Apply Rabsolu_right. -Apply Rle_sym1; Apply Rle_trans with (Rabsolu (Reste_E x y n)). -Apply Rabsolu_pos. -Apply Reste_E_maj. -Apply lt_le_trans with (1). -Apply lt_O_Sn. -Apply le_trans with (max x0 (1)). -Apply le_max_r. -Apply H2. +Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0. +intros; assert (H := maj_Reste_cv_R0 x y). +unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros. +exists (max x0 1); intros. +unfold R_dist in |- *; rewrite Rminus_0_r. +apply Rle_lt_trans with (maj_Reste_E x y n). +apply Reste_E_maj. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply le_trans with (max x0 1). +apply le_max_r. +apply H2. +replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) 0). +apply H1. +unfold ge in |- *; apply le_trans with (max x0 1). +apply le_max_l. +apply H2. +unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right. +apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)). +apply Rabs_pos. +apply Reste_E_maj. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +apply le_trans with (max x0 1). +apply le_max_r. +apply H2. Qed. (**********) -Lemma exp_plus : (x,y:R) ``(exp (x+y))==(exp x)*(exp y)``. -Intros; Assert H0 := (E1_cvg x). -Assert H := (E1_cvg y). -Assert H1 := (E1_cvg ``x+y``). -EApply UL_sequence. -Apply H1. -Assert H2 := (CV_mult ? ? ? ? H0 H). -Assert H3 := (CV_minus ? ? ? ? H2 (Reste_E_cv x y)). -Unfold Un_cv; Unfold Un_cv in H3; Intros. -Elim (H3 ? H4); Intros. -Exists (S x0); Intros. -Rewrite <- (exp_form x y n). -Rewrite minus_R0 in H5. -Apply H5. -Unfold ge; Apply le_trans with (S x0). -Apply le_n_Sn. -Apply H6. -Apply lt_le_trans with (S x0). -Apply lt_O_Sn. -Apply H6. +Lemma exp_plus : forall x y:R, exp (x + y) = exp x * exp y. +intros; assert (H0 := E1_cvg x). +assert (H := E1_cvg y). +assert (H1 := E1_cvg (x + y)). +eapply UL_sequence. +apply H1. +assert (H2 := CV_mult _ _ _ _ H0 H). +assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)). +unfold Un_cv in |- *; unfold Un_cv in H3; intros. +elim (H3 _ H4); intros. +exists (S x0); intros. +rewrite <- (exp_form x y n). +rewrite Rminus_0_r in H5. +apply H5. +unfold ge in |- *; apply le_trans with (S x0). +apply le_n_Sn. +apply H6. +apply lt_le_trans with (S x0). +apply lt_O_Sn. +apply H6. Qed. (**********) -Lemma exp_pos_pos : (x:R) ``0<x`` -> ``0<(exp x)``. -Intros; Pose An := [N:nat]``/(INR (fact N))*(pow x N)``. -Cut (Un_cv [n:nat](sum_f_R0 An n) (exp x)). -Intro; Apply Rlt_le_trans with (sum_f_R0 An O). -Unfold An; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Apply Rlt_R0_R1. -Apply sum_incr. -Assumption. -Intro; Unfold An; Left; Apply Rmult_lt_pos. -Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply (pow_lt ? n H). -Unfold exp; Unfold projT1; Case (exist_exp x); Intro. -Unfold exp_in; Unfold infinit_sum Un_cv; Trivial. +Lemma exp_pos_pos : forall x:R, 0 < x -> 0 < exp x. +intros; pose (An := fun N:nat => / INR (fact N) * x ^ N). +cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)). +intro; apply Rlt_le_trans with (sum_f_R0 An 0). +unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; + apply Rlt_0_1. +apply sum_incr. +assumption. +intro; unfold An in |- *; left; apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply (pow_lt _ n H). +unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro. +unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial. Qed. (**********) -Lemma exp_pos : (x:R) ``0<(exp x)``. -Intro; Case (total_order_T R0 x); Intro. -Elim s; Intro. -Apply (exp_pos_pos ? a). -Rewrite <- b; Rewrite exp_0; Apply Rlt_R0_R1. -Replace (exp x) with ``1/(exp (-x))``. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rlt_R0_R1. -Apply Rlt_Rinv; Apply exp_pos_pos. -Apply (Rgt_RO_Ropp ? r). -Cut ``(exp (-x))<>0``. -Intro; Unfold Rdiv; Apply r_Rmult_mult with ``(exp (-x))``. -Rewrite Rmult_1l; Rewrite <- Rinv_r_sym. -Rewrite <- exp_plus. -Rewrite Rplus_Ropp_l; Rewrite exp_0; Reflexivity. -Apply H. -Apply H. -Assert H := (exp_plus x ``-x``). -Rewrite Rplus_Ropp_r in H; Rewrite exp_0 in H. -Red; Intro; Rewrite H0 in H. -Rewrite Rmult_Or in H. -Elim R1_neq_R0; Assumption. +Lemma exp_pos : forall x:R, 0 < exp x. +intro; case (total_order_T 0 x); intro. +elim s; intro. +apply (exp_pos_pos _ a). +rewrite <- b; rewrite exp_0; apply Rlt_0_1. +replace (exp x) with (1 / exp (- x)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rlt_0_1. +apply Rinv_0_lt_compat; apply exp_pos_pos. +apply (Ropp_0_gt_lt_contravar _ r). +cut (exp (- x) <> 0). +intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)). +rewrite Rmult_1_l; rewrite <- Rinv_r_sym. +rewrite <- exp_plus. +rewrite Rplus_opp_l; rewrite exp_0; reflexivity. +apply H. +apply H. +assert (H := exp_plus x (- x)). +rewrite Rplus_opp_r in H; rewrite exp_0 in H. +red in |- *; intro; rewrite H0 in H. +rewrite Rmult_0_r in H. +elim R1_neq_R0; assumption. Qed. (* ((exp h)-1)/h -> 0 quand h->0 *) -Lemma derivable_pt_lim_exp_0 : (derivable_pt_lim exp ``0`` ``1``). -Unfold derivable_pt_lim; Intros. -Pose fn := [N:nat][x:R]``(pow x N)/(INR (fact (S N)))``. -Cut (CVN_R fn). -Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)). -Intro cv; Cut ((n:nat)(continuity (fn n))). -Intro; Cut (continuity (SFL fn cv)). -Intro; Unfold continuity in H1. -Assert H2 := (H1 R0). -Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2. -Elim (H2 ? H); Intros alp H3. -Elim H3; Intros. -Exists (mkposreal ? H4); Intros. -Rewrite Rplus_Ol; Rewrite exp_0. -Replace ``((exp h)-1)/h`` with (SFL fn cv h). -Replace R1 with (SFL fn cv R0). -Apply H5. -Split. -Unfold D_x no_cond; Split. -Trivial. -Apply (not_sym ? ? H6). -Rewrite minus_R0; Apply H7. -Unfold SFL. -Case (cv ``0``); Intros. -EApply UL_sequence. -Apply u. -Unfold Un_cv SP. -Intros; Exists (1); Intros. -Unfold R_dist; Rewrite decomp_sum. -Rewrite (Rplus_sym (fn O R0)). -Replace (fn O R0) with R1. -Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or. -Replace (sum_f_R0 [i:nat](fn (S i) ``0``) (pred n)) with R0. -Rewrite Rabsolu_R0; Apply H8. -Symmetry; Apply sum_eq_R0; Intros. -Unfold fn. -Simpl. -Unfold Rdiv; Do 2 Rewrite Rmult_Ol; Reflexivity. -Unfold fn; Simpl. -Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity. -Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H9]. -Unfold SFL exp. -Unfold projT1. -Case (cv h); Case (exist_exp h); Intros. -EApply UL_sequence. -Apply u. -Unfold Un_cv; Intros. -Unfold exp_in in e. -Unfold infinit_sum in e. -Cut ``0<eps0*(Rabsolu h)``. -Intro; Elim (e ? H9); Intros N0 H10. -Exists N0; Intros. -Unfold R_dist. -Apply Rlt_monotony_contra with ``(Rabsolu h)``. -Apply Rabsolu_pos_lt; Assumption. -Rewrite <- Rabsolu_mult. -Rewrite Rminus_distr. -Replace ``h*(x-1)/h`` with ``(x-1)``. -Unfold R_dist in H10. -Replace ``h*(SP fn n h)-(x-1)`` with (Rminus (sum_f_R0 [i:nat]``/(INR (fact i))*(pow h i)`` (S n)) x). -Rewrite (Rmult_sym (Rabsolu h)). -Apply H10. -Unfold ge. -Apply le_trans with (S N0). -Apply le_n_Sn. -Apply le_n_S; Apply H11. -Rewrite decomp_sum. -Replace ``/(INR (fact O))*(pow h O)`` with R1. -Unfold Rminus. -Rewrite Ropp_distr1. -Rewrite Ropp_Ropp. -Rewrite <- (Rplus_sym ``-x``). -Rewrite <- (Rplus_sym ``-x+1``). -Rewrite Rplus_assoc; Repeat Apply Rplus_plus_r. -Replace (pred (S n)) with n; [Idtac | Reflexivity]. -Unfold SP. -Rewrite scal_sum. -Apply sum_eq; Intros. -Unfold fn. -Replace (pow h (S i)) with ``h*(pow h i)``. -Unfold Rdiv; Ring. -Simpl; Ring. -Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity. -Apply lt_O_Sn. -Unfold Rdiv. -Rewrite <- Rmult_assoc. -Symmetry; Apply Rinv_r_simpl_m. -Assumption. -Apply Rmult_lt_pos. -Apply H8. -Apply Rabsolu_pos_lt; Assumption. -Apply SFL_continuity; Assumption. -Intro; Unfold fn. -Replace [x:R]``(pow x n)/(INR (fact (S n)))`` with (div_fct (pow_fct n) (fct_cte (INR (fact (S n))))); [Idtac | Reflexivity]. -Apply continuity_div. -Apply derivable_continuous; Apply (derivable_pow n). -Apply derivable_continuous; Apply derivable_const. -Intro; Unfold fct_cte; Apply INR_fact_neq_0. -Apply (CVN_R_CVS ? X). -Assert H0 := Alembert_exp. -Unfold CVN_R. -Intro; Unfold CVN_r. -Apply Specif.existT with [N:nat]``(pow r N)/(INR (fact (S N)))``. -Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``(pow r k)/(INR (fact (S k)))``) n) l)). -Intro. -Elim X; Intros. -Exists x; Intros. -Split. -Apply p. -Unfold Boule; Intros. -Rewrite minus_R0 in H1. -Unfold fn. -Unfold Rdiv; Rewrite Rabsolu_mult. -Cut ``0<(INR (fact (S n)))``. -Intro. -Rewrite (Rabsolu_right ``/(INR (fact (S n)))``). -Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S n)))``). -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply H2. -Rewrite <- Pow_Rabsolu. -Apply pow_maj_Rabs. -Rewrite Rabsolu_Rabsolu; Left; Apply H1. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply H2. -Apply INR_fact_lt_0. -Cut (r::R)<>``0``. -Intro; Apply Alembert_C2. -Intro; Apply Rabsolu_no_R0. -Unfold Rdiv; Apply prod_neq_R0. -Apply pow_nonzero; Assumption. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Unfold Un_cv in H0. -Unfold Un_cv; Intros. -Cut ``0<eps0/r``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply (cond_pos r)]]. -Elim (H0 ? H3); Intros N0 H4. -Exists N0; Intros. -Cut (ge (S n) N0). -Intro hyp_sn. -Assert H6 := (H4 ? hyp_sn). -Unfold R_dist in H6; Rewrite minus_R0 in H6. -Rewrite Rabsolu_Rabsolu in H6. -Unfold R_dist; Rewrite minus_R0. -Rewrite Rabsolu_Rabsolu. -Replace ``(Rabsolu ((pow r (S n))/(INR (fact (S (S n))))))/ - (Rabsolu ((pow r n)/(INR (fact (S n)))))`` with ``r*/(INR (fact (S (S n))))*//(INR (fact (S n)))``. -Rewrite Rmult_assoc; Rewrite Rabsolu_mult. -Rewrite (Rabsolu_right r). -Apply Rlt_monotony_contra with ``/r``. -Apply Rlt_Rinv; Apply (cond_pos r). -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps0). -Apply H6. -Assumption. -Apply Rle_sym1; Left; Apply (cond_pos r). -Unfold Rdiv. -Repeat Rewrite Rabsolu_mult. -Repeat Rewrite Rabsolu_Rinv. -Rewrite Rinv_Rmult. -Repeat Rewrite Rabsolu_right. -Rewrite Rinv_Rinv. -Rewrite (Rmult_sym r). -Rewrite (Rmult_sym (pow r (S n))). -Repeat Rewrite Rmult_assoc. -Apply Rmult_mult_r. -Rewrite (Rmult_sym r). -Rewrite <- Rmult_assoc; Rewrite <- (Rmult_sym (INR (fact (S n)))). -Apply Rmult_mult_r. -Simpl. -Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Ring. -Apply pow_nonzero; Assumption. -Apply INR_fact_neq_0. -Apply Rle_sym1; Left; Apply INR_fact_lt_0. -Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r). -Apply Rle_sym1; Left; Apply INR_fact_lt_0. -Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r). -Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption. -Apply Rinv_neq_R0; Apply Rabsolu_no_R0; Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Unfold ge; Apply le_trans with n. -Apply H5. -Apply le_n_Sn. -Assert H1 := (cond_pos r); Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1). +Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1. +unfold derivable_pt_lim in |- *; intros. +pose (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))). +cut (CVN_R fn). +intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). +intro cv; cut (forall n:nat, continuity (fn n)). +intro; cut (continuity (SFL fn cv)). +intro; unfold continuity in H1. +assert (H2 := H1 0). +unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. +elim (H2 _ H); intros alp H3. +elim H3; intros. +exists (mkposreal _ H4); intros. +rewrite Rplus_0_l; rewrite exp_0. +replace ((exp h - 1) / h) with (SFL fn cv h). +replace 1 with (SFL fn cv 0). +apply H5. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq H6). +rewrite Rminus_0_r; apply H7. +unfold SFL in |- *. +case (cv 0); intros. +eapply UL_sequence. +apply u. +unfold Un_cv, SP in |- *. +intros; exists 1%nat; intros. +unfold R_dist in |- *; rewrite decomp_sum. +rewrite (Rplus_comm (fn 0%nat 0)). +replace (fn 0%nat 0) with 1. +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_r. +replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0. +rewrite Rabs_R0; apply H8. +symmetry in |- *; apply sum_eq_R0; intros. +unfold fn in |- *. +simpl in |- *. +unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity. +unfold fn in |- *; simpl in |- *. +unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. +apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ]. +unfold SFL, exp in |- *. +unfold projT1 in |- *. +case (cv h); case (exist_exp h); intros. +eapply UL_sequence. +apply u. +unfold Un_cv in |- *; intros. +unfold exp_in in e. +unfold infinit_sum in e. +cut (0 < eps0 * Rabs h). +intro; elim (e _ H9); intros N0 H10. +exists N0; intros. +unfold R_dist in |- *. +apply Rmult_lt_reg_l with (Rabs h). +apply Rabs_pos_lt; assumption. +rewrite <- Rabs_mult. +rewrite Rmult_minus_distr_l. +replace (h * ((x - 1) / h)) with (x - 1). +unfold R_dist in H10. +replace (h * SP fn n h - (x - 1)) with + (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x). +rewrite (Rmult_comm (Rabs h)). +apply H10. +unfold ge in |- *. +apply le_trans with (S N0). +apply le_n_Sn. +apply le_n_S; apply H11. +rewrite decomp_sum. +replace (/ INR (fact 0) * h ^ 0) with 1. +unfold Rminus in |- *. +rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +rewrite <- (Rplus_comm (- x)). +rewrite <- (Rplus_comm (- x + 1)). +rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l. +replace (pred (S n)) with n; [ idtac | reflexivity ]. +unfold SP in |- *. +rewrite scal_sum. +apply sum_eq; intros. +unfold fn in |- *. +replace (h ^ S i) with (h * h ^ i). +unfold Rdiv in |- *; ring. +simpl in |- *; ring. +simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. +apply lt_O_Sn. +unfold Rdiv in |- *. +rewrite <- Rmult_assoc. +symmetry in |- *; apply Rinv_r_simpl_m. +assumption. +apply Rmult_lt_0_compat. +apply H8. +apply Rabs_pos_lt; assumption. +apply SFL_continuity; assumption. +intro; unfold fn in |- *. +replace (fun x:R => x ^ n / INR (fact (S n))) with + (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ]. +apply continuity_div. +apply derivable_continuous; apply (derivable_pow n). +apply derivable_continuous; apply derivable_const. +intro; unfold fct_cte in |- *; apply INR_fact_neq_0. +apply (CVN_R_CVS _ X). +assert (H0 := Alembert_exp). +unfold CVN_R in |- *. +intro; unfold CVN_r in |- *. +apply existT with (fun N:nat => r ^ N / INR (fact (S N))). +cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)). +intro. +elim X; intros. +exists x; intros. +split. +apply p. +unfold Boule in |- *; intros. +rewrite Rminus_0_r in H1. +unfold fn in |- *. +unfold Rdiv in |- *; rewrite Rabs_mult. +cut (0 < INR (fact (S n))). +intro. +rewrite (Rabs_right (/ INR (fact (S n)))). +do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))). +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply H2. +rewrite <- RPow_abs. +apply pow_maj_Rabs. +rewrite Rabs_Rabsolu; left; apply H1. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2. +apply INR_fact_lt_0. +cut ((r:R) <> 0). +intro; apply Alembert_C2. +intro; apply Rabs_no_R0. +unfold Rdiv in |- *; apply prod_neq_R0. +apply pow_nonzero; assumption. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +unfold Un_cv in H0. +unfold Un_cv in |- *; intros. +cut (0 < eps0 / r); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ]. +elim (H0 _ H3); intros N0 H4. +exists N0; intros. +cut (S n >= N0)%nat. +intro hyp_sn. +assert (H6 := H4 _ hyp_sn). +unfold R_dist in H6; rewrite Rminus_0_r in H6. +rewrite Rabs_Rabsolu in H6. +unfold R_dist in |- *; rewrite Rminus_0_r. +rewrite Rabs_Rabsolu. +replace + (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n)))) + with (r * / INR (fact (S (S n))) * / / INR (fact (S n))). +rewrite Rmult_assoc; rewrite Rabs_mult. +rewrite (Rabs_right r). +apply Rmult_lt_reg_l with (/ r). +apply Rinv_0_lt_compat; apply (cond_pos r). +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0). +apply H6. +assumption. +apply Rle_ge; left; apply (cond_pos r). +unfold Rdiv in |- *. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv. +rewrite Rinv_mult_distr. +repeat rewrite Rabs_right. +rewrite Rinv_involutive. +rewrite (Rmult_comm r). +rewrite (Rmult_comm (r ^ S n)). +repeat rewrite Rmult_assoc. +apply Rmult_eq_compat_l. +rewrite (Rmult_comm r). +rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))). +apply Rmult_eq_compat_l. +simpl in |- *. +rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +ring. +apply pow_nonzero; assumption. +apply INR_fact_neq_0. +apply Rle_ge; left; apply INR_fact_lt_0. +apply Rle_ge; left; apply pow_lt; apply (cond_pos r). +apply Rle_ge; left; apply INR_fact_lt_0. +apply Rle_ge; left; apply pow_lt; apply (cond_pos r). +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +unfold ge in |- *; apply le_trans with n. +apply H5. +apply le_n_Sn. +assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1; + elim (Rlt_irrefl _ H1). Qed. (**********) -Lemma derivable_pt_lim_exp : (x:R) (derivable_pt_lim exp x (exp x)). -Intro; Assert H0 := derivable_pt_lim_exp_0. -Unfold derivable_pt_lim in H0; Unfold derivable_pt_lim; Intros. -Cut ``0<eps/(exp x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply exp_pos]]. -Elim (H0 ? H1); Intros del H2. -Exists del; Intros. -Assert H5 := (H2 ? H3 H4). -Rewrite Rplus_Ol in H5; Rewrite exp_0 in H5. -Replace ``((exp (x+h))-(exp x))/h-(exp x)`` with ``(exp x)*(((exp h)-1)/h-1)``. -Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (exp x)). -Apply Rlt_monotony_contra with ``/(exp x)``. -Apply Rlt_Rinv; Apply exp_pos. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps). -Apply H5. -Assert H6 := (exp_pos x); Red; Intro; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6). -Apply Rle_sym1; Left; Apply exp_pos. -Rewrite Rminus_distr. -Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rminus_distr. -Rewrite Rmult_1r; Rewrite exp_plus; Reflexivity. -Qed. +Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x). +intro; assert (H0 := derivable_pt_lim_exp_0). +unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros. +cut (0 < eps / exp x); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ]. +elim (H0 _ H1); intros del H2. +exists del; intros. +assert (H5 := H2 _ H3 H4). +rewrite Rplus_0_l in H5; rewrite exp_0 in H5. +replace ((exp (x + h) - exp x) / h - exp x) with + (exp x * ((exp h - 1) / h - 1)). +rewrite Rabs_mult; rewrite (Rabs_right (exp x)). +apply Rmult_lt_reg_l with (/ exp x). +apply Rinv_0_lt_compat; apply exp_pos. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). +apply H5. +assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6; + elim (Rlt_irrefl _ H6). +apply Rle_ge; left; apply exp_pos. +rewrite Rmult_minus_distr_l. +rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rmult_minus_distr_l. +rewrite Rmult_1_r; rewrite exp_plus; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v index 330d53812..5eab01e5b 100644 --- a/theories/Reals/MVT.v +++ b/theories/Reals/MVT.v @@ -8,510 +8,692 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Ranalysis1. -Require Rtopology. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import Rtopology. Open Local Scope R_scope. (* The Mean Value Theorem *) -Theorem MVT : (f,g:R->R;a,b:R;pr1:(c:R)``a<c<b``->(derivable_pt f c);pr2:(c:R)``a<c<b``->(derivable_pt g c)) ``a<b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> ((c:R)``a<=c<=b``->(continuity_pt g c)) -> (EXT c : R | (EXT P : ``a<c<b`` | ``((g b)-(g a))*(derive_pt f c (pr1 c P))==((f b)-(f a))*(derive_pt g c (pr2 c P))``)). -Intros; Assert H2 := (Rlt_le ? ? H). -Pose h := [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)``. -Cut (c:R)``a<c<b``->(derivable_pt h c). -Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt h c)). -Intro; Assert H4 := (continuity_ab_maj h a b H2 H3). -Assert H5 := (continuity_ab_min h a b H2 H3). -Elim H4; Intros Mx H6. -Elim H5; Intros mx H7. -Cut (h a)==(h b). -Intro; Pose M := (h Mx); Pose m := (h mx). -Cut (c:R;P:``a<c<b``) (derive_pt h c (X c P))==``((g b)-(g a))*(derive_pt f c (pr1 c P))-((f b)-(f a))*(derive_pt g c (pr2 c P))``. -Intro; Case (Req_EM (h a) M); Intro. -Case (Req_EM (h a) m); Intro. -Cut ((c:R)``a<=c<=b``->(h c)==M). -Intro; Cut ``a<(a+b)/2<b``. +Theorem MVT : + forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c) + (pr2:forall c:R, a < c < b -> derivable_pt g c), + a < b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + (forall c:R, a <= c <= b -> continuity_pt g c) -> + exists c : R + | ( exists P : a < c < b + | (g b - g a) * derive_pt f c (pr1 c P) = + (f b - f a) * derive_pt g c (pr2 c P)). +intros; assert (H2 := Rlt_le _ _ H). +pose (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y). +cut (forall c:R, a < c < b -> derivable_pt h c). +intro; cut (forall c:R, a <= c <= b -> continuity_pt h c). +intro; assert (H4 := continuity_ab_maj h a b H2 H3). +assert (H5 := continuity_ab_min h a b H2 H3). +elim H4; intros Mx H6. +elim H5; intros mx H7. +cut (h a = h b). +intro; pose (M := h Mx); pose (m := h mx). +cut + (forall (c:R) (P:a < c < b), + derive_pt h c (X c P) = + (g b - g a) * derive_pt f c (pr1 c P) - + (f b - f a) * derive_pt g c (pr2 c P)). +intro; case (Req_dec (h a) M); intro. +case (Req_dec (h a) m); intro. +cut (forall c:R, a <= c <= b -> h c = M). +intro; cut (a < (a + b) / 2 < b). (*** h constant ***) -Intro; Exists ``(a+b)/2``. -Exists H13. -Apply Rminus_eq; Rewrite <- H9; Apply deriv_constant2 with a b. -Elim H13; Intros; Assumption. -Elim H13; Intros; Assumption. -Intros; Rewrite (H12 ``(a+b)/2``). -Apply H12; Split; Left; Assumption. -Elim H13; Intros; Split; Left; Assumption. -Split. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H. -DiscrR. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite Rplus_sym; Rewrite double; Apply Rlt_compatibility; Apply H. -DiscrR. -Intros; Elim H6; Intros H13 _. -Elim H7; Intros H14 _. -Apply Rle_antisym. -Apply H13; Apply H12. -Rewrite H10 in H11; Rewrite H11; Apply H14; Apply H12. -Cut ``a<mx<b``. +intro; exists ((a + b) / 2). +exists H13. +apply Rminus_diag_uniq; rewrite <- H9; apply deriv_constant2 with a b. +elim H13; intros; assumption. +elim H13; intros; assumption. +intros; rewrite (H12 ((a + b) / 2)). +apply H12; split; left; assumption. +elim H13; intros; split; left; assumption. +split. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H. +discrR. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double; + apply Rplus_lt_compat_l; apply H. +discrR. +intros; elim H6; intros H13 _. +elim H7; intros H14 _. +apply Rle_antisym. +apply H13; apply H12. +rewrite H10 in H11; rewrite H11; apply H14; apply H12. +cut (a < mx < b). (*** h admet un minimum global sur [a,b] ***) -Intro; Exists mx. -Exists H12. -Apply Rminus_eq; Rewrite <- H9; Apply deriv_minimum with a b. -Elim H12; Intros; Assumption. -Elim H12; Intros; Assumption. -Intros; Elim H7; Intros. -Apply H15; Split; Left; Assumption. -Elim H7; Intros _ H12; Elim H12; Intros; Split. -Inversion H13. -Apply H15. -Rewrite H15 in H11; Elim H11; Reflexivity. -Inversion H14. -Apply H15. -Rewrite H8 in H11; Rewrite <- H15 in H11; Elim H11; Reflexivity. -Cut ``a<Mx<b``. +intro; exists mx. +exists H12. +apply Rminus_diag_uniq; rewrite <- H9; apply deriv_minimum with a b. +elim H12; intros; assumption. +elim H12; intros; assumption. +intros; elim H7; intros. +apply H15; split; left; assumption. +elim H7; intros _ H12; elim H12; intros; split. +inversion H13. +apply H15. +rewrite H15 in H11; elim H11; reflexivity. +inversion H14. +apply H15. +rewrite H8 in H11; rewrite <- H15 in H11; elim H11; reflexivity. +cut (a < Mx < b). (*** h admet un maximum global sur [a,b] ***) -Intro; Exists Mx. -Exists H11. -Apply Rminus_eq; Rewrite <- H9; Apply deriv_maximum with a b. -Elim H11; Intros; Assumption. -Elim H11; Intros; Assumption. -Intros; Elim H6; Intros; Apply H14. -Split; Left; Assumption. -Elim H6; Intros _ H11; Elim H11; Intros; Split. -Inversion H12. -Apply H14. -Rewrite H14 in H10; Elim H10; Reflexivity. -Inversion H13. -Apply H14. -Rewrite H8 in H10; Rewrite <- H14 in H10; Elim H10; Reflexivity. -Intros; Unfold h; Replace (derive_pt [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)`` c (X c P)) with (derive_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c (derivable_pt_minus ? ? ? (derivable_pt_mult ? ? ? (derivable_pt_const ``(g b)-(g a)`` c) (pr1 c P)) (derivable_pt_mult ? ? ? (derivable_pt_const ``(f b)-(f a)`` c) (pr2 c P)))); [Idtac | Apply pr_nu]. -Rewrite derive_pt_minus; Do 2 Rewrite derive_pt_mult; Do 2 Rewrite derive_pt_const; Do 2 Rewrite Rmult_Ol; Do 2 Rewrite Rplus_Ol; Reflexivity. -Unfold h; Ring. -Intros; Unfold h; Change (continuity_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c). -Apply continuity_pt_minus; Apply continuity_pt_mult. -Apply derivable_continuous_pt; Apply derivable_const. -Apply H0; Apply H3. -Apply derivable_continuous_pt; Apply derivable_const. -Apply H1; Apply H3. -Intros; Change (derivable_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c). -Apply derivable_pt_minus; Apply derivable_pt_mult. -Apply derivable_pt_const. -Apply (pr1 ? H3). -Apply derivable_pt_const. -Apply (pr2 ? H3). +intro; exists Mx. +exists H11. +apply Rminus_diag_uniq; rewrite <- H9; apply deriv_maximum with a b. +elim H11; intros; assumption. +elim H11; intros; assumption. +intros; elim H6; intros; apply H14. +split; left; assumption. +elim H6; intros _ H11; elim H11; intros; split. +inversion H12. +apply H14. +rewrite H14 in H10; elim H10; reflexivity. +inversion H13. +apply H14. +rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity. +intros; unfold h in |- *; + replace + (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P)) + with + (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c + (derivable_pt_minus _ _ _ + (derivable_pt_mult _ _ _ (derivable_pt_const (g b - g a) c) (pr1 c P)) + (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P)))); + [ idtac | apply pr_nu ]. +rewrite derive_pt_minus; do 2 rewrite derive_pt_mult; + do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; + do 2 rewrite Rplus_0_l; reflexivity. +unfold h in |- *; ring. +intros; unfold h in |- *; + change + (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) + c) in |- *. +apply continuity_pt_minus; apply continuity_pt_mult. +apply derivable_continuous_pt; apply derivable_const. +apply H0; apply H3. +apply derivable_continuous_pt; apply derivable_const. +apply H1; apply H3. +intros; + change + (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) + c) in |- *. +apply derivable_pt_minus; apply derivable_pt_mult. +apply derivable_pt_const. +apply (pr1 _ H3). +apply derivable_pt_const. +apply (pr2 _ H3). Qed. (* Corollaries ... *) -Lemma MVT_cor1 : (f:(R->R); a,b:R; pr:(derivable f)) ``a < b``->(EXT c:R | ``(f b)-(f a) == (derive_pt f c (pr c))*(b-a)``/\``a < c < b``). -Intros f a b pr H; Cut (c:R)``a<c<b``->(derivable_pt f c); [Intro | Intros; Apply pr]. -Cut (c:R)``a<c<b``->(derivable_pt id c); [Intro | Intros; Apply derivable_pt_id]. -Cut ((c:R)``a<=c<=b``->(continuity_pt f c)); [Intro | Intros; Apply derivable_continuous_pt; Apply pr]. -Cut ((c:R)``a<=c<=b``->(continuity_pt id c)); [Intro | Intros; Apply derivable_continuous_pt; Apply derivable_id]. -Assert H2 := (MVT f id a b X X0 H H0 H1). -Elim H2; Intros c H3; Elim H3; Intros. -Exists c; Split. -Cut (derive_pt id c (X0 c x)) == (derive_pt id c (derivable_pt_id c)); [Intro | Apply pr_nu]. -Rewrite H5 in H4; Rewrite (derive_pt_id c) in H4; Rewrite Rmult_1r in H4; Rewrite <- H4; Replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); [Idtac | Apply pr_nu]; Apply Rmult_sym. -Apply x. +Lemma MVT_cor1 : + forall (f:R -> R) (a b:R) (pr:derivable f), + a < b -> + exists c : R | f b - f a = derive_pt f c (pr c) * (b - a) /\ a < c < b. +intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c); + [ intro | intros; apply pr ]. +cut (forall c:R, a < c < b -> derivable_pt id c); + [ intro | intros; apply derivable_pt_id ]. +cut (forall c:R, a <= c <= b -> continuity_pt f c); + [ intro | intros; apply derivable_continuous_pt; apply pr ]. +cut (forall c:R, a <= c <= b -> continuity_pt id c); + [ intro | intros; apply derivable_continuous_pt; apply derivable_id ]. +assert (H2 := MVT f id a b X X0 H H0 H1). +elim H2; intros c H3; elim H3; intros. +exists c; split. +cut (derive_pt id c (X0 c x) = derive_pt id c (derivable_pt_id c)); + [ intro | apply pr_nu ]. +rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4; + rewrite <- H4; replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); + [ idtac | apply pr_nu ]; apply Rmult_comm. +apply x. Qed. -Theorem MVT_cor2 : (f,f':R->R;a,b:R) ``a<b`` -> ((c:R)``a<=c<=b``->(derivable_pt_lim f c (f' c))) -> (EXT c:R | ``(f b)-(f a)==(f' c)*(b-a)``/\``a<c<b``). -Intros f f' a b H H0; Cut ((c:R)``a<=c<=b``->(derivable_pt f c)). -Intro; Cut ((c:R)``a<c<b``->(derivable_pt f c)). -Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt f c)). -Intro; Cut ((c:R)``a<=c<=b``->(derivable_pt id c)). -Intro; Cut ((c:R)``a<c<b``->(derivable_pt id c)). -Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt id c)). -Intro; Elim (MVT f id a b X0 X2 H H1 H2); Intros; Elim H3; Clear H3; Intros; Exists x; Split. -Cut (derive_pt id x (X2 x x0))==R1. -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_1r in H3; Rewrite Rmult_sym; 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. -Assumption. -Intros; Apply derivable_continuous_pt; Apply X1; Assumption. -Intros; Apply derivable_pt_id. -Intros; Apply derivable_pt_id. -Intros; Apply derivable_continuous_pt; Apply X; Assumption. -Intros; Elim H1; Intros; Apply X; Split; Left; Assumption. -Intros; Unfold derivable_pt; Apply Specif.existT with (f' c); Apply H0; Apply H1. +Theorem MVT_cor2 : + forall (f f':R -> R) (a b:R), + a < b -> + (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) -> + exists c : R | f b - f a = f' c * (b - a) /\ a < c < b. +intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c). +intro; cut (forall c:R, a < c < b -> derivable_pt f c). +intro; cut (forall c:R, a <= c <= b -> continuity_pt f c). +intro; cut (forall c:R, a <= c <= b -> derivable_pt id c). +intro; cut (forall c:R, a < c < b -> derivable_pt id c). +intro; cut (forall c:R, a <= c <= b -> continuity_pt id c). +intro; elim (MVT f id a b X0 X2 H H1 H2); intros; elim H3; clear H3; intros; + exists x; split. +cut (derive_pt id x (X2 x x0) = 1). +cut (derive_pt f x (X0 x x0) = f' x). +intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3; + rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *; + assumption. +apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption. +apply derive_pt_eq_0; apply derivable_pt_lim_id. +assumption. +intros; apply derivable_continuous_pt; apply X1; assumption. +intros; apply derivable_pt_id. +intros; apply derivable_pt_id. +intros; apply derivable_continuous_pt; apply X; assumption. +intros; elim H1; intros; apply X; split; left; assumption. +intros; unfold derivable_pt in |- *; apply existT with (f' c); apply H0; + apply H1. Qed. -Lemma MVT_cor3 : (f,f':(R->R); a,b:R) ``a < b`` -> ((x:R)``a <= x`` -> ``x <= b``->(derivable_pt_lim f x (f' x))) -> (EXT c:R | ``a<=c``/\``c<=b``/\``(f b)==(f a) + (f' c)*(b-a)``). -Intros f f' a b H H0; Assert H1 : (EXT c:R | ``(f b) -(f a) == (f' c)*(b-a)``/\``a<c<b``); [Apply MVT_cor2; [Apply H | Intros; Elim H1; Intros; Apply (H0 ? H2 H3)] | Elim H1; Intros; Exists x; Elim H2; Intros; Elim H4; Intros; Split; [Left; Assumption | Split; [Left; Assumption | Rewrite <- H3; Ring]]]. +Lemma MVT_cor3 : + forall (f f':R -> R) (a b:R), + a < b -> + (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) -> + exists c : R | a <= c /\ c <= b /\ f b = f a + f' c * (b - a). +intros f f' a b H H0; + assert (H1 : exists c : R | f b - f a = f' c * (b - a) /\ a < c < b); + [ apply MVT_cor2; [ apply H | intros; elim H1; intros; apply (H0 _ H2 H3) ] + | elim H1; intros; exists x; elim H2; intros; elim H4; intros; split; + [ left; assumption | split; [ left; assumption | rewrite <- H3; ring ] ] ]. Qed. -Lemma Rolle : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ``a<b`` -> (f a)==(f b) -> (EXT c:R | (EXT P: ``a<c<b`` | ``(derive_pt f c (pr c P))==0``)). -Intros; Assert H2 : (x:R)``a<x<b``->(derivable_pt id x). -Intros; Apply derivable_pt_id. -Assert H3 := (MVT f id a b pr H2 H0 H); Assert H4 : (x:R)``a<=x<=b``->(continuity_pt id x). -Intros; Apply derivable_continuous; Apply derivable_id. -Elim (H3 H4); Intros; Elim H5; Intros; Exists x; Exists x0; Rewrite H1 in H6; Unfold id in H6; Unfold Rminus in H6; Rewrite Rplus_Ropp_r in H6; Rewrite Rmult_Ol in H6; Apply r_Rmult_mult with ``b-a``; [Rewrite Rmult_Or; Apply H6 | Apply Rminus_eq_contra; Red; Intro; Rewrite H7 in H0; Elim (Rlt_antirefl ? H0)]. +Lemma Rolle : + forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + a < b -> + f a = f b -> + exists c : R | ( exists P : a < c < b | derive_pt f c (pr c P) = 0). +intros; assert (H2 : forall x:R, a < x < b -> derivable_pt id x). +intros; apply derivable_pt_id. +assert (H3 := MVT f id a b pr H2 H0 H); + assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x). +intros; apply derivable_continuous; apply derivable_id. +elim (H3 H4); intros; elim H5; intros; exists x; exists x0; rewrite H1 in H6; + unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6; + rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a); + [ rewrite Rmult_0_r; apply H6 + | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0; + elim (Rlt_irrefl _ H0) ]. Qed. (**********) -Lemma nonneg_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``0<=(derive_pt f x (pr x))``) -> (increasing f). -Intros. -Unfold increasing. -Intros. -Case (total_order_T x y); Intro. -Elim s; Intro. -Apply Rle_anti_compatibility with ``-(f x)``. -Rewrite Rplus_Ropp_l; Rewrite Rplus_sym. -Assert H1 := (MVT_cor1 f ? ? pr a). -Elim H1; Intros. -Elim H2; Intros. -Unfold Rminus in H3. -Rewrite H3. -Apply Rmult_le_pos. -Apply H. -Apply Rle_anti_compatibility with x. -Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring]. -Rewrite b; Right; Reflexivity. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)). +Lemma nonneg_derivative_1 : + forall (f:R -> R) (pr:derivable f), + (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f. +intros. +unfold increasing in |- *. +intros. +case (total_order_T x y); intro. +elim s; intro. +apply Rplus_le_reg_l with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H1 := MVT_cor1 f _ _ pr a). +elim H1; intros. +elim H2; intros. +unfold Rminus in H3. +rewrite H3. +apply Rmult_le_pos. +apply H. +apply Rplus_le_reg_l with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. +rewrite b; right; reflexivity. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). Qed. (**********) -Lemma nonpos_derivative_0 : (f:R->R;pr:(derivable f)) (decreasing f) -> ((x:R) ``(derive_pt f x (pr x))<=0``). -Intros f pr H x; Assert H0 :=H; Unfold decreasing in H0; Generalize (derivable_derive f x (pr x)); Intro; Elim H1; Intros l H2. -Rewrite H2; Case (total_order l R0); Intro. -Left; Assumption. -Elim H3; Intro. -Right; Assumption. -Generalize (derive_pt_eq_1 f x l (pr x) H2); Intros; Cut ``0< (l/2)``. -Intro; Elim (H5 ``(l/2)`` H6); Intros delta H7; Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``. -Intro; Decompose [and] H8; Intros; Generalize (H7 ``delta/2`` H9 H12); Cut ``((f (x+delta/2))-(f x))/(delta/2)<=0``. -Intro; Cut ``0< -(((f (x+delta/2))-(f x))/(delta/2)-l)``. -Intro; Unfold Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``). -Intros; Generalize (Rlt_compatibility_r ``-l`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``(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))``. -Intro. -Generalize (Rlt_Ropp ``-(((f (x+delta/2))+ -(f x))/(delta/2))`` ``-(l/2)`` H15). -Repeat Rewrite Ropp_Ropp. -Intro. -Generalize (Rlt_trans ``0`` ``l/2`` ``((f (x+delta/2))-(f x))/(delta/2)`` H6 H16); Intro. -Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``0`` H17 H10)). -Ring. -Pattern 3 l; Rewrite double_var. -Ring. -Intros. -Generalize (Rge_Ropp ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` r). -Rewrite Ropp_O. -Intro. -Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``0`` H13 H15)). -Replace ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` with ``(((f (x))-(f (x+delta/2)))/(delta/2)) +l``. -Unfold Rminus. -Apply ge0_plus_gt0_is_gt0. -Unfold Rdiv; Apply Rmult_le_pos. -Cut ``x<=(x+(delta*/2))``. -Intro; Generalize (H0 x ``x+(delta*/2)`` H13); Intro; Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H14); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption. -Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption. -Left; Apply Rlt_Rinv; Assumption. -Assumption. -Rewrite Ropp_distr2. -Unfold Rminus. -Rewrite (Rplus_sym l). -Unfold Rdiv. -Rewrite <- Ropp_mul1. -Rewrite Ropp_distr1. -Rewrite Ropp_Ropp. -Rewrite (Rplus_sym (f x)). -Reflexivity. -Replace ``((f (x+delta/2))-(f x))/(delta/2)`` with ``-(((f x)-(f (x+delta/2)))/(delta/2))``. -Rewrite <- Ropp_O. -Apply Rge_Ropp. -Apply Rle_sym1. -Unfold Rdiv; Apply Rmult_le_pos. -Cut ``x<=(x+(delta*/2))``. -Intro; Generalize (H0 x ``x+(delta*/2)`` H10); Intro. -Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption. -Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption. -Left; Apply Rlt_Rinv; Assumption. -Unfold Rdiv; Rewrite <- Ropp_mul1. -Rewrite Ropp_distr2. -Reflexivity. -Split. -Unfold Rdiv; Apply prod_neq_R0. -Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H8; Elim (Rlt_antirefl ``0`` H8). -Apply Rinv_neq_R0; DiscrR. -Split. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0]. -Rewrite Rabsolu_right. -Unfold Rdiv; Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite double; Pattern 1 (pos delta); Rewrite <- Rplus_Or. -Apply Rlt_compatibility; Apply (cond_pos delta). -DiscrR. -Apply Rle_sym1; Unfold Rdiv; Left; Apply Rmult_lt_pos. -Apply (cond_pos delta). -Apply Rlt_Rinv; Sup0. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply H4 | Apply Rlt_Rinv; Sup0]. +Lemma nonpos_derivative_0 : + forall (f:R -> R) (pr:derivable f), + decreasing f -> forall x:R, derive_pt f x (pr x) <= 0. +intros f pr H x; assert (H0 := H); unfold decreasing in H0; + generalize (derivable_derive f x (pr x)); intro; elim H1; + intros l H2. +rewrite H2; case (Rtotal_order l 0); intro. +left; assumption. +elim H3; intro. +right; assumption. +generalize (derive_pt_eq_1 f x l (pr x) H2); intros; cut (0 < l / 2). +intro; elim (H5 (l / 2) H6); intros delta H7; + cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). +intro; decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12); + cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0). +intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)). +intro; unfold Rabs in |- *; + case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). +intros; + generalize + (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) + (l / 2) H14); unfold Rminus in |- *. +replace (l / 2 + - l) with (- (l / 2)). +replace (- ((f (x + delta / 2) + - f x) / (delta / 2) + - l) + - l) with + (- ((f (x + delta / 2) + - f x) / (delta / 2))). +intro. +generalize + (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2))) + (- (l / 2)) H15). +repeat rewrite Ropp_involutive. +intro. +generalize + (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16); + intro. +elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)). +ring. +pattern l at 3 in |- *; rewrite double_var. +ring. +intros. +generalize + (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r). +rewrite Ropp_0. +intro. +elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) 0 H13 + H15)). +replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with + ((f x - f (x + delta / 2)) / (delta / 2) + l). +unfold Rminus in |- *. +apply Rplus_le_lt_0_compat. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H0 x (x + delta * / 2) H13); intro; + generalize + (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +assumption. +rewrite Ropp_minus_distr. +unfold Rminus in |- *. +rewrite (Rplus_comm l). +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +rewrite (Rplus_comm (f x)). +reflexivity. +replace ((f (x + delta / 2) - f x) / (delta / 2)) with + (- ((f x - f (x + delta / 2)) / (delta / 2))). +rewrite <- Ropp_0. +apply Ropp_ge_le_contravar. +apply Rle_ge. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H0 x (x + delta * / 2) H10); intro. +generalize + (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. +rewrite Ropp_minus_distr. +reflexivity. +split. +unfold Rdiv in |- *; apply prod_neq_R0. +generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8; + elim (Rlt_irrefl 0 H8). +apply Rinv_neq_0_compat; discrR. +split. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +rewrite Rabs_right. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *; + rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l; apply (cond_pos delta). +discrR. +apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat. +apply (cond_pos delta). +apply Rinv_0_lt_compat; prove_sup0. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. (**********) -Lemma increasing_decreasing_opp : (f:R->R) (increasing f) -> (decreasing (opp_fct f)). -Unfold increasing decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rge_Ropp; Apply Rle_sym1; Assumption. +Lemma increasing_decreasing_opp : + forall f:R -> R, increasing f -> decreasing (- f)%F. +unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0); + intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption. Qed. (**********) -Lemma nonpos_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<=0``) -> (decreasing f). -Intros. -Cut (h:R)``-(-(f h))==(f h)``. -Intro. -Generalize (increasing_decreasing_opp (opp_fct f)). -Unfold decreasing. -Unfold opp_fct. -Intros. -Rewrite <- (H0 x); Rewrite <- (H0 y). -Apply H1. -Cut (x:R)``0<=(derive_pt (opp_fct f) x ((derivable_opp f pr) x))``. -Intros. -Replace [x:R]``-(f x)`` with (opp_fct f); [Idtac | Reflexivity]. -Apply (nonneg_derivative_1 (opp_fct f) (derivable_opp f pr) H3). -Intro. -Assert H3 := (derive_pt_opp f x0 (pr x0)). -Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``. -Intro. -Rewrite <- H4. -Rewrite H3. -Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Apply (H x0). -Apply pr_nu. -Assumption. -Intro; Ring. +Lemma nonpos_derivative_1 : + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f. +intros. +cut (forall h:R, - - f h = f h). +intro. +generalize (increasing_decreasing_opp (- f)%F). +unfold decreasing in |- *. +unfold opp_fct in |- *. +intros. +rewrite <- (H0 x); rewrite <- (H0 y). +apply H1. +cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)). +intros. +replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ]. +apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3). +intro. +assert (H3 := derive_pt_opp f x0 (pr x0)). +cut + (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = + derive_pt (- f) x0 (derivable_opp f pr x0)). +intro. +rewrite <- H4. +rewrite H3. +rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0). +apply pr_nu. +assumption. +intro; ring. Qed. (**********) -Lemma positive_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``0<(derive_pt f x (pr x))``)->(strict_increasing f). -Intros. -Unfold strict_increasing. -Intros. -Apply Rlt_anti_compatibility with ``-(f x)``. -Rewrite Rplus_Ropp_l; Rewrite Rplus_sym. -Assert H1 := (MVT_cor1 f ? ? pr H0). -Elim H1; Intros. -Elim H2; Intros. -Unfold Rminus in H3. -Rewrite H3. -Apply Rmult_lt_pos. -Apply H. -Apply Rlt_anti_compatibility with x. -Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring]. +Lemma positive_derivative : + forall (f:R -> R) (pr:derivable f), + (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f. +intros. +unfold strict_increasing in |- *. +intros. +apply Rplus_lt_reg_r with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H1 := MVT_cor1 f _ _ pr H0). +elim H1; intros. +elim H2; intros. +unfold Rminus in H3. +rewrite H3. +apply Rmult_lt_0_compat. +apply H. +apply Rplus_lt_reg_r with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. Qed. (**********) -Lemma strictincreasing_strictdecreasing_opp : (f:R->R) (strict_increasing f) -> -(strict_decreasing (opp_fct f)). -Unfold strict_increasing strict_decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rlt_Ropp; Assumption. +Lemma strictincreasing_strictdecreasing_opp : + forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. +unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros; + generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; + assumption. Qed. (**********) -Lemma negative_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<0``)->(strict_decreasing f). -Intros. -Cut (h:R)``- (-(f h))==(f h)``. -Intros. -Generalize (strictincreasing_strictdecreasing_opp (opp_fct f)). -Unfold strict_decreasing opp_fct. -Intros. -Rewrite <- (H0 x). -Rewrite <- (H0 y). -Apply H1; [Idtac | Assumption]. -Cut (x:R)``0<(derive_pt (opp_fct f) x (derivable_opp f pr x))``. -Intros; EApply positive_derivative; Apply H3. -Intro. -Assert H3 := (derive_pt_opp f x0 (pr x0)). -Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``. -Intro. -Rewrite <- H4; Rewrite H3. -Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply (H x0). -Apply pr_nu. -Intro; Ring. +Lemma negative_derivative : + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f. +intros. +cut (forall h:R, - - f h = f h). +intros. +generalize (strictincreasing_strictdecreasing_opp (- f)%F). +unfold strict_decreasing, opp_fct in |- *. +intros. +rewrite <- (H0 x). +rewrite <- (H0 y). +apply H1; [ idtac | assumption ]. +cut (forall x:R, 0 < derive_pt (- f) x (derivable_opp f pr x)). +intros; eapply positive_derivative; apply H3. +intro. +assert (H3 := derive_pt_opp f x0 (pr x0)). +cut + (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = + derive_pt (- f) x0 (derivable_opp f pr x0)). +intro. +rewrite <- H4; rewrite H3. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0). +apply pr_nu. +intro; ring. Qed. (**********) -Lemma null_derivative_0 : (f:R->R;pr:(derivable f)) (constant f)->((x:R) ``(derive_pt f x (pr x))==0``). -Intros. -Unfold constant in H. -Apply derive_pt_eq_0. -Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Simpl; Intros. -Rewrite (H x ``x+h``); Unfold Rminus; Unfold Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. +Lemma null_derivative_0 : + forall (f:R -> R) (pr:derivable f), + constant f -> forall x:R, derive_pt f x (pr x) = 0. +intros. +unfold constant in H. +apply derive_pt_eq_0. +intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros. +rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *; + rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; + rewrite Rabs_R0; assumption. Qed. (**********) -Lemma increasing_decreasing : (f:R->R) (increasing f) -> (decreasing f) -> (constant f). -Unfold increasing decreasing constant; Intros; Case (total_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; Apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). +Lemma increasing_decreasing : + forall f:R -> R, increasing f -> decreasing f -> constant f. +unfold increasing, decreasing, constant in |- *; intros; + case (Rtotal_order x y); intro. +generalize (Rlt_le x y H1); intro; + apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)). +elim H1; intro. +rewrite H2; reflexivity. +generalize (Rlt_le y x H2); intro; symmetry in |- *; + apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). Qed. (**********) -Lemma null_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))==0``)->(constant f). -Intros. -Cut (x:R)``(derive_pt f x (pr x)) <= 0``. -Cut (x:R)``0 <= (derive_pt f x (pr x))``. -Intros. -Assert H2 := (nonneg_derivative_1 f pr H0). -Assert H3 := (nonpos_derivative_1 f pr H1). -Apply increasing_decreasing; Assumption. -Intro; Right; Symmetry; Apply (H x). -Intro; Right; Apply (H x). +Lemma null_derivative_1 : + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) = 0) -> constant f. +intros. +cut (forall x:R, derive_pt f x (pr x) <= 0). +cut (forall x:R, 0 <= derive_pt f x (pr x)). +intros. +assert (H2 := nonneg_derivative_1 f pr H0). +assert (H3 := nonpos_derivative_1 f pr H1). +apply increasing_decreasing; assumption. +intro; right; symmetry in |- *; apply (H x). +intro; right; apply (H x). Qed. (**********) -Lemma derive_increasing_interv_ax : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> (((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``)) /\ (((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``)). -Intros. -Split; Intros. -Apply Rlt_anti_compatibility with ``-(f x)``. -Rewrite Rplus_Ropp_l; Rewrite Rplus_sym. -Assert H4 := (MVT_cor1 f ? ? pr H3). -Elim H4; Intros. -Elim H5; Intros. -Unfold Rminus in H6. -Rewrite H6. -Apply Rmult_lt_pos. -Apply H0. -Elim H7; Intros. -Split. -Elim H1; Intros. -Apply Rle_lt_trans with x; Assumption. -Elim H2; Intros. -Apply Rlt_le_trans with y; Assumption. -Apply Rlt_anti_compatibility with x. -Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring]. -Apply Rle_anti_compatibility with ``-(f x)``. -Rewrite Rplus_Ropp_l; Rewrite Rplus_sym. -Assert H4 := (MVT_cor1 f ? ? pr H3). -Elim H4; Intros. -Elim H5; Intros. -Unfold Rminus in H6. -Rewrite H6. -Apply Rmult_le_pos. -Apply H0. -Elim H7; Intros. -Split. -Elim H1; Intros. -Apply Rle_lt_trans with x; Assumption. -Elim H2; Intros. -Apply Rlt_le_trans with y; Assumption. -Apply Rle_anti_compatibility with x. -Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Left; Assumption | Ring]. +Lemma derive_increasing_interv_ax : + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\ + ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y). +intros. +split; intros. +apply Rplus_lt_reg_r with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H4 := MVT_cor1 f _ _ pr H3). +elim H4; intros. +elim H5; intros. +unfold Rminus in H6. +rewrite H6. +apply Rmult_lt_0_compat. +apply H0. +elim H7; intros. +split. +elim H1; intros. +apply Rle_lt_trans with x; assumption. +elim H2; intros. +apply Rlt_le_trans with y; assumption. +apply Rplus_lt_reg_r with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. +apply Rplus_le_reg_l with (- f x). +rewrite Rplus_opp_l; rewrite Rplus_comm. +assert (H4 := MVT_cor1 f _ _ pr H3). +elim H4; intros. +elim H5; intros. +unfold Rminus in H6. +rewrite H6. +apply Rmult_le_pos. +apply H0. +elim H7; intros. +split. +elim H1; intros. +apply Rle_lt_trans with x; assumption. +elim H2; intros. +apply Rlt_le_trans with y; assumption. +apply Rplus_le_reg_l with x. +rewrite Rplus_0_r; replace (x + (y + - x)) with y; + [ left; assumption | ring ]. Qed. (**********) -Lemma derive_increasing_interv : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``). -Intros. -Generalize (derive_increasing_interv_ax a b f pr H); Intro. -Elim H4; Intros H5 _; Apply (H5 H0 x y H1 H2 H3). +Lemma derive_increasing_interv : + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y. +intros. +generalize (derive_increasing_interv_ax a b f pr H); intro. +elim H4; intros H5 _; apply (H5 H0 x y H1 H2 H3). Qed. (**********) -Lemma derive_increasing_interv_var : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``). -Intros a b f pr H H0 x y H1 H2 H3; Generalize (derive_increasing_interv_ax a b f pr H); Intro; Elim H4; Intros _ H5; Apply (H5 H0 x y H1 H2 H3). +Lemma derive_increasing_interv_var : + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y. +intros a b f pr H H0 x y H1 H2 H3; + generalize (derive_increasing_interv_ax a b f pr H); + intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3). Qed. (**********) (**********) -Theorem IAF : (f:R->R;a,b,k:R;pr:(derivable f)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt f c (pr c))<=k``) -> ``(f b)-(f a)<=k*(b-a)``. -Intros. -Case (total_order_T a b); Intro. -Elim s; Intro. -Assert H1 := (MVT_cor1 f ? ? pr a0). -Elim H1; Intros. -Elim H2; Intros. -Rewrite H3. -Do 2 Rewrite <- (Rmult_sym ``(b-a)``). -Apply Rle_monotony. -Apply Rle_anti_compatibility with ``a``; Rewrite Rplus_Or. -Replace ``a+(b-a)`` with b; [Assumption | Ring]. -Apply H0. -Elim H4; Intros. -Split; Left; Assumption. -Rewrite b0. -Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r. -Rewrite Rmult_Or; Right; Reflexivity. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). +Theorem IAF : + forall (f:R -> R) (a b k:R) (pr:derivable f), + a <= b -> + (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) -> + f b - f a <= k * (b - a). +intros. +case (total_order_T a b); intro. +elim s; intro. +assert (H1 := MVT_cor1 f _ _ pr a0). +elim H1; intros. +elim H2; intros. +rewrite H3. +do 2 rewrite <- (Rmult_comm (b - a)). +apply Rmult_le_compat_l. +apply Rplus_le_reg_l with a; rewrite Rplus_0_r. +replace (a + (b - a)) with b; [ assumption | ring ]. +apply H0. +elim H4; intros. +split; left; assumption. +rewrite b0. +unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. +rewrite Rmult_0_r; right; reflexivity. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). Qed. -Lemma IAF_var : (f,g:R->R;a,b:R;pr1:(derivable f);pr2:(derivable g)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt g c (pr2 c))<=(derive_pt f c (pr1 c))``) -> ``(g b)-(g a)<=(f b)-(f a)``. -Intros. -Cut (derivable (minus_fct g f)). -Intro. -Cut (c:R)``a<=c<=b``->``(derive_pt (minus_fct g f) c (X c))<=0``. -Intro. -Assert H2 := (IAF (minus_fct g f) a b R0 X H H1). -Rewrite Rmult_Ol in H2; Unfold minus_fct in H2. -Apply Rle_anti_compatibility with ``-(f b)+(f a)``. -Replace ``-(f b)+(f a)+((f b)-(f a))`` with R0; [Idtac | Ring]. -Replace ``-(f b)+(f a)+((g b)-(g a))`` with ``(g b)-(f b)-((g a)-(f a))``; [Apply H2 | Ring]. -Intros. -Cut (derive_pt (minus_fct g f) c (X c))==(derive_pt (minus_fct g f) c (derivable_pt_minus ? ? ? (pr2 c) (pr1 c))). -Intro. -Rewrite H2. -Rewrite derive_pt_minus. -Apply Rle_anti_compatibility with (derive_pt f c (pr1 c)). -Rewrite Rplus_Or. -Replace ``(derive_pt f c (pr1 c))+((derive_pt g c (pr2 c))-(derive_pt f c (pr1 c)))`` with ``(derive_pt g c (pr2 c))``; [Idtac | Ring]. -Apply H0; Assumption. -Apply pr_nu. -Apply derivable_minus; Assumption. +Lemma IAF_var : + forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g), + a <= b -> + (forall c:R, a <= c <= b -> derive_pt g c (pr2 c) <= derive_pt f c (pr1 c)) -> + g b - g a <= f b - f a. +intros. +cut (derivable (g - f)). +intro. +cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0). +intro. +assert (H2 := IAF (g - f)%F a b 0 X H H1). +rewrite Rmult_0_l in H2; unfold minus_fct in H2. +apply Rplus_le_reg_l with (- f b + f a). +replace (- f b + f a + (f b - f a)) with 0; [ idtac | ring ]. +replace (- f b + f a + (g b - g a)) with (g b - f b - (g a - f a)); + [ apply H2 | ring ]. +intros. +cut + (derive_pt (g - f) c (X c) = + derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))). +intro. +rewrite H2. +rewrite derive_pt_minus. +apply Rplus_le_reg_l with (derive_pt f c (pr1 c)). +rewrite Rplus_0_r. +replace + (derive_pt f c (pr1 c) + (derive_pt g c (pr2 c) - derive_pt f c (pr1 c))) + with (derive_pt g c (pr2 c)); [ idtac | ring ]. +apply H0; assumption. +apply pr_nu. +apply derivable_minus; assumption. Qed. (* If f has a null derivative in ]a,b[ and is continue in [a,b], *) (* then f is constant on [a,b] *) -Lemma null_derivative_loc : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R;P:``a<x<b``)(derive_pt f x (pr x P))==R0) -> (constant_D_eq f [x:R]``a<=x<=b`` (f a)). -Intros; Unfold constant_D_eq; Intros; Case (total_order_T a b); Intro. -Elim s; Intro. -Assert H2 : (y:R)``a<y<x``->(derivable_pt id y). -Intros; Apply derivable_pt_id. -Assert H3 : (y:R)``a<=y<=x``->(continuity_pt id y). -Intros; Apply derivable_continuous; Apply derivable_id. -Assert H4 : (y:R)``a<y<x``->(derivable_pt f y). -Intros; Apply pr; Elim H4; Intros; Split. -Assumption. -Elim H1; Intros; Apply Rlt_le_trans with x; Assumption. -Assert H5 : (y:R)``a<=y<=x``->(continuity_pt f y). -Intros; Apply H; Elim H5; Intros; Split. -Assumption. -Elim H1; Intros; Apply Rle_trans with x; Assumption. -Elim H1; Clear H1; Intros; Elim H1; Clear H1; Intro. -Assert H7 := (MVT f id a x H4 H2 H1 H5 H3). -Elim H7; Intros; Elim H8; Intros; Assert H10 : ``a<x0<b``. -Elim x1; Intros; Split. -Assumption. -Apply Rlt_le_trans with x; Assumption. -Assert H11 : ``(derive_pt f x0 (H4 x0 x1))==0``. -Replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); [Apply H0 | Apply pr_nu]. -Assert H12 : ``(derive_pt id x0 (H2 x0 x1))==1``. -Apply derive_pt_eq_0; Apply derivable_pt_lim_id. -Rewrite H11 in H9; Rewrite H12 in H9; Rewrite Rmult_Or in H9; Rewrite Rmult_1r in H9; Apply Rminus_eq; Symmetry; Assumption. -Rewrite H1; Reflexivity. -Assert H2 : x==a. -Rewrite <- b0 in H1; Elim H1; Intros; Apply Rle_antisym; Assumption. -Rewrite H2; Reflexivity. -Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H2 H3) r)). +Lemma null_derivative_loc : + forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) -> + constant_D_eq f (fun x:R => a <= x <= b) (f a). +intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro. +elim s; intro. +assert (H2 : forall y:R, a < y < x -> derivable_pt id y). +intros; apply derivable_pt_id. +assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y). +intros; apply derivable_continuous; apply derivable_id. +assert (H4 : forall y:R, a < y < x -> derivable_pt f y). +intros; apply pr; elim H4; intros; split. +assumption. +elim H1; intros; apply Rlt_le_trans with x; assumption. +assert (H5 : forall y:R, a <= y <= x -> continuity_pt f y). +intros; apply H; elim H5; intros; split. +assumption. +elim H1; intros; apply Rle_trans with x; assumption. +elim H1; clear H1; intros; elim H1; clear H1; intro. +assert (H7 := MVT f id a x H4 H2 H1 H5 H3). +elim H7; intros; elim H8; intros; assert (H10 : a < x0 < b). +elim x1; intros; split. +assumption. +apply Rlt_le_trans with x; assumption. +assert (H11 : derive_pt f x0 (H4 x0 x1) = 0). +replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); + [ apply H0 | apply pr_nu ]. +assert (H12 : derive_pt id x0 (H2 x0 x1) = 1). +apply derive_pt_eq_0; apply derivable_pt_lim_id. +rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9; + rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry in |- *; + assumption. +rewrite H1; reflexivity. +assert (H2 : x = a). +rewrite <- b0 in H1; elim H1; intros; apply Rle_antisym; assumption. +rewrite H2; reflexivity. +elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)). Qed. (* Unicity of the antiderivative *) -Lemma antiderivative_Ucte : (f,g1,g2:R->R;a,b:R) (antiderivative f g1 a b) -> (antiderivative f g2 a b) -> (EXT c:R | (x:R)``a<=x<=b``->``(g1 x)==(g2 x)+c``). -Unfold antiderivative; Intros; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _; Exists ``(g1 a)-(g2 a)``; Intros; Assert H3 : (x:R)``a<=x<=b``->(derivable_pt g1 x). -Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H x0 H3); Intros; EApply derive_pt_eq_1; Symmetry; Apply H4. -Assert H4 : (x:R)``a<=x<=b``->(derivable_pt g2 x). -Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H0 x0 H4); Intros; EApply derive_pt_eq_1; Symmetry; Apply H5. -Assert H5 : (x:R)``a<x<b``->(derivable_pt (minus_fct g1 g2) x). -Intros; Elim H5; Intros; Apply derivable_pt_minus; [Apply H3; Split; Left; Assumption | Apply H4; Split; Left; Assumption]. -Assert H6 : (x:R)``a<=x<=b``->(continuity_pt (minus_fct g1 g2) x). -Intros; Apply derivable_continuous_pt; Apply derivable_pt_minus; [Apply H3 | Apply H4]; Assumption. -Assert H7 : (x:R;P:``a<x<b``)(derive_pt (minus_fct g1 g2) x (H5 x P))==``0``. -Intros; Elim P; Intros; Apply derive_pt_eq_0; Replace R0 with ``(f x0)-(f x0)``; [Idtac | Ring]. -Assert H9 : ``a<=x0<=b``. -Split; Left; Assumption. -Apply derivable_pt_lim_minus; [Elim (H ? H9) | Elim (H0 ? H9)]; Intros; EApply derive_pt_eq_1; Symmetry; Apply H10. -Assert H8 := (null_derivative_loc (minus_fct g1 g2) a b H5 H6 H7); Unfold constant_D_eq in H8; Assert H9 := (H8 ? H2); Unfold minus_fct in H9; Rewrite <- H9; Ring. -Qed. +Lemma antiderivative_Ucte : + forall (f g1 g2:R -> R) (a b:R), + antiderivative f g1 a b -> + antiderivative f g2 a b -> + exists c : R | (forall x:R, a <= x <= b -> g1 x = g2 x + c). +unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + clear H0; intros H0 _; exists (g1 a - g2 a); intros; + assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x). +intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3); + intros; eapply derive_pt_eq_1; symmetry in |- *; + apply H4. +assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). +intros; unfold derivable_pt in |- *; apply existT with (f x0); + elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; + apply H5. +assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). +intros; elim H5; intros; apply derivable_pt_minus; + [ apply H3; split; left; assumption | apply H4; split; left; assumption ]. +assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x). +intros; apply derivable_continuous_pt; apply derivable_pt_minus; + [ apply H3 | apply H4 ]; assumption. +assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0). +intros; elim P; intros; apply derive_pt_eq_0; replace 0 with (f x0 - f x0); + [ idtac | ring ]. +assert (H9 : a <= x0 <= b). +split; left; assumption. +apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H10. +assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7); + unfold constant_D_eq in H8; assert (H9 := H8 _ H2); + unfold minus_fct in H9; rewrite <- H9; ring. +Qed.
\ No newline at end of file diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v index 961f8bf0a..e2080827b 100644 --- a/theories/Reals/NewtonInt.v +++ b/theories/Reals/NewtonInt.v @@ -8,593 +8,781 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require Ranalysis. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis. Open Local Scope R_scope. (*******************************************) (* Newton's Integral *) (*******************************************) -Definition Newton_integrable [f:R->R;a,b:R] : Type := (sigTT ? [g:R->R](antiderivative f g a b)\/(antiderivative f g b a)). +Definition Newton_integrable (f:R -> R) (a b:R) : Type := + sigT (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a). -Definition NewtonInt [f:R->R;a,b:R;pr:(Newton_integrable f a b)] : R := let g = Cases pr of (existTT a b) => a end in ``(g b)-(g a)``. +Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R := + let g := match pr with + | existT a b => a + end in g b - g a. (* If f is differentiable, then f' is Newton integrable (Tautology ?) *) -Lemma FTCN_step1 : (f:Differential;a,b:R) (Newton_integrable [x:R](derive_pt f x (cond_diff f x)) a b). -Intros f a b; Unfold Newton_integrable; Apply existTT with (d1 f); Unfold antiderivative; Intros; Case (total_order_Rle a b); Intro; [Left; Split; [Intros; Exists (cond_diff f x); Reflexivity | Assumption] | Right; Split; [Intros; Exists (cond_diff f x); Reflexivity | Auto with real]]. +Lemma FTCN_step1 : + forall (f:Differential) (a b:R), + Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b. +intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f); + unfold antiderivative in |- *; intros; case (Rle_dec a b); + intro; + [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] + | right; split; + [ intros; exists (cond_diff f x); reflexivity | auto with real ] ]. Defined. (* By definition, we have the Fondamental Theorem of Calculus *) -Lemma FTC_Newton : (f:Differential;a,b:R) (NewtonInt [x:R](derive_pt f x (cond_diff f x)) a b (FTCN_step1 f a b))==``(f b)-(f a)``. -Intros; Unfold NewtonInt; Reflexivity. +Lemma FTC_Newton : + forall (f:Differential) (a b:R), + NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b + (FTCN_step1 f a b) = f b - f a. +intros; unfold NewtonInt in |- *; reflexivity. Qed. (* $\int_a^a f$ exists forall a:R and f:R->R *) -Lemma NewtonInt_P1 : (f:R->R;a:R) (Newton_integrable f a a). -Intros f a; Unfold Newton_integrable; Apply existTT with (mult_fct (fct_cte (f a)) id); Left; Unfold antiderivative; Split. -Intros; Assert H1 : (derivable_pt (mult_fct (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; 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; Rewrite H2; Ring]. -Right; Reflexivity. +Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a. +intros f a; unfold Newton_integrable in |- *; + apply existT with (fct_cte (f a) * id)%F; left; + unfold antiderivative in |- *; split. +intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x). +apply derivable_pt_mult. +apply derivable_pt_const. +apply derivable_pt_id. +exists H1; assert (H2 : x = a). +elim H; intros; apply Rle_antisym; assumption. +symmetry in |- *; apply derive_pt_eq_0; + replace (f x) with (0 * id x + fct_cte (f a) x * 1); + [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x); + [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ] + | unfold id, fct_cte in |- *; rewrite H2; ring ]. +right; reflexivity. Defined. (* $\int_a^a f = 0$ *) -Lemma NewtonInt_P2 : (f:R->R;a:R) ``(NewtonInt f a a (NewtonInt_P1 f a))==0``. -Intros; Unfold NewtonInt; Simpl; Unfold mult_fct fct_cte id; Ring. +Lemma NewtonInt_P2 : + forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0. +intros; unfold NewtonInt in |- *; simpl in |- *; + unfold mult_fct, fct_cte, id in |- *; ring. Qed. (* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *) -Lemma NewtonInt_P3 : (f:R->R;a,b:R;X:(Newton_integrable f a b)) (Newton_integrable f b a). -Unfold Newton_integrable; Intros; Elim X; Intros g H; Apply existTT with g; Tauto. +Lemma NewtonInt_P3 : + forall (f:R -> R) (a b:R) (X:Newton_integrable f a b), + Newton_integrable f b a. +unfold Newton_integrable in |- *; intros; elim X; intros g H; + apply existT with g; tauto. Defined. (* $\int_a^b f = -\int_b^a f$ *) -Lemma NewtonInt_P4 : (f:R->R;a,b:R;pr:(Newton_integrable f a b)) ``(NewtonInt f a b pr)==-(NewtonInt f b a (NewtonInt_P3 f a b pr))``. -Intros; Unfold Newton_integrable in pr; Elim pr; Intros; Elim p; Intro. -Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)). -Intros; Elim o; Intro. -Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro. -Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)). -Rewrite H3; Ring. -Assert H1 := (antiderivative_Ucte f x x0 a b H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Assert H3 : ``a<=a<=b``. -Split; [Right; Reflexivity | Assumption]. -Assert H4 : ``a<=b<=b``. -Split; [Assumption | Right; Reflexivity]. -Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring. -Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)); Intros; Elim o; Intro. -Assert H1 := (antiderivative_Ucte f x x0 b a H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Assert H3 : ``b<=a<=a``. -Split; [Assumption | Right; Reflexivity]. -Assert H4 : ``b<=b<=a``. -Split; [Right; Reflexivity | Assumption]. -Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring. -Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro. -Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)). -Rewrite H3; Ring. +Lemma NewtonInt_P4 : + forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b), + NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr). +intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro. +unfold NewtonInt in |- *; + case + (NewtonInt_P3 f a b + (existT + (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x + p)). +intros; elim o; intro. +unfold antiderivative in H0; elim H0; intros; elim H2; intro. +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). +rewrite H3; ring. +assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros; + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +assert (H3 : a <= a <= b). +split; [ right; reflexivity | assumption ]. +assert (H4 : a <= b <= b). +split; [ assumption | right; reflexivity ]. +assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. +unfold NewtonInt in |- *; + case + (NewtonInt_P3 f a b + (existT + (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x + p)); intros; elim o; intro. +assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros; + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +assert (H3 : b <= a <= a). +split; [ assumption | right; reflexivity ]. +assert (H4 : b <= b <= a). +split; [ right; reflexivity | assumption ]. +assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. +unfold antiderivative in H0; elim H0; intros; elim H2; intro. +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). +rewrite H3; ring. Qed. (* The set of Newton integrable functions is a vectorial space *) -Lemma NewtonInt_P5 : (f,g:R->R;l,a,b:R) (Newton_integrable f a b) -> (Newton_integrable g a b) -> (Newton_integrable [x:R]``l*(f x)+(g x)`` a b). -Unfold Newton_integrable; Intros; Elim X; Intros; Elim X0; Intros; Exists [y:R]``l*(x y)+(x0 y)``. -Elim p; Intro. -Elim p0; Intro. -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 [y:R]``l*(x y)+(x0 y)`` x1). -Reg. -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_antirefl ? (Rlt_le_trans ? ? ? H5 H2)). -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; Assumption | Rewrite <- H5; Assumption]. -Assert H11 : ``b<=x1<=a``. -Split; Right; [Rewrite <- H5; Symmetry; Assumption | Assumption]. -Assert H12 : (derivable_pt x x1). -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; Exists (g x1); Elim (H1 ? H11); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13. -Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1). -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)``. -Elim (H3 ? H10); Intros; Rewrite H16; Apply pr_nu. -Rewrite H15; Rewrite H16; Ring. -Right; Reflexivity. -Elim p0; Intro. -Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Elim H4; Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H5 H2)). -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; Assumption | Rewrite H5; Assumption]. -Assert H11 : ``b<=x1<=a``. -Split; Right; [Rewrite H5; Symmetry; Assumption | Assumption]. -Assert H12 : (derivable_pt x x1). -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; Exists (g x1); Elim (H1 ? H10); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13. -Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1). -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; 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 [y:R]``l*(x y)+(x0 y)`` x1). -Reg. -Exists H5; Symmetry; Reg; Rewrite <- H3; Rewrite <- H4; Reflexivity. -Assumption. +Lemma NewtonInt_P5 : + forall (f g:R -> R) (l a b:R), + Newton_integrable f a b -> + Newton_integrable g a b -> + Newton_integrable (fun x:R => l * f x + g x) a b. +unfold Newton_integrable in |- *; intros; elim X; intros; elim X0; intros; + exists (fun y:R => l * x y + x0 y). +elim p; intro. +elim p0; intro. +left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; + clear H; intros; elim H0; clear H0; intros H0 _. +split. +intros; elim (H _ H2); elim (H0 _ H2); intros. +assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. +assumption. +unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). +left; rewrite <- H5; unfold antiderivative in |- *; split. +intros; elim H6; intros; assert (H9 : x1 = a). +apply Rle_antisym; assumption. +assert (H10 : a <= x1 <= b). +split; right; [ symmetry in |- *; assumption | rewrite <- H5; assumption ]. +assert (H11 : b <= x1 <= a). +split; right; [ rewrite <- H5; symmetry in |- *; assumption | assumption ]. +assert (H12 : derivable_pt x x1). +unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H12. +assert (H13 : derivable_pt x0 x1). +unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H13. +assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H14; symmetry in |- *; reg. +assert (H15 : derive_pt x0 x1 H13 = g x1). +elim (H1 _ H11); intros; rewrite H15; apply pr_nu. +assert (H16 : derive_pt x x1 H12 = f x1). +elim (H3 _ H10); intros; rewrite H16; apply pr_nu. +rewrite H15; rewrite H16; ring. +right; reflexivity. +elim p0; intro. +unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). +left; rewrite H5; unfold antiderivative in |- *; split. +intros; elim H6; intros; assert (H9 : x1 = a). +apply Rle_antisym; assumption. +assert (H10 : a <= x1 <= b). +split; right; [ symmetry in |- *; assumption | rewrite H5; assumption ]. +assert (H11 : b <= x1 <= a). +split; right; [ rewrite H5; symmetry in |- *; assumption | assumption ]. +assert (H12 : derivable_pt x x1). +unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H12. +assert (H13 : derivable_pt x0 x1). +unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H13. +assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H14; symmetry in |- *; reg. +assert (H15 : derive_pt x0 x1 H13 = g x1). +elim (H1 _ H10); intros; rewrite H15; apply pr_nu. +assert (H16 : derive_pt x x1 H12 = f x1). +elim (H3 _ H11); intros; rewrite H16; apply pr_nu. +rewrite H15; rewrite H16; ring. +right; reflexivity. +right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; + clear H; intros; elim H0; clear H0; intros H0 _; split. +intros; elim (H _ H2); elim (H0 _ H2); intros. +assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). +reg. +exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. +assumption. Defined. (**********) -Lemma antiderivative_P1 : (f,g,F,G:R->R;l,a,b:R) (antiderivative f F a b) -> (antiderivative g G a b) -> (antiderivative [x:R]``l*(f x)+(g x)`` [x:R]``l*(F x)+(G x)`` a b). -Unfold antiderivative; Intros; Elim H; Elim H0; Clear H H0; Intros; Split. -Intros; Elim (H ? H3); Elim (H1 ? H3); Intros. -Assert H6 : (derivable_pt [x:R]``l*(F x)+(G x)`` x). -Reg. -Exists H6; Symmetry; Reg; Rewrite <- H4; Rewrite <- H5; Ring. -Assumption. +Lemma antiderivative_P1 : + forall (f g F G:R -> R) (l a b:R), + antiderivative f F a b -> + antiderivative g G a b -> + antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b. +unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros; + split. +intros; elim (H _ H3); elim (H1 _ H3); intros. +assert (H6 : derivable_pt (fun x:R => l * F x + G x) x). +reg. +exists H6; symmetry in |- *; reg; rewrite <- H4; rewrite <- H5; ring. +assumption. Qed. (* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *) -Lemma NewtonInt_P6 : (f,g:R->R;l,a,b:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable g a b)) (NewtonInt [x:R]``l*(f x)+(g x)`` a b (NewtonInt_P5 f g l a b pr1 pr2))==``l*(NewtonInt f a b pr1)+(NewtonInt g a b pr2)``. -Intros f g l a b pr1 pr2; Unfold NewtonInt; Case (NewtonInt_P5 f g l a b pr1 pr2); Intros; Case pr1; Intros; Case pr2; Intros; Case (total_order_T a b); Intro. -Elim s; Intro. -Elim o; Intro. -Elim o0; Intro. -Elim o1; Intro. -Assert H2 := (antiderivative_P1 f g x0 x1 l a b H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``a<=a<=b``. -Split; [Right; Reflexivity | Left; Assumption]. -Assert H6 : ``a<=b<=b``. -Split; [Left; Assumption | Right; Reflexivity]. -Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring. -Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 a0)). -Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)). -Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 a0)). -Rewrite b0; Ring. -Elim o; Intro. -Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r)). -Elim o0; Intro. -Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)). -Elim o1; Intro. -Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 r)). -Assert H2 := (antiderivative_P1 f g x0 x1 l b a H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``b<=a<=a``. -Split; [Left; Assumption | Right; Reflexivity]. -Assert H6 : ``b<=b<=a``. -Split; [Right; Reflexivity | Left; Assumption]. -Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring. +Lemma NewtonInt_P6 : + forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b) + (pr2:Newton_integrable g a b), + NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) = + l * NewtonInt f a b pr1 + NewtonInt g a b pr2. +intros f g l a b pr1 pr2; unfold NewtonInt in |- *; + case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; + intros; case pr2; intros; case (total_order_T a b); + intro. +elim s; intro. +elim o; intro. +elim o0; intro. +elim o1; intro. +assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + elim H3; intros; assert (H5 : a <= a <= b). +split; [ right; reflexivity | left; assumption ]. +assert (H6 : a <= b <= b). +split; [ left; assumption | right; reflexivity ]. +assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. +unfold antiderivative in H1; elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)). +unfold antiderivative in H0; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)). +rewrite b0; ring. +elim o; intro. +unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)). +elim o0; intro. +unfold antiderivative in H0; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). +elim o1; intro. +unfold antiderivative in H1; elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)). +assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + elim H3; intros; assert (H5 : b <= a <= a). +split; [ left; assumption | right; reflexivity ]. +assert (H6 : b <= b <= a). +split; [ right; reflexivity | left; assumption ]. +assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. Qed. -Lemma antiderivative_P2 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 b c) -> (antiderivative f [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) a c). -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. -Elim s; Intro. -Assert H5 : ``a<=x<=b``. -Split; [Assumption | Left; Assumption]. -Assert H6 := (H ? H5); Elim H6; Clear H6; Intros; Assert H7 : (derivable_pt_lim [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x (f x)). -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; Pose D := (Rmin x1 ``b-x``). -Assert H11 : ``0<D``. -Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``b-x``); Intro. -Apply (cond_pos x1). -Apply Rlt_Rminus; Assumption. -Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro. -Case (total_order_Rle ``x+h`` b); Intro. -Apply H10. -Assumption. -Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_l]. -Elim n; Left; Apply Rlt_le_trans with ``x+D``. -Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h). -Apply Rle_Rabsolu. -Apply H13. -Apply Rle_anti_compatibility with ``-x``; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite Rplus_sym; Unfold D; Apply Rmin_r. -Elim n; Left; Assumption. -Assert H8 : (derivable_pt [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x). -Unfold derivable_pt; Apply Specif.existT with (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; Assumption | Assumption]. -Elim (H ? H5); Elim (H0 ? H6); Intros; Assert H9 : (derive_pt F0 x x1)==(f x). -Symmetry; Assumption. -Assert H10 : (derive_pt F1 x x0)==(f x). -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 H13 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)). -Unfold derivable_pt_lim; Unfold derivable_pt_lim in H11 H12; Intros; Elim (H11 ? H13); Elim (H12 ? H13); Intros; Pose D := (Rmin x2 x3); Assert H16 : ``0<D``. -Unfold D; Unfold Rmin; Case (total_order_Rle x2 x3); Intro. -Apply (cond_pos x2). -Apply (cond_pos x3). -Exists (mkposreal ? H16); Intros; Case (total_order_Rle x b); Intro. -Case (total_order_Rle ``x+h`` b); Intro. -Apply H15. -Assumption. -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; Apply Rmin_l]. -Rewrite b0; Ring. -Elim n; Right; Assumption. -Assert H14 : (derivable_pt [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x). -Unfold derivable_pt; Apply Specif.existT with (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; Assert H7 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)). -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; Pose D := (Rmin x1 ``x-b``); Assert H11 : ``0<D``. -Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``x-b``); Intro. -Apply (cond_pos x1). -Apply Rlt_Rminus; Assumption. -Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)). -Case (total_order_Rle ``x+h`` b); Intro. -Cut ``b<x+h``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)). -Apply Rlt_anti_compatibility with ``-h-b``; Replace ``-h-b+b`` with ``-h``; [Idtac | Ring]; Replace ``-h-b+(x+h)`` with ``x-b``; [Idtac | Ring]; Apply Rle_lt_trans with (Rabsolu h). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Apply Rlt_le_trans with D. -Apply H13. -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; Apply Rmin_l. -Assert H8 : (derivable_pt [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x). -Unfold derivable_pt; Apply Specif.existT with (f x); Apply H7. -Exists H8; Symmetry; Apply derive_pt_eq_0; Apply H7. +Lemma antiderivative_P2 : + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 b c -> + antiderivative f + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) a c. +unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + clear H0; intros; split. +2: apply Rle_trans with b; assumption. +intros; elim H3; clear H3; intros; case (total_order_T x b); intro. +elim s; intro. +assert (H5 : a <= x <= b). +split; [ assumption | left; assumption ]. +assert (H6 := H _ H5); elim H6; clear H6; intros; + assert + (H7 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). +unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x). +symmetry in |- *; assumption. +assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8; + intros; elim (H8 _ H9); intros; pose (D := Rmin x1 (b - x)). +assert (H11 : 0 < D). +unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro. +apply (cond_pos x1). +apply Rlt_Rminus; assumption. +exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. +case (Rle_dec (x + h) b); intro. +apply H10. +assumption. +apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. +elim n; left; apply Rlt_le_trans with (x + D). +apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h). +apply RRle_abs. +apply H13. +apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; + apply Rmin_r. +elim n; left; assumption. +assert + (H8 : + derivable_pt + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). +unfold derivable_pt in |- *; apply existT with (f x); apply H7. +exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. +assert (H5 : a <= x <= b). +split; [ assumption | right; assumption ]. +assert (H6 : b <= x <= c). +split; [ right; symmetry in |- *; assumption | assumption ]. +elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x). +symmetry in |- *; assumption. +assert (H10 : derive_pt F1 x x0 = f x). +symmetry in |- *; assumption. +assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9); + assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10); + assert + (H13 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). +unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros; + elim (H11 _ H13); elim (H12 _ H13); intros; pose (D := Rmin x2 x3); + assert (H16 : 0 < D). +unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro. +apply (cond_pos x2). +apply (cond_pos x3). +exists (mkposreal _ H16); intros; case (Rle_dec x b); intro. +case (Rle_dec (x + h) b); intro. +apply H15. +assumption. +apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ]. +replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x). +apply H14. +assumption. +apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. +rewrite b0; ring. +elim n; right; assumption. +assert + (H14 : + derivable_pt + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). +unfold derivable_pt in |- *; apply existT with (f x); apply H13. +exists H14; symmetry in |- *; apply derive_pt_eq_0; apply H13. +assert (H5 : b <= x <= c). +split; [ left; assumption | assumption ]. +assert (H6 := H0 _ H5); elim H6; clear H6; intros; + assert + (H7 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). +unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x). +symmetry in |- *; assumption. +assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8; + intros; elim (H8 _ H9); intros; pose (D := Rmin x1 (x - b)); + assert (H11 : 0 < D). +unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro. +apply (cond_pos x1). +apply Rlt_Rminus; assumption. +exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). +case (Rle_dec (x + h) b); intro. +cut (b < x + h). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)). +apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h); + [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); + [ idtac | ring ]; apply Rle_lt_trans with (Rabs h). +rewrite <- Rabs_Ropp; apply RRle_abs. +apply Rlt_le_trans with D. +apply H13. +unfold D in |- *; apply Rmin_r. +replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with + (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10. +assumption. +apply Rlt_le_trans with D. +assumption. +unfold D in |- *; apply Rmin_l. +assert + (H8 : + derivable_pt + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). +unfold derivable_pt in |- *; apply existT with (f x); apply H7. +exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. Qed. -Lemma antiderivative_P3 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 c b) -> (antiderivative f F1 c a)\/(antiderivative f F0 a c). -Intros; Unfold antiderivative in H H0; Elim H; Clear H; Elim H0; Clear H0; Intros; Case (total_order_T a c); Intro. -Elim s; Intro. -Right; Unfold antiderivative; Split. -Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption]. -Left; Assumption. -Right; Unfold antiderivative; Split. -Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption]. -Right; Assumption. -Left; Unfold antiderivative; Split. -Intros; Apply H; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with a; Assumption]. -Left; Assumption. +Lemma antiderivative_P3 : + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 c b -> + antiderivative f F1 c a \/ antiderivative f F0 a c. +intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; + intros; case (total_order_T a c); intro. +elim s; intro. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ assumption | apply Rle_trans with c; assumption ]. +left; assumption. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ assumption | apply Rle_trans with c; assumption ]. +right; assumption. +left; unfold antiderivative in |- *; split. +intros; apply H; elim H3; intros; split; + [ assumption | apply Rle_trans with a; assumption ]. +left; assumption. Qed. -Lemma antiderivative_P4 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 a c) -> (antiderivative f F1 b c)\/(antiderivative f F0 c b). -Intros; Unfold antiderivative in H H0; Elim H; Clear H; Elim H0; Clear H0; Intros; Case (total_order_T c b); Intro. -Elim s; Intro. -Right; Unfold antiderivative; Split. -Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption]. -Left; Assumption. -Right; Unfold antiderivative; Split. -Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption]. -Right; Assumption. -Left; Unfold antiderivative; Split. -Intros; Apply H; Elim H3; Intros; Split; [Apply Rle_trans with b; Assumption | Assumption]. -Left; Assumption. +Lemma antiderivative_P4 : + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 a c -> + antiderivative f F1 b c \/ antiderivative f F0 c b. +intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; + intros; case (total_order_T c b); intro. +elim s; intro. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ apply Rle_trans with c; assumption | assumption ]. +left; assumption. +right; unfold antiderivative in |- *; split. +intros; apply H1; elim H3; intros; split; + [ apply Rle_trans with c; assumption | assumption ]. +right; assumption. +left; unfold antiderivative in |- *; split. +intros; apply H; elim H3; intros; split; + [ apply Rle_trans with b; assumption | assumption ]. +left; assumption. Qed. -Lemma NewtonInt_P7 : (f:R->R;a,b,c:R) ``a<b`` -> ``b<c`` -> (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c). -Unfold Newton_integrable; Intros f a b c Hab Hbc X X0; Elim X; Clear X; Intros F0 H0; Elim X0; Clear X0; Intros F1 H1; Pose g := [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end); Apply existTT with g; Left; Unfold g; Apply antiderivative_P2. -Elim H0; Intro. -Assumption. -Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hab)). -Elim H1; Intro. -Assumption. -Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hbc)). +Lemma NewtonInt_P7 : + forall (f:R -> R) (a b c:R), + a < b -> + b < c -> + Newton_integrable f a b -> + Newton_integrable f b c -> Newton_integrable f a c. +unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X; + clear X; intros F0 H0; elim X0; clear X0; intros F1 H1; + pose + (g := + fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end); apply existT with g; left; unfold g in |- *; + apply antiderivative_P2. +elim H0; intro. +assumption. +unfold antiderivative in H; elim H; clear H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)). +elim H1; intro. +assumption. +unfold antiderivative in H; elim H; clear H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)). Qed. -Lemma NewtonInt_P8 : (f:(R->R); a,b,c:R) (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c). -Intros. -Elim X; Intros F0 H0. -Elim X0; Intros F1 H1. -Case (total_order_T a b); Intro. -Elim s; Intro. -Case (total_order_T b c); Intro. -Elim s0; Intro. +Lemma NewtonInt_P8 : + forall (f:R -> R) (a b c:R), + Newton_integrable f a b -> + Newton_integrable f b c -> Newton_integrable f a c. +intros. +elim X; intros F0 H0. +elim X0; intros F1 H1. +case (total_order_T a b); intro. +elim s; intro. +case (total_order_T b c); intro. +elim s0; intro. (* a<b & b<c *) -Unfold Newton_integrable; Apply existTT with [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end). -Elim H0; Intro. -Elim H1; Intro. -Left; Apply antiderivative_P2; Assumption. -Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a1)). -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)). +unfold Newton_integrable in |- *; + apply existT with + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end). +elim H0; intro. +elim H1; intro. +left; apply antiderivative_P2; assumption. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). (* a<b & b=c *) -Rewrite b0 in X; Apply X. +rewrite b0 in X; apply X. (* a<b & b>c *) -Case (total_order_T a c); Intro. -Elim s0; Intro. -Unfold Newton_integrable; Apply existTT with F0. -Left. -Elim H1; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim H0; Intro. -Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H). -Elim H3; Intro. -Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)). -Assumption. -Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)). -Rewrite b0; Apply NewtonInt_P1. -Unfold Newton_integrable; Apply existTT with F1. -Right. -Elim H1; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim H0; Intro. -Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H). -Elim H3; Intro. -Assumption. -Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)). -Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)). +case (total_order_T a c); intro. +elim s0; intro. +unfold Newton_integrable in |- *; apply existT with F0. +left. +elim H1; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim H0; intro. +assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). +elim H3; intro. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). +assumption. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). +rewrite b0; apply NewtonInt_P1. +unfold Newton_integrable in |- *; apply existT with F1. +right. +elim H1; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim H0; intro. +assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). +elim H3; intro. +assumption. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). (* a=b *) -Rewrite b0; Apply X0. -Case (total_order_T b c); Intro. -Elim s; Intro. +rewrite b0; apply X0. +case (total_order_T b c); intro. +elim s; intro. (* a>b & b<c *) -Case (total_order_T a c); Intro. -Elim s0; Intro. -Unfold Newton_integrable; Apply existTT with F1. -Left. -Elim H1; Intro. +case (total_order_T a c); intro. +elim s0; intro. +unfold Newton_integrable in |- *; apply existT with F1. +left. +elim H1; intro. (*****************) -Elim H0; Intro. -Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)). -Assert H3 := (antiderivative_P4 f F0 F1 b a c H2 H). -Elim H3; Intro. -Assumption. -Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)). -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)). -Rewrite b0; Apply NewtonInt_P1. -Unfold Newton_integrable; Apply existTT with F0. -Right. -Elim H0; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim H1; Intro. -Assert H3 := (antiderivative_P4 f F0 F1 b a c H H2). -Elim H3; Intro. -Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)). -Assumption. -Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)). +elim H0; intro. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). +assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H). +elim H3; intro. +assumption. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). +rewrite b0; apply NewtonInt_P1. +unfold Newton_integrable in |- *; apply existT with F0. +right. +elim H0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim H1; intro. +assert (H3 := antiderivative_P4 f F0 F1 b a c H H2). +elim H3; intro. +unfold antiderivative in H4; elim H4; clear H4; intros _ H4. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). +assumption. +unfold antiderivative in H2; elim H2; clear H2; intros _ H2. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). (* a>b & b=c *) -Rewrite b0 in X; Apply X. +rewrite b0 in X; apply X. (* a>b & b>c *) -Assert X1 := (NewtonInt_P3 f a b X). -Assert X2 := (NewtonInt_P3 f b c X0). -Apply NewtonInt_P3. -Apply NewtonInt_P7 with b; Assumption. +assert (X1 := NewtonInt_P3 f a b X). +assert (X2 := NewtonInt_P3 f b c X0). +apply NewtonInt_P3. +apply NewtonInt_P7 with b; assumption. Defined. (* Chasles' relation *) -Lemma NewtonInt_P9 : (f:R->R;a,b,c:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable f b c)) ``(NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2))==(NewtonInt f a b pr1)+(NewtonInt f b c pr2)``. -Intros; Unfold NewtonInt. -Case (NewtonInt_P8 f a b c pr1 pr2); Intros. -Case pr1; Intros. -Case pr2; Intros. -Case (total_order_T a b); Intro. -Elim s; Intro. -Case (total_order_T b c); Intro. -Elim s0; Intro. +Lemma NewtonInt_P9 : + forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b) + (pr2:Newton_integrable f b c), + NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) = + NewtonInt f a b pr1 + NewtonInt f b c pr2. +intros; unfold NewtonInt in |- *. +case (NewtonInt_P8 f a b c pr1 pr2); intros. +case pr1; intros. +case pr2; intros. +case (total_order_T a b); intro. +elim s; intro. +case (total_order_T b c); intro. +elim s0; intro. (* a<b & b<c *) -Elim o0; Intro. -Elim o1; Intro. -Elim o; Intro. -Assert H2 := (antiderivative_P2 f x0 x1 a b c H H0). -Assert H3 := (antiderivative_Ucte f x [x:R] - Cases (total_order_Rle x b) of - (leftT _) => (x0 x) - | (rightT _) => ``(x1 x)+((x0 b)-(x1 b))`` - end a c H1 H2). -Elim H3; Intros. -Assert H5 : ``a<=a<=c``. -Split; [Right; Reflexivity | Left; Apply Rlt_trans with b; Assumption]. -Assert H6 : ``a<=c<=c``. -Split; [Left; Apply Rlt_trans with b; Assumption | Right; Reflexivity]. -Rewrite (H4 ? H5); Rewrite (H4 ? H6). -Case (total_order_Rle a b); Intro. -Case (total_order_Rle c b); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a1)). -Ring. -Elim n; Left; Assumption. -Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? a0 a1))). -Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a1)). -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)). +elim o0; intro. +elim o1; intro. +elim o; intro. +assert (H2 := antiderivative_P2 f x0 x1 a b c H H0). +assert + (H3 := + antiderivative_Ucte f x + (fun x:R => + match Rle_dec x b with + | left _ => x0 x + | right _ => x1 x + (x0 b - x1 b) + end) a c H1 H2). +elim H3; intros. +assert (H5 : a <= a <= c). +split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ]. +assert (H6 : a <= c <= c). +split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ]. +rewrite (H4 _ H5); rewrite (H4 _ H6). +case (Rle_dec a b); intro. +case (Rle_dec c b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)). +ring. +elim n; left; assumption. +unfold antiderivative in H1; elim H1; clear H1; intros _ H1. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))). +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). (* a<b & b=c *) -Rewrite <- b0. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or. -Rewrite <- b0 in o. -Elim o0; Intro. -Elim o; Intro. -Assert H1 := (antiderivative_Ucte f x x0 a b H0 H). -Elim H1; Intros. -Rewrite (H2 b). -Rewrite (H2 a). -Ring. -Split; [Right; Reflexivity | Left; Assumption]. -Split; [Left; Assumption | Right; Reflexivity]. -Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)). -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)). +rewrite <- b0. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. +rewrite <- b0 in o. +elim o0; intro. +elim o; intro. +assert (H1 := antiderivative_Ucte f x x0 a b H0 H). +elim H1; intros. +rewrite (H2 b). +rewrite (H2 a). +ring. +split; [ right; reflexivity | left; assumption ]. +split; [ left; assumption | right; reflexivity ]. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). (* a<b & b>c *) -Elim o1; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim o0; Intro. -Elim o; Intro. -Assert H2 := (antiderivative_P2 f x x1 a c b H1 H). -Assert H3 := (antiderivative_Ucte ? ? ? a b H0 H2). -Elim H3; Intros. -Rewrite (H4 a). -Rewrite (H4 b). -Case (total_order_Rle b c); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)). -Case (total_order_Rle a c); Intro. -Ring. -Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption. -Split; [Left; Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Left; Assumption]. -Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H1 H0). -Assert H3 := (antiderivative_Ucte ? ? ? c b H H2). -Elim H3; Intros. -Rewrite (H4 c). -Rewrite (H4 b). -Case (total_order_Rle b a); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a0)). -Case (total_order_Rle c a); Intro. -Ring. -Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption. -Split; [Left; Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Left; Assumption]. -Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)). +elim o1; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o0; intro. +elim o; intro. +assert (H2 := antiderivative_P2 f x x1 a c b H1 H). +assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2). +elim H3; intros. +rewrite (H4 a). +rewrite (H4 b). +case (Rle_dec b c); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). +case (Rle_dec a c); intro. +ring. +elim n0; unfold antiderivative in H1; elim H1; intros; assumption. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0). +assert (H3 := antiderivative_Ucte _ _ _ c b H H2). +elim H3; intros. +rewrite (H4 c). +rewrite (H4 b). +case (Rle_dec b a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)). +case (Rle_dec c a); intro. +ring. +elim n0; unfold antiderivative in H1; elim H1; intros; assumption. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). (* a=b *) -Rewrite b0 in o; Rewrite b0. -Elim o; Intro. -Elim o1; Intro. -Assert H1 := (antiderivative_Ucte ? ? ? b c H H0). -Elim H1; Intros. -Assert H3 : ``b<=c``. -Unfold antiderivative in H; Elim H; Intros; Assumption. -Rewrite (H2 b). -Rewrite (H2 c). -Ring. -Split; [Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Assumption]. -Assert H1 : ``b==c``. -Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption. -Rewrite H1; Ring. -Elim o1; Intro. -Assert H1 : ``b==c``. -Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption. -Rewrite H1; Ring. -Assert H1 := (antiderivative_Ucte ? ? ? c b H H0). -Elim H1; Intros. -Assert H3 : ``c<=b``. -Unfold antiderivative in H; Elim H; Intros; Assumption. -Rewrite (H2 c). -Rewrite (H2 b). -Ring. -Split; [Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Assumption]. +rewrite b0 in o; rewrite b0. +elim o; intro. +elim o1; intro. +assert (H1 := antiderivative_Ucte _ _ _ b c H H0). +elim H1; intros. +assert (H3 : b <= c). +unfold antiderivative in H; elim H; intros; assumption. +rewrite (H2 b). +rewrite (H2 c). +ring. +split; [ assumption | right; reflexivity ]. +split; [ right; reflexivity | assumption ]. +assert (H1 : b = c). +unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; + assumption. +rewrite H1; ring. +elim o1; intro. +assert (H1 : b = c). +unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; + assumption. +rewrite H1; ring. +assert (H1 := antiderivative_Ucte _ _ _ c b H H0). +elim H1; intros. +assert (H3 : c <= b). +unfold antiderivative in H; elim H; intros; assumption. +rewrite (H2 c). +rewrite (H2 b). +ring. +split; [ assumption | right; reflexivity ]. +split; [ right; reflexivity | assumption ]. (* a>b & b<c *) -Case (total_order_T b c); Intro. -Elim s; Intro. -Elim o0; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim o1; Intro. -Elim o; Intro. -Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H H1). -Assert H3 := (antiderivative_Ucte ? ? ? b c H0 H2). -Elim H3; Intros. -Rewrite (H4 b). -Rewrite (H4 c). -Case (total_order_Rle b a); Intro. -Case (total_order_Rle c a); Intro. -Assert H5 : ``a==c``. -Unfold antiderivative in H1; Elim H1; Intros; Apply Rle_antisym; Assumption. -Rewrite H5; Ring. -Ring. -Elim n; Left; Assumption. -Split; [Left; Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Left; Assumption]. -Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H1). -Assert H3 := (antiderivative_Ucte ? ? ? b a H H2). -Elim H3; Intros. -Rewrite (H4 a). -Rewrite (H4 b). -Case (total_order_Rle b c); Intro. -Case (total_order_Rle a c); Intro. -Assert H5 : ``a==c``. -Unfold antiderivative in H1; Elim H1; Intros; Apply Rle_antisym; Assumption. -Rewrite H5; Ring. -Ring. -Elim n; Left; Assumption. -Split; [Right; Reflexivity | Left; Assumption]. -Split; [Left; Assumption | Right; Reflexivity]. -Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)). +case (total_order_T b c); intro. +elim s; intro. +elim o0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o1; intro. +elim o; intro. +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1). +assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2). +elim H3; intros. +rewrite (H4 b). +rewrite (H4 c). +case (Rle_dec b a); intro. +case (Rle_dec c a); intro. +assert (H5 : a = c). +unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. +rewrite H5; ring. +ring. +elim n; left; assumption. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1). +assert (H3 := antiderivative_Ucte _ _ _ b a H H2). +elim H3; intros. +rewrite (H4 a). +rewrite (H4 b). +case (Rle_dec b c); intro. +case (Rle_dec a c); intro. +assert (H5 : a = c). +unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. +rewrite H5; ring. +ring. +elim n; left; assumption. +split; [ right; reflexivity | left; assumption ]. +split; [ left; assumption | right; reflexivity ]. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). (* a>b & b=c *) -Rewrite <- b0. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or. -Rewrite <- b0 in o. -Elim o0; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim o; Intro. -Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)). -Assert H1 := (antiderivative_Ucte f x x0 b a H0 H). -Elim H1; Intros. -Rewrite (H2 b). -Rewrite (H2 a). -Ring. -Split; [Left; Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Left; Assumption]. +rewrite <- b0. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. +rewrite <- b0 in o. +elim o0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o; intro. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). +assert (H1 := antiderivative_Ucte f x x0 b a H0 H). +elim H1; intros. +rewrite (H2 b). +rewrite (H2 a). +ring. +split; [ left; assumption | right; reflexivity ]. +split; [ right; reflexivity | left; assumption ]. (* a>b & b>c *) -Elim o0; Intro. -Unfold antiderivative in H; Elim H; Clear H; Intros _ H. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). -Elim o1; Intro. -Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r0)). -Elim o; Intro. -Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? r0 r))). -Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H). -Assert H3 := (antiderivative_Ucte ? ? ? c a H1 H2). -Elim H3; Intros. -Assert H5 : ``c<=a``. -Unfold antiderivative in H1; Elim H1; Intros; Assumption. -Rewrite (H4 c). -Rewrite (H4 a). -Case (total_order_Rle a b); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r1 r)). -Case (total_order_Rle c b); Intro. -Ring. -Elim n0; Left; Assumption. -Split; [Assumption | Right; Reflexivity]. -Split; [Right; Reflexivity | Assumption]. +elim o0; intro. +unfold antiderivative in H; elim H; clear H; intros _ H. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). +elim o1; intro. +unfold antiderivative in H0; elim H0; clear H0; intros _ H0. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)). +elim o; intro. +unfold antiderivative in H1; elim H1; clear H1; intros _ H1. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))). +assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H). +assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2). +elim H3; intros. +assert (H5 : c <= a). +unfold antiderivative in H1; elim H1; intros; assumption. +rewrite (H4 c). +rewrite (H4 a). +case (Rle_dec a b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)). +case (Rle_dec c b); intro. +ring. +elim n0; left; assumption. +split; [ assumption | right; reflexivity ]. +split; [ right; reflexivity | assumption ]. Qed. - diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v index 2576d9275..4111377b7 100644 --- a/theories/Reals/PSeries_reg.v +++ b/theories/Reals/PSeries_reg.v @@ -8,187 +8,252 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Ranalysis1. -Require Max. -Require Even. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Ranalysis1. +Require Import Max. +Require Import Even. Open Local Scope R_scope. -Definition Boule [x:R;r:posreal] : R -> Prop := [y:R]``(Rabsolu (y-x))<r``. +Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r. (* Uniform convergence *) -Definition CVU [fn:nat->R->R;f:R->R;x:R;r:posreal] : Prop := (eps:R)``0<eps``->(EX N:nat | (n:nat;y:R) (le N n)->(Boule x r y)->``(Rabsolu ((f y)-(fn n y)))<eps``). +Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) + (r:posreal) : Prop := + forall eps:R, + 0 < eps -> + exists N : nat + | (forall (n:nat) (y:R), + (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). (* Normal convergence *) -Definition CVN_r [fn:nat->R->R;r:posreal] : Type := (SigT ? [An:nat->R](sigTT R [l:R]((Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu (An k)) n) l)/\((n:nat)(y:R)(Boule R0 r y)->(Rle (Rabsolu (fn n y)) (An n)))))). +Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type := + sigT + (fun An:nat -> R => + sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\ + (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))). -Definition CVN_R [fn:nat->R->R] : Type := (r:posreal) (CVN_r fn r). +Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r. -Definition SFL [fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))] : R-> R := [y:R](Cases (cv y) of (existTT a b) => a end). +Definition SFL (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (y:R) : R := match cv y with + | existT a b => a + end. (* In a complete space, normal convergence implies uniform convergence *) -Lemma CVN_CVU : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> (CVU [n:nat](SP fn n) (SFL fn cv) ``0`` r). -Intros; Unfold CVU; Intros. -Unfold CVN_r in X. -Elim X; Intros An X0. -Elim X0; Intros s H0. -Elim H0; Intros. -Cut (Un_cv [n:nat](Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s) R0). -Intro; Unfold Un_cv in H3. -Elim (H3 eps H); Intros N0 H4. -Exists N0; Intros. -Apply Rle_lt_trans with (Rabsolu (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)). -Rewrite <- (Rabsolu_Ropp (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)); Rewrite Ropp_distr3; Rewrite (Rabsolu_right (Rminus s (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n))). -EApply sum_maj1. -Unfold SFL; Case (cv y); Intro. -Trivial. -Apply H1. -Intro; Elim H0; Intros. -Rewrite (Rabsolu_right (An n0)). -Apply H8; Apply H6. -Apply Rle_sym1; Apply Rle_trans with (Rabsolu (fn n0 y)). -Apply Rabsolu_pos. -Apply H8; Apply H6. -Apply Rle_sym1; Apply Rle_anti_compatibility with (sum_f_R0 [k:nat](Rabsolu (An k)) n). -Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym s); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Apply sum_incr. -Apply H1. -Intro; Apply Rabsolu_pos. -Unfold R_dist in H4; Unfold Rminus in H4; Rewrite Ropp_O in H4. -Assert H7 := (H4 n H5). -Rewrite Rplus_Or in H7; Apply H7. -Unfold Un_cv in H1; Unfold Un_cv; Intros. -Elim (H1? H3); Intros. -Exists x; Intros. -Unfold R_dist; Unfold R_dist in H4. -Rewrite minus_R0; Apply H4; Assumption. +Lemma CVN_CVU : + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r. +intros; unfold CVU in |- *; intros. +unfold CVN_r in X. +elim X; intros An X0. +elim X0; intros s H0. +elim H0; intros. +cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0). +intro; unfold Un_cv in H3. +elim (H3 eps H); intros N0 H4. +exists N0; intros. +apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)). +rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)); + rewrite Ropp_minus_distr'; + rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)). +eapply sum_maj1. +unfold SFL in |- *; case (cv y); intro. +trivial. +apply H1. +intro; elim H0; intros. +rewrite (Rabs_right (An n0)). +apply H8; apply H6. +apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)). +apply Rabs_pos. +apply H8; apply H6. +apply Rle_ge; + apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n). +rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s); + rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; + apply sum_incr. +apply H1. +intro; apply Rabs_pos. +unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4. +assert (H7 := H4 n H5). +rewrite Rplus_0_r in H7; apply H7. +unfold Un_cv in H1; unfold Un_cv in |- *; intros. +elim (H1 _ H3); intros. +exists x; intros. +unfold R_dist in |- *; unfold R_dist in H4. +rewrite Rminus_0_r; apply H4; assumption. Qed. (* Each limit of a sequence of functions which converges uniformly is continue *) -Lemma CVU_continuity : (fn:nat->R->R;f:R->R;x:R;r:posreal) (CVU fn f x r) -> ((n:nat)(y:R) (Boule x r y)->(continuity_pt (fn n) y)) -> ((y:R) (Boule x r y) -> (continuity_pt f y)). -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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H ? H3); Intros N0 H4. -Assert H5 := (H0 N0 y H1). -Cut (EXT del : posreal | (h:R) ``(Rabsolu h)<del`` -> (Boule x r ``y+h``) ). -Intro. -Elim H6; Intros del1 H7. -Unfold continuity_pt in H5; Unfold continue_in in H5; Unfold limit1_in in H5; Unfold limit_in in H5; Simpl in H5; Unfold R_dist in H5. -Elim (H5 ? H3); Intros del2 H8. -Pose del := (Rmin del1 del2). -Exists del; Intros. -Split. -Unfold del; Unfold Rmin; Case (total_order_Rle del1 del2); Intro. -Apply (cond_pos del1). -Elim H8; Intros; Assumption. -Intros; Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(f y)))``. -Replace ``(f x0)-(f y)`` with ``((f x0)-(fn N0 x0))+((fn N0 x0)-(f y))``; [Apply Rabsolu_triang | Ring]. -Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(fn N0 y)))+(Rabsolu ((fn N0 y)-(f y)))``. -Rewrite Rplus_assoc; Apply Rle_compatibility. -Replace ``(fn N0 x0)-(f y)`` with ``((fn N0 x0)-(fn N0 y))+((fn N0 y)-(f y))``; [Apply Rabsolu_triang | Ring]. -Replace ``eps`` with ``eps/3+eps/3+eps/3``. -Repeat Apply Rplus_lt. -Apply H4. -Apply le_n. -Replace x0 with ``y+(x0-y)``; [Idtac | Ring]; Apply H7. -Elim H9; Intros. -Apply Rlt_le_trans with del. -Assumption. -Unfold del; 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; Apply Rmin_r. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H4. -Apply le_n. -Assumption. -Apply r_Rmult_mult with ``3``. -Do 2 Rewrite Rmult_Rplus_distr; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m. -Ring. -DiscrR. -DiscrR. -Cut ``0<r-(Rabsolu (x-y))``. -Intro; Exists (mkposreal ? H6). -Simpl; Intros. -Unfold Boule; Replace ``y+h-x`` with ``h+(y-x)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu h)+(Rabsolu (y-x))``. -Apply Rabsolu_triang. -Apply Rlt_anti_compatibility with ``-(Rabsolu (x-y))``. -Rewrite <- (Rabsolu_Ropp ``y-x``); Rewrite Ropp_distr3. -Replace ``-(Rabsolu (x-y))+r`` with ``r-(Rabsolu (x-y))``. -Replace ``-(Rabsolu (x-y))+((Rabsolu h)+(Rabsolu (x-y)))`` with (Rabsolu h). -Apply H7. -Ring. -Ring. -Unfold Boule in H1; Rewrite <- (Rabsolu_Ropp ``x-y``); Rewrite Ropp_distr3; Apply Rlt_anti_compatibility with ``(Rabsolu (y-x))``. -Rewrite Rplus_Or; Replace ``(Rabsolu (y-x))+(r-(Rabsolu (y-x)))`` with ``(pos r)``; [Apply H1 | Ring]. +Lemma CVU_continuity : + forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal), + CVU fn f x r -> + (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) -> + forall y:R, Boule x r y -> continuity_pt f y. +intros; unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +unfold CVU in H. +cut (0 < eps / 3); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H _ H3); intros N0 H4. +assert (H5 := H0 N0 y H1). +cut ( exists del : posreal | (forall h:R, Rabs h < del -> Boule x r (y + h))). +intro. +elim H6; intros del1 H7. +unfold continuity_pt in H5; unfold continue_in in H5; unfold limit1_in in H5; + unfold limit_in in H5; simpl in H5; unfold R_dist in H5. +elim (H5 _ H3); intros del2 H8. +pose (del := Rmin del1 del2). +exists del; intros. +split. +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro. +apply (cond_pos del1). +elim H8; intros; assumption. +intros; + apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)). +replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y)); + [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with + (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)). +rewrite Rplus_assoc; apply Rplus_le_compat_l. +replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y)); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 3 + eps / 3 + eps / 3). +repeat apply Rplus_lt_compat. +apply H4. +apply le_n. +replace x0 with (y + (x0 - y)); [ idtac | ring ]; apply H7. +elim H9; intros. +apply Rlt_le_trans with del. +assumption. +unfold del in |- *; apply Rmin_l. +elim H8; intros. +apply H11. +split. +elim H9; intros; assumption. +elim H9; intros; apply Rlt_le_trans with del. +assumption. +unfold del in |- *; apply Rmin_r. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4. +apply le_n. +assumption. +apply Rmult_eq_reg_l with 3. +do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rinv_r_simpl_m. +ring. +discrR. +discrR. +cut (0 < r - Rabs (x - y)). +intro; exists (mkposreal _ H6). +simpl in |- *; intros. +unfold Boule in |- *; replace (y + h - x) with (h + (y - x)); + [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)). +apply Rabs_triang. +apply Rplus_lt_reg_r with (- Rabs (x - y)). +rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'. +replace (- Rabs (x - y) + r) with (r - Rabs (x - y)). +replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h). +apply H7. +ring. +ring. +unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr'; + apply Rplus_lt_reg_r with (Rabs (y - x)). +rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r); + [ apply H1 | ring ]. Qed. (**********) -Lemma continuity_pt_finite_SF : (fn:nat->R->R;N:nat;x:R) ((n:nat)(le n N)->(continuity_pt (fn n) x)) -> (continuity_pt [y:R](sum_f_R0 [k:nat]``(fn k y)`` N) x). -Intros; Induction N. -Simpl; Apply (H O); Apply le_n. -Simpl; Replace [y:R](Rplus (sum_f_R0 [k:nat](fn k y) N) (fn (S N) y)) with (plus_fct [y:R](sum_f_R0 [k:nat](fn k y) N) [y:R](fn (S N) y)); [Idtac | Reflexivity]. -Apply continuity_pt_plus. -Apply HrecN. -Intros; Apply H. -Apply le_trans with N; [Assumption | Apply le_n_Sn]. -Apply (H (S N)); Apply le_n. +Lemma continuity_pt_finite_SF : + forall (fn:nat -> R -> R) (N:nat) (x:R), + (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) -> + continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x. +intros; induction N as [| N HrecN]. +simpl in |- *; apply (H 0%nat); apply le_n. +simpl in |- *; + replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with + ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F; + [ idtac | reflexivity ]. +apply continuity_pt_plus. +apply HrecN. +intros; apply H. +apply le_trans with N; [ assumption | apply le_n_Sn ]. +apply (H (S N)); apply le_n. Qed. (* Continuity and normal convergence *) -Lemma SFL_continuity_pt : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> ((n:nat)(y:R) (Boule ``0`` r y) -> (continuity_pt (fn n) y)) -> ((y:R) (Boule ``0`` r y) -> (continuity_pt (SFL fn cv) y)). -Intros; EApply CVU_continuity. -Apply CVN_CVU. -Apply X. -Intros; Unfold SP; Apply continuity_pt_finite_SF. -Intros; Apply H. -Apply H1. -Apply H0. +Lemma SFL_continuity_pt : + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (r:posreal), + CVN_r fn r -> + (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) -> + forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y. +intros; eapply CVU_continuity. +apply CVN_CVU. +apply X. +intros; unfold SP in |- *; apply continuity_pt_finite_SF. +intros; apply H. +apply H1. +apply H0. Qed. -Lemma SFL_continuity : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))) (CVN_R fn) -> ((n:nat)(continuity (fn n))) -> (continuity (SFL fn cv)). -Intros; Unfold continuity; Intro. -Cut ``0<(Rabsolu x)+1``; [Intro | Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1]]. -Cut (Boule ``0`` (mkposreal ? H0) x). -Intro; EApply SFL_continuity_pt with (mkposreal ? H0). -Apply X. -Intros; Apply (H n y). -Apply H1. -Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1. +Lemma SFL_continuity : + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)), + CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv). +intros; unfold continuity in |- *; intro. +cut (0 < Rabs x + 1); + [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ]. +cut (Boule 0 (mkposreal _ H0) x). +intro; eapply SFL_continuity_pt with (mkposreal _ H0). +apply X. +intros; apply (H n y). +apply H1. +unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r; + pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1. Qed. (* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) -Lemma CVN_R_CVS : (fn:nat->R->R) (CVN_R fn) -> ((x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))). -Intros; Apply R_complete. -Unfold SP; Pose An := [N:nat](fn N x). -Change (Cauchy_crit_series An). -Apply cauchy_abs. -Unfold Cauchy_crit_series; Apply CV_Cauchy. -Unfold CVN_R in X; Cut ``0<(Rabsolu x)+1``. -Intro; Assert H0 := (X (mkposreal ? H)). -Unfold CVN_r in H0; Elim H0; Intros Bn H1. -Elim H1; Intros l H2. -Elim H2; Intros. -Apply Rseries_CV_comp with Bn. -Intro; Split. -Apply Rabsolu_pos. -Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0. -Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1. -Apply existTT with l. -Cut (n:nat)``0<=(Bn n)``. -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 [k:nat](Rabsolu (Bn k)) n). -Apply H7; Assumption. -Apply sum_eq; Intros; Apply Rabsolu_right; Apply Rle_sym1; Apply H5. -Intro; Apply Rle_trans with (Rabsolu (An n)). -Apply Rabsolu_pos. -Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1. -Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1]. -Qed. +Lemma CVN_R_CVS : + forall fn:nat -> R -> R, + CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l). +intros; apply R_complete. +unfold SP in |- *; pose (An := fun N:nat => fn N x). +change (Cauchy_crit_series An) in |- *. +apply cauchy_abs. +unfold Cauchy_crit_series in |- *; apply CV_Cauchy. +unfold CVN_R in X; cut (0 < Rabs x + 1). +intro; assert (H0 := X (mkposreal _ H)). +unfold CVN_r in H0; elim H0; intros Bn H1. +elim H1; intros l H2. +elim H2; intros. +apply Rseries_CV_comp with Bn. +intro; split. +apply Rabs_pos. +unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + rewrite Rminus_0_r. +pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + apply Rlt_0_1. +apply existT with l. +cut (forall n:nat, 0 <= Bn n). +intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros. +elim (H3 _ H6); intros. +exists x0; intros. +replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n). +apply H7; assumption. +apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5. +intro; apply Rle_trans with (Rabs (An n)). +apply Rabs_pos. +unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; + rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. +apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v index 090680cf1..c12aea9df 100644 --- a/theories/Reals/PartSum.v +++ b/theories/Reals/PartSum.v @@ -8,469 +8,596 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require Rcomplete. -Require Max. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import Rcomplete. +Require Import Max. Open Local Scope R_scope. -Lemma tech1 : (An:nat->R;N:nat) ((n:nat)``(le n N)``->``0<(An n)``) -> ``0 < (sum_f_R0 An N)``. -Intros; Induction N. -Simpl; Apply H; Apply le_n. -Simpl; Apply gt0_plus_gt0_is_gt0. -Apply HrecN; Intros; Apply H; Apply le_S; Assumption. -Apply H; Apply le_n. +Lemma tech1 : + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H; apply le_n. +simpl in |- *; apply Rplus_lt_0_compat. +apply HrecN; intros; apply H; apply le_S; assumption. +apply H; apply le_n. Qed. (* Chasles' relation *) -Lemma tech2 : (An:nat->R;m,n:nat) (lt m n) -> (sum_f_R0 An n) == (Rplus (sum_f_R0 An m) (sum_f_R0 [i:nat]``(An (plus (S m) i))`` (minus n (S m)))). -Intros; Induction n. -Elim (lt_n_O ? H). -Cut (lt m n)\/m=n. -Intro; Elim H0; Intro. -Replace (sum_f_R0 An (S n)) with ``(sum_f_R0 An n)+(An (S n))``; [Idtac | Reflexivity]. -Replace (minus (S n) (S m)) with (S (minus n (S m))). -Replace (sum_f_R0 [i:nat](An (plus (S m) i)) (S (minus n (S m)))) with (Rplus (sum_f_R0 [i:nat](An (plus (S m) i)) (minus n (S m))) (An (plus (S m) (S (minus n (S m)))))); [Idtac | Reflexivity]. -Replace (plus (S m) (S (minus n (S m)))) with (S n). -Rewrite (Hrecn H1). -Ring. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR. -Rewrite S_INR; Ring. -Apply lt_le_S; Assumption. -Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR. -Repeat Rewrite S_INR; Ring. -Apply le_n_S; Apply lt_le_weak; Assumption. -Apply lt_le_S; Assumption. -Rewrite H1; Rewrite <- minus_n_n; Simpl. -Replace (plus n O) with n; [Reflexivity | Ring]. -Inversion H. -Right; Reflexivity. -Left; Apply lt_le_trans with (S m); [Apply lt_n_Sn | Assumption]. +Lemma tech2 : + forall (An:nat -> R) (m n:nat), + (m < n)%nat -> + sum_f_R0 An n = + sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). +intros; induction n as [| n Hrecn]. +elim (lt_n_O _ H). +cut ((m < n)%nat \/ m = n). +intro; elim H0; intro. +replace (sum_f_R0 An (S n)) with (sum_f_R0 An n + An (S n)); + [ idtac | reflexivity ]. +replace (S n - S m)%nat with (S (n - S m)). +replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with + (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) + + An (S m + S (n - S m))%nat); [ idtac | reflexivity ]. +replace (S m + S (n - S m))%nat with (S n). +rewrite (Hrecn H1). +ring. +apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite S_INR; + rewrite minus_INR. +rewrite S_INR; ring. +apply lt_le_S; assumption. +apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. +repeat rewrite S_INR; ring. +apply le_n_S; apply lt_le_weak; assumption. +apply lt_le_S; assumption. +rewrite H1; rewrite <- minus_n_n; simpl in |- *. +replace (n + 0)%nat with n; [ reflexivity | ring ]. +inversion H. +right; reflexivity. +left; apply lt_le_trans with (S m); [ apply lt_n_Sn | assumption ]. Qed. (* Sum of geometric sequences *) -Lemma tech3 : (k:R;N:nat) ``k<>1`` -> (sum_f_R0 [i:nat](pow k i) N)==``(1-(pow k (S N)))/(1-k)``. -Intros; Cut ``1-k<>0``. -Intro; Induction N. -Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym. -Reflexivity. -Apply H0. -Replace (sum_f_R0 ([i:nat](pow k i)) (S N)) with (Rplus (sum_f_R0 [i:nat](pow k i) N) (pow k (S N))); [Idtac | Reflexivity]; Rewrite HrecN; Replace ``(1-(pow k (S N)))/(1-k)+(pow k (S N))`` with ``((1-(pow k (S N)))+(1-k)*(pow k (S N)))/(1-k)``. -Apply r_Rmult_mult with ``1-k``. -Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(1-k)``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [ Do 2 Rewrite Rmult_1l; Simpl; Ring | Apply H0]. -Apply H0. -Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite (Rmult_sym ``1-k``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Reflexivity. -Apply H0. -Apply Rminus_eq_contra; Red; Intro; Elim H; Symmetry; Assumption. +Lemma tech3 : + forall (k:R) (N:nat), + k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k). +intros; cut (1 - k <> 0). +intro; induction N as [| N HrecN]. +simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. +reflexivity. +apply H0. +replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with + (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ]; + rewrite HrecN; + replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with + ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)). +apply Rmult_eq_reg_l with (1 - k). +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k))); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ]. +apply H0. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k)); + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; reflexivity. +apply H0. +apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry in |- *; + assumption. Qed. -Lemma tech4 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> ``(An N)<=(An O)*(pow k N)``. -Intros; Induction N. -Simpl; Right; Ring. -Apply Rle_trans with ``k*(An N)``. -Left; Apply (H0 N). -Replace (S N) with (plus N (1)); [Idtac | Ring]. -Rewrite pow_add; Simpl; Rewrite Rmult_1r; Replace ``(An O)*((pow k N)*k)`` with ``k*((An O)*(pow k N))``; [Idtac | Ring]; Apply Rle_monotony. -Assumption. -Apply HrecN. +Lemma tech4 : + forall (An:nat -> R) (k:R) (N:nat), + 0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N. +intros; induction N as [| N HrecN]. +simpl in |- *; right; ring. +apply Rle_trans with (k * An N). +left; apply (H0 N). +replace (S N) with (N + 1)%nat; [ idtac | ring ]. +rewrite pow_add; simpl in |- *; rewrite Rmult_1_r; + replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N)); + [ idtac | ring ]; apply Rmult_le_compat_l. +assumption. +apply HrecN. Qed. -Lemma tech5 : (An:nat->R;N:nat) (sum_f_R0 An (S N))==``(sum_f_R0 An N)+(An (S N))``. -Intros; Reflexivity. +Lemma tech5 : + forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N). +intros; reflexivity. Qed. -Lemma tech6 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> (Rle (sum_f_R0 An N) (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N))). -Intros; Induction N. -Simpl; Right; Ring. -Apply Rle_trans with (Rplus (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N)) (An (S N))). -Rewrite tech5; Do 2 Rewrite <- (Rplus_sym (An (S N))); Apply Rle_compatibility. -Apply HrecN. -Rewrite tech5 ; Rewrite Rmult_Rplus_distr; Apply Rle_compatibility. -Apply tech4; Assumption. +Lemma tech6 : + forall (An:nat -> R) (k:R) (N:nat), + 0 <= k -> + (forall i:nat, An (S i) < k * An i) -> + sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N. +intros; induction N as [| N HrecN]. +simpl in |- *; right; ring. +apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)). +rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N))); + apply Rplus_le_compat_l. +apply HrecN. +rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l. +apply tech4; assumption. Qed. -Lemma tech7 : (r1,r2:R) ``r1<>0`` -> ``r2<>0`` -> ``r1<>r2`` -> ``/r1<>/r2``. -Intros; Red; Intro. -Assert H3 := (Rmult_mult_r r1 ? ? H2). -Rewrite <- Rinv_r_sym in H3; [Idtac | Assumption]. -Assert H4 := (Rmult_mult_r r2 ? ? H3). -Rewrite Rmult_1r in H4; Rewrite <- Rmult_assoc in H4. -Rewrite Rinv_r_simpl_m in H4; [Idtac | Assumption]. -Elim H1; Symmetry; Assumption. +Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2. +intros; red in |- *; intro. +assert (H3 := Rmult_eq_compat_l r1 _ _ H2). +rewrite <- Rinv_r_sym in H3; [ idtac | assumption ]. +assert (H4 := Rmult_eq_compat_l r2 _ _ H3). +rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4. +rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ]. +elim H1; symmetry in |- *; assumption. Qed. -Lemma tech11 : (An,Bn,Cn:nat->R;N:nat) ((i:nat) (An i)==``(Bn i)-(Cn i)``) -> (sum_f_R0 An N)==``(sum_f_R0 Bn N)-(sum_f_R0 Cn N)``. -Intros; Induction N. -Simpl; Apply H. -Do 3 Rewrite tech5; Rewrite HrecN; Rewrite (H (S N)); Ring. +Lemma tech11 : + forall (An Bn Cn:nat -> R) (N:nat), + (forall i:nat, An i = Bn i - Cn i) -> + sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H. +do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring. Qed. -Lemma tech12 : (An:nat->R;x:R;l:R) (Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l) -> (Pser An x l). -Intros; Unfold Pser; Unfold infinit_sum; Unfold Un_cv in H; Assumption. +Lemma tech12 : + forall (An:nat -> R) (x l:R), + Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l -> + Pser An x l. +intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H; + assumption. Qed. -Lemma scal_sum : (An:nat->R;N:nat;x:R) (Rmult x (sum_f_R0 An N))==(sum_f_R0 [i:nat]``(An i)*x`` N). -Intros; Induction N. -Simpl; Ring. -Do 2 Rewrite tech5. -Rewrite Rmult_Rplus_distr; Rewrite <- HrecN; Ring. +Lemma scal_sum : + forall (An:nat -> R) (N:nat) (x:R), + x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N. +intros; induction N as [| N HrecN]. +simpl in |- *; ring. +do 2 rewrite tech5. +rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring. Qed. -Lemma decomp_sum : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==(Rplus (An O) (sum_f_R0 [i:nat](An (S i)) (pred N))). -Intros; Induction N. -Elim (lt_n_n ? H). -Cut (lt O N)\/N=O. -Intro; Elim H0; Intro. -Cut (S (pred N))=(pred (S N)). -Intro; Rewrite <- H2. -Do 2 Rewrite tech5. -Replace (S (S (pred N))) with (S N). -Rewrite (HrecN H1); Ring. -Rewrite H2; Simpl; Reflexivity. -Assert H2 := (O_or_S N). -Elim H2; Intros. -Elim a; Intros. -Rewrite <- p. -Simpl; Reflexivity. -Rewrite <- b in H1; Elim (lt_n_n ? H1). -Rewrite H1; Simpl; Reflexivity. -Inversion H. -Right; Reflexivity. -Left; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption]. +Lemma decomp_sum : + forall (An:nat -> R) (N:nat), + (0 < N)%nat -> + sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N). +intros; induction N as [| N HrecN]. +elim (lt_irrefl _ H). +cut ((0 < N)%nat \/ N = 0%nat). +intro; elim H0; intro. +cut (S (pred N) = pred (S N)). +intro; rewrite <- H2. +do 2 rewrite tech5. +replace (S (S (pred N))) with (S N). +rewrite (HrecN H1); ring. +rewrite H2; simpl in |- *; reflexivity. +assert (H2 := O_or_S N). +elim H2; intros. +elim a; intros. +rewrite <- p. +simpl in |- *; reflexivity. +rewrite <- b in H1; elim (lt_irrefl _ H1). +rewrite H1; simpl in |- *; reflexivity. +inversion H. +right; reflexivity. +left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. Qed. -Lemma plus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)+(Bn i)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``. -Intros; Induction N. -Simpl; Ring. -Do 3 Rewrite tech5; Rewrite HrecN; Ring. +Lemma plus_sum : + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N. +intros; induction N as [| N HrecN]. +simpl in |- *; ring. +do 3 rewrite tech5; rewrite HrecN; ring. Qed. -Lemma sum_eq : (An,Bn:nat->R;N:nat) ((i:nat)(le i N)->(An i)==(Bn i)) -> (sum_f_R0 An N)==(sum_f_R0 Bn N). -Intros; Induction 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]. +Lemma sum_eq : + forall (An Bn:nat -> R) (N:nat), + (forall i:nat, (i <= N)%nat -> An i = Bn i) -> + sum_f_R0 An N = sum_f_R0 Bn N. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H; apply le_n. +do 2 rewrite tech5; rewrite HrecN. +rewrite (H (S N)); [ reflexivity | apply le_n ]. +intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ]. Qed. (* Unicity of the limit defined by convergent series *) -Lemma unicity_sum : (An:nat->R;l1,l2:R) (infinit_sum An l1) -> (infinit_sum An l2) -> l1 == l2. -Unfold infinit_sum; Intros. -Case (Req_EM l1 l2); Intro. -Assumption. -Cut ``0<(Rabsolu ((l1-l2)/2))``; [Intro | Apply Rabsolu_pos_lt]. -Elim (H ``(Rabsolu ((l1-l2)/2))`` H2); Intros. -Elim (H0 ``(Rabsolu ((l1-l2)/2))`` H2); Intros. -Pose N := (max x0 x); Cut (ge N x0). -Cut (ge N x). -Intros; Assert H7 := (H3 N H5); Assert H8 := (H4 N H6). -Cut ``(Rabsolu (l1-l2)) <= (R_dist (sum_f_R0 An N) l1) + (R_dist (sum_f_R0 An N) l2)``. -Intro; Assert H10 := (Rplus_lt ? ? ? ? H7 H8); Assert H11 := (Rle_lt_trans ? ? ? H9 H10); Unfold Rdiv in H11; Rewrite Rabsolu_mult in H11. -Cut ``(Rabsolu (/2))==/2``. -Intro; Rewrite H12 in H11; Assert H13 := double_var; Unfold Rdiv in H13; Rewrite <- H13 in H11. -Elim (Rlt_antirefl ? H11). -Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H20; Generalize (lt_INR_0 (2) (neq_O_lt (2) H20)); Unfold INR; Intro; Assumption | Discriminate]. -Unfold R_dist; Rewrite <- (Rabsolu_Ropp ``(sum_f_R0 An N)-l1``); Rewrite Ropp_distr3. -Replace ``l1-l2`` with ``((l1-(sum_f_R0 An N)))+((sum_f_R0 An N)-l2)``; [Idtac | Ring]. -Apply Rabsolu_triang. -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_R0; DiscrR. +Lemma uniqueness_sum : + forall (An:nat -> R) (l1 l2:R), + infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2. +unfold infinit_sum in |- *; intros. +case (Req_dec l1 l2); intro. +assumption. +cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ]. +elim (H (Rabs ((l1 - l2) / 2)) H2); intros. +elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros. +pose (N := max x0 x); cut (N >= x0)%nat. +cut (N >= x)%nat. +intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6). +cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2). +intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8); + assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11; + rewrite Rabs_mult in H11. +cut (Rabs (/ 2) = / 2). +intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13; + rewrite <- H13 in H11. +elim (Rlt_irrefl _ H11). +apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat; + cut (0%nat <> 2%nat); + [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *; + intro; assumption + | discriminate ]. +unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1)); + rewrite Ropp_minus_distr'. +replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2)); + [ idtac | ring ]. +apply Rabs_triang. +unfold ge in |- *; unfold N in |- *; apply le_max_r. +unfold ge in |- *; unfold N in |- *; apply le_max_l. +unfold Rdiv in |- *; apply prod_neq_R0. +apply Rminus_eq_contra; assumption. +apply Rinv_neq_0_compat; discrR. Qed. -Lemma minus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)-(Bn i)`` N)==``(sum_f_R0 An N)-(sum_f_R0 Bn N)``. -Intros; Induction N. -Simpl; Ring. -Do 3 Rewrite tech5; Rewrite HrecN; Ring. +Lemma minus_sum : + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. +intros; induction N as [| N HrecN]. +simpl in |- *; ring. +do 3 rewrite tech5; rewrite HrecN; ring. Qed. -Lemma sum_decomposition : (An:nat->R;N:nat) (Rplus (sum_f_R0 [l:nat](An (mult (2) l)) (S N)) (sum_f_R0 [l:nat](An (S (mult (2) l))) N))==(sum_f_R0 An (mult (2) (S N))). -Intros. -Induction N. -Simpl; Ring. -Rewrite tech5. -Rewrite (tech5 [l:nat](An (S (mult (2) l))) N). -Replace (mult (2) (S (S N))) with (S (S (mult (2) (S N)))). -Rewrite (tech5 An (S (mult (2) (S N)))). -Rewrite (tech5 An (mult (2) (S N))). -Rewrite <- HrecN. -Ring. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR;Repeat Rewrite S_INR. -Ring. +Lemma sum_decomposition : + forall (An:nat -> R) (N:nat), + sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) + + sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N). +intros. +induction N as [| N HrecN]. +simpl in |- *; ring. +rewrite tech5. +rewrite (tech5 (fun l:nat => An (S (2 * l))) N). +replace (2 * S (S N))%nat with (S (S (2 * S N))). +rewrite (tech5 An (S (2 * S N))). +rewrite (tech5 An (2 * S N)). +rewrite <- HrecN. +ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR. +ring. Qed. -Lemma sum_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``(An n)<=(Bn n)``) -> ``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``. -Intros. -Induction N. -Simpl; Apply H. -Apply le_n. -Do 2 Rewrite tech5. -Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``. -Apply Rle_compatibility. -Apply H. -Apply le_n. -Do 2 Rewrite <- (Rplus_sym ``(Bn (S N))``). -Apply Rle_compatibility. -Apply HrecN. -Intros; Apply H. -Apply le_trans with N; [Assumption | Apply le_n_Sn]. +Lemma sum_Rle : + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> An n <= Bn n) -> + sum_f_R0 An N <= sum_f_R0 Bn N. +intros. +induction N as [| N HrecN]. +simpl in |- *; apply H. +apply le_n. +do 2 rewrite tech5. +apply Rle_trans with (sum_f_R0 An N + Bn (S N)). +apply Rplus_le_compat_l. +apply H. +apply le_n. +do 2 rewrite <- (Rplus_comm (Bn (S N))). +apply Rplus_le_compat_l. +apply HrecN. +intros; apply H. +apply le_trans with N; [ assumption | apply le_n_Sn ]. Qed. -Lemma sum_Rabsolu : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [l:nat](Rabsolu (An l)) N)). -Intros. -Induction N. -Simpl. -Right; Reflexivity. -Do 2 Rewrite tech5. -Apply Rle_trans with ``(Rabsolu (sum_f_R0 An N))+(Rabsolu (An (S N)))``. -Apply Rabsolu_triang. -Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))). -Apply Rle_compatibility. -Apply HrecN. +Lemma Rsum_abs : + forall (An:nat -> R) (N:nat), + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N. +intros. +induction N as [| N HrecN]. +simpl in |- *. +right; reflexivity. +do 2 rewrite tech5. +apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). +apply Rabs_triang. +do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). +apply Rplus_le_compat_l. +apply HrecN. Qed. -Lemma sum_cte : (x:R;N:nat) (sum_f_R0 [_:nat]x N) == ``x*(INR (S N))``. -Intros. -Induction N. -Simpl; Ring. -Rewrite tech5. -Rewrite HrecN; Repeat Rewrite S_INR; Ring. +Lemma sum_cte : + forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N). +intros. +induction N as [| N HrecN]. +simpl in |- *; ring. +rewrite tech5. +rewrite HrecN; repeat rewrite S_INR; ring. Qed. (**********) -Lemma sum_growing : (An,Bn:nat->R;N:nat) ((n:nat)``(An n)<=(Bn n)``)->``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``. -Intros. -Induction N. -Simpl; Apply H. -Do 2 Rewrite tech5. -Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``. -Apply Rle_compatibility; Apply H. -Do 2 Rewrite <- (Rplus_sym (Bn (S N))). -Apply Rle_compatibility; Apply HrecN. +Lemma sum_growing : + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N. +intros. +induction N as [| N HrecN]. +simpl in |- *; apply H. +do 2 rewrite tech5. +apply Rle_trans with (sum_f_R0 An N + Bn (S N)). +apply Rplus_le_compat_l; apply H. +do 2 rewrite <- (Rplus_comm (Bn (S N))). +apply Rplus_le_compat_l; apply HrecN. Qed. (**********) -Lemma Rabsolu_triang_gen : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [i:nat](Rabsolu (An i)) N)). -Intros. -Induction N. -Simpl. -Right; Reflexivity. -Do 2 Rewrite tech5. -Apply Rle_trans with ``(Rabsolu ((sum_f_R0 An N)))+(Rabsolu (An (S N)))``. -Apply Rabsolu_triang. -Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))). -Apply Rle_compatibility; Apply HrecN. +Lemma Rabs_triang_gen : + forall (An:nat -> R) (N:nat), + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. +intros. +induction N as [| N HrecN]. +simpl in |- *. +right; reflexivity. +do 2 rewrite tech5. +apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). +apply Rabs_triang. +do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). +apply Rplus_le_compat_l; apply HrecN. Qed. (**********) -Lemma cond_pos_sum : (An:nat->R;N:nat) ((n:nat)``0<=(An n)``) -> ``0<=(sum_f_R0 An N)``. -Intros. -Induction N. -Simpl; Apply H. -Rewrite tech5. -Apply ge0_plus_ge0_is_ge0. -Apply HrecN. -Apply H. +Lemma cond_pos_sum : + forall (An:nat -> R) (N:nat), + (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N. +intros. +induction N as [| N HrecN]. +simpl in |- *; apply H. +rewrite tech5. +apply Rplus_le_le_0_compat. +apply HrecN. +apply H. Qed. (* Cauchy's criterion for series *) -Definition Cauchy_crit_series [An:nat->R] : Prop := (Cauchy_crit [N:nat](sum_f_R0 An N)). +Definition Cauchy_crit_series (An:nat -> R) : Prop := + Cauchy_crit (fun N:nat => sum_f_R0 An N). (* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *) -Lemma cauchy_abs : (An:nat->R) (Cauchy_crit_series [i:nat](Rabsolu (An i))) -> (Cauchy_crit_series An). -Unfold Cauchy_crit_series; Unfold Cauchy_crit. -Intros. -Elim (H eps H0); Intros. -Exists x. -Intros. -Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m))). -Intro. -Apply Rle_lt_trans with (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m)). -Assumption. -Apply H1; Assumption. -Assert H4 := (lt_eq_lt_dec n m). -Elim H4; Intro. -Elim a; Intro. -Rewrite (tech2 An n m); [Idtac | Assumption]. -Rewrite (tech2 [i:nat](Rabsolu (An i)) n m); [Idtac | Assumption]. -Unfold R_dist. -Unfold Rminus. -Do 2 Rewrite Ropp_distr1. -Do 2 Rewrite <- Rplus_assoc. -Do 2 Rewrite Rplus_Ropp_r. -Do 2 Rewrite Rplus_Ol. -Do 2 Rewrite Rabsolu_Ropp. -Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S n) i))) (minus m (S n)))). -Pose Bn:=[i:nat](An (plus (S n) i)). -Replace [i:nat](Rabsolu (An (plus (S n) i))) with [i:nat](Rabsolu (Bn i)). -Apply Rabsolu_triang_gen. -Unfold Bn; Reflexivity. -Apply Rle_sym1. -Apply cond_pos_sum. -Intro; Apply Rabsolu_pos. -Rewrite b. -Unfold R_dist. -Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r. -Rewrite Rabsolu_R0; Right; Reflexivity. -Rewrite (tech2 An m n); [Idtac | Assumption]. -Rewrite (tech2 [i:nat](Rabsolu (An i)) m n); [Idtac | Assumption]. -Unfold R_dist. -Unfold Rminus. -Do 2 Rewrite Rplus_assoc. -Rewrite (Rplus_sym (sum_f_R0 An m)). -Rewrite (Rplus_sym (sum_f_R0 [i:nat](Rabsolu (An i)) m)). -Do 2 Rewrite Rplus_assoc. -Do 2 Rewrite Rplus_Ropp_l. -Do 2 Rewrite Rplus_Or. -Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S m) i))) (minus n (S m)))). -Pose Bn:=[i:nat](An (plus (S m) i)). -Replace [i:nat](Rabsolu (An (plus (S m) i))) with [i:nat](Rabsolu (Bn i)). -Apply Rabsolu_triang_gen. -Unfold Bn; Reflexivity. -Apply Rle_sym1. -Apply cond_pos_sum. -Intro; Apply Rabsolu_pos. +Lemma cauchy_abs : + forall An:nat -> R, + Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An. +unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. +intros. +elim (H eps H0); intros. +exists x. +intros. +cut + (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= + R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) + (sum_f_R0 (fun i:nat => Rabs (An i)) m)). +intro. +apply Rle_lt_trans with + (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) + (sum_f_R0 (fun i:nat => Rabs (An i)) m)). +assumption. +apply H1; assumption. +assert (H4 := lt_eq_lt_dec n m). +elim H4; intro. +elim a; intro. +rewrite (tech2 An n m); [ idtac | assumption ]. +rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ]. +unfold R_dist in |- *. +unfold Rminus in |- *. +do 2 rewrite Ropp_plus_distr. +do 2 rewrite <- Rplus_assoc. +do 2 rewrite Rplus_opp_r. +do 2 rewrite Rplus_0_l. +do 2 rewrite Rabs_Ropp. +rewrite + (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n))) + . +pose (Bn := fun i:nat => An (S n + i)%nat). +replace (fun i:nat => Rabs (An (S n + i)%nat)) with + (fun i:nat => Rabs (Bn i)). +apply Rabs_triang_gen. +unfold Bn in |- *; reflexivity. +apply Rle_ge. +apply cond_pos_sum. +intro; apply Rabs_pos. +rewrite b. +unfold R_dist in |- *. +unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. +rewrite Rabs_R0; right; reflexivity. +rewrite (tech2 An m n); [ idtac | assumption ]. +rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ]. +unfold R_dist in |- *. +unfold Rminus in |- *. +do 2 rewrite Rplus_assoc. +rewrite (Rplus_comm (sum_f_R0 An m)). +rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)). +do 2 rewrite Rplus_assoc. +do 2 rewrite Rplus_opp_l. +do 2 rewrite Rplus_0_r. +rewrite + (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m))) + . +pose (Bn := fun i:nat => An (S m + i)%nat). +replace (fun i:nat => Rabs (An (S m + i)%nat)) with + (fun i:nat => Rabs (Bn i)). +apply Rabs_triang_gen. +unfold Bn in |- *; reflexivity. +apply Rle_ge. +apply cond_pos_sum. +intro; apply Rabs_pos. Qed. (**********) -Lemma cv_cauchy_1 : (An:nat->R) (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (Cauchy_crit_series An). -Intros. -Elim X; Intros. -Unfold Un_cv in p. -Unfold Cauchy_crit_series; Unfold Cauchy_crit. -Intros. -Cut ``0<eps/2``. -Intro. -Elim (p ``eps/2`` H0); Intros. -Exists x0. -Intros. -Apply Rle_lt_trans with ``(R_dist (sum_f_R0 An n) x)+(R_dist (sum_f_R0 An m) x)``. -Unfold R_dist. -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 <- (Rabsolu_Ropp ``(sum_f_R0 An m)-x``). -Apply Rabsolu_triang. -Apply Rlt_le_trans with ``eps/2+eps/2``. -Apply Rplus_lt. -Apply H1; Assumption. -Apply H1; Assumption. -Right; Symmetry; Apply double_var. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. +Lemma cv_cauchy_1 : + forall An:nat -> R, + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> + Cauchy_crit_series An. +intros. +elim X; intros. +unfold Un_cv in p. +unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. +intros. +cut (0 < eps / 2). +intro. +elim (p (eps / 2) H0); intros. +exists x0. +intros. +apply Rle_lt_trans with (R_dist (sum_f_R0 An n) x + R_dist (sum_f_R0 An m) x). +unfold R_dist in |- *. +replace (sum_f_R0 An n - sum_f_R0 An m) with + (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ]. +rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)). +apply Rabs_triang. +apply Rlt_le_trans with (eps / 2 + eps / 2). +apply Rplus_lt_compat. +apply H1; assumption. +apply H1; assumption. +right; symmetry in |- *; apply double_var. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. -Lemma cv_cauchy_2 : (An:nat->R) (Cauchy_crit_series An) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intros. -Apply R_complete. -Unfold Cauchy_crit_series in H. -Exact H. +Lemma cv_cauchy_2 : + forall An:nat -> R, + Cauchy_crit_series An -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros. +apply R_complete. +unfold Cauchy_crit_series in H. +exact H. Qed. (**********) -Lemma sum_eq_R0 : (An:nat->R;N:nat) ((n:nat)(le n N)->``(An n)==0``) -> (sum_f_R0 An N)==R0. -Intros; Induction N. -Simpl; Apply H; Apply le_n. -Rewrite tech5; Rewrite HrecN; [Rewrite Rplus_Ol; Apply H; Apply le_n | Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn]]. +Lemma sum_eq_R0 : + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0. +intros; induction N as [| N HrecN]. +simpl in |- *; apply H; apply le_n. +rewrite tech5; rewrite HrecN; + [ rewrite Rplus_0_l; apply H; apply le_n + | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ]. Qed. -Definition SP [fn:nat->R->R;N:nat] : R->R := [x:R](sum_f_R0 [k:nat]``(fn k x)`` N). +Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R := + sum_f_R0 (fun k:nat => fn k x) N. (**********) -Lemma sum_incr : (An:nat->R;N:nat;l:R) (Un_cv [n:nat](sum_f_R0 An n) l) -> ((n:nat)``0<=(An n)``) -> ``(sum_f_R0 An N)<=l``. -Intros; Case (total_order_T (sum_f_R0 An N) l); Intro. -Elim s; Intro. -Left; Apply a. -Right; Apply b. -Cut (Un_growing [n:nat](sum_f_R0 An n)). -Intro; Pose l1 := (sum_f_R0 An N). -Fold l1 in r. -Unfold Un_cv in H; Cut ``0<l1-l``. -Intro; Elim (H ? H2); Intros. -Pose N0 := (max x N); Cut (ge N0 x). -Intro; Assert H5 := (H3 N0 H4). -Cut ``l1<=(sum_f_R0 An N0)``. -Intro; Unfold R_dist in H5; Rewrite Rabsolu_right in H5. -Cut ``(sum_f_R0 An N0)<l1``. -Intro; Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H7 H6)). -Apply Rlt_anti_compatibility with ``-l``. -Do 2 Rewrite (Rplus_sym ``-l``). -Apply H5. -Apply Rle_sym1; Apply Rle_anti_compatibility with l. -Rewrite Rplus_Or; Replace ``l+((sum_f_R0 An N0)-l)`` with (sum_f_R0 An N0); [Idtac | Ring]; Apply Rle_trans with l1. -Left; Apply r. -Apply H6. -Unfold l1; Apply Rle_sym2; Apply (growing_prop [k:nat](sum_f_R0 An k)). -Apply H1. -Unfold ge N0; Apply le_max_r. -Unfold ge N0; Apply le_max_l. -Apply Rlt_anti_compatibility with l; Rewrite Rplus_Or; Replace ``l+(l1-l)`` with l1; [Apply r | Ring]. -Unfold Un_growing; Intro; Simpl; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Apply H0. +Lemma sum_incr : + forall (An:nat -> R) (N:nat) (l:R), + Un_cv (fun n:nat => sum_f_R0 An n) l -> + (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l. +intros; case (total_order_T (sum_f_R0 An N) l); intro. +elim s; intro. +left; apply a. +right; apply b. +cut (Un_growing (fun n:nat => sum_f_R0 An n)). +intro; pose (l1 := sum_f_R0 An N). +fold l1 in r. +unfold Un_cv in H; cut (0 < l1 - l). +intro; elim (H _ H2); intros. +pose (N0 := max x N); cut (N0 >= x)%nat. +intro; assert (H5 := H3 N0 H4). +cut (l1 <= sum_f_R0 An N0). +intro; unfold R_dist in H5; rewrite Rabs_right in H5. +cut (sum_f_R0 An N0 < l1). +intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)). +apply Rplus_lt_reg_r with (- l). +do 2 rewrite (Rplus_comm (- l)). +apply H5. +apply Rle_ge; apply Rplus_le_reg_l with l. +rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0); + [ idtac | ring ]; apply Rle_trans with l1. +left; apply r. +apply H6. +unfold l1 in |- *; apply Rge_le; + apply (growing_prop (fun k:nat => sum_f_R0 An k)). +apply H1. +unfold ge, N0 in |- *; apply le_max_r. +unfold ge, N0 in |- *; apply le_max_l. +apply Rplus_lt_reg_r with l; rewrite Rplus_0_r; + replace (l + (l1 - l)) with l1; [ apply r | ring ]. +unfold Un_growing in |- *; intro; simpl in |- *; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; apply H0. Qed. (**********) -Lemma sum_cv_maj : (An:nat->R;fn:nat->R->R;x,l1,l2:R) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu l1)<=l2``. -Intros; Case (total_order_T (Rabsolu l1) l2); Intro. -Elim s; Intro. -Left; Apply a. -Right; Apply b. -Cut (n0:nat)``(Rabsolu (SP fn n0 x))<=(sum_f_R0 An n0)``. -Intro; Cut ``0<((Rabsolu l1)-l2)/2``. -Intro; Unfold Un_cv in H H0. -Elim (H ? H3); Intros Na H4. -Elim (H0 ? H3); Intros Nb H5. -Pose N := (max Na Nb). -Unfold R_dist in H4 H5. -Cut ``(Rabsolu ((sum_f_R0 An N)-l2))<((Rabsolu l1)-l2)/2``. -Intro; Cut ``(Rabsolu ((Rabsolu l1)-(Rabsolu (SP fn N x))))<((Rabsolu l1)-l2)/2``. -Intro; Cut ``(sum_f_R0 An N)<((Rabsolu l1)+l2)/2``. -Intro; Cut ``((Rabsolu l1)+l2)/2<(Rabsolu (SP fn N x))``. -Intro; Cut ``(sum_f_R0 An N)<(Rabsolu (SP fn N x))``. -Intro; Assert H11 := (H2 N). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H10)). -Apply Rlt_trans with ``((Rabsolu l1)+l2)/2``; Assumption. -Case (case_Rabsolu ``(Rabsolu l1)-(Rabsolu (SP fn N x))``); Intro. -Apply Rlt_trans with (Rabsolu l1). -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite double; Apply Rlt_compatibility; Apply r. -DiscrR. -Apply (Rminus_lt ? ? r0). -Rewrite (Rabsolu_right ? r0) in H7. -Apply Rlt_anti_compatibility with ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))``. -Replace ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))+((Rabsolu l1)+l2)/2`` with ``(Rabsolu l1)-(Rabsolu (SP fn N x))``. -Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H7. -Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``/2``); Pattern 1 (Rabsolu l1); Rewrite double_var; Unfold Rdiv; Ring. -Case (case_Rabsolu ``(sum_f_R0 An N)-l2``); Intro. -Apply Rlt_trans with l2. -Apply (Rminus_lt ? ? r0). -Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite (double l2); Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite (Rplus_sym (Rabsolu l1)); Apply Rlt_compatibility; Apply r. -DiscrR. -Rewrite (Rabsolu_right ? r0) in H6; Apply Rlt_anti_compatibility with ``-l2``. -Replace ``-l2+((Rabsolu l1)+l2)/2`` with ``((Rabsolu l1)-l2)/2``. -Rewrite Rplus_sym; Apply H6. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Rewrite Rmult_Rplus_distrl; Pattern 2 l2; Rewrite double_var; Repeat Rewrite (Rmult_sym ``/2``); Rewrite Ropp_distr1; Unfold Rdiv; Ring. -Apply Rle_lt_trans with ``(Rabsolu ((SP fn N x)-l1))``. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply Rabsolu_triang_inv2. -Apply H4; Unfold ge N; Apply le_max_l. -Apply H5; Unfold ge N; Apply le_max_r. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rlt_anti_compatibility with l2. -Rewrite Rplus_Or; Replace ``l2+((Rabsolu l1)-l2)`` with (Rabsolu l1); [Apply r | Ring]. -Apply Rlt_Rinv; Sup0. -Intros; Induction n0. -Unfold SP; Simpl; Apply H1. -Unfold SP; Simpl. -Apply Rle_trans with (Rplus (Rabsolu (sum_f_R0 [k:nat](fn k x) n0)) (Rabsolu (fn (S n0) x))). -Apply Rabsolu_triang. -Apply Rle_trans with ``(sum_f_R0 An n0)+(Rabsolu (fn (S n0) x))``. -Do 2 Rewrite <- (Rplus_sym (Rabsolu (fn (S n0) x))). -Apply Rle_compatibility; Apply Hrecn0. -Apply Rle_compatibility; Apply H1. -Qed. +Lemma sum_cv_maj : + forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R), + Un_cv (fun n:nat => SP fn n x) l1 -> + Un_cv (fun n:nat => sum_f_R0 An n) l2 -> + (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2. +intros; case (total_order_T (Rabs l1) l2); intro. +elim s; intro. +left; apply a. +right; apply b. +cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0). +intro; cut (0 < (Rabs l1 - l2) / 2). +intro; unfold Un_cv in H, H0. +elim (H _ H3); intros Na H4. +elim (H0 _ H3); intros Nb H5. +pose (N := max Na Nb). +unfold R_dist in H4, H5. +cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2). +intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2). +intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2). +intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)). +intro; cut (sum_f_R0 An N < Rabs (SP fn N x)). +intro; assert (H11 := H2 N). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)). +apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption. +case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro. +apply Rlt_trans with (Rabs l1). +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r. +discrR. +apply (Rminus_lt _ _ r0). +rewrite (Rabs_right _ r0) in H7. +apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)). +replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with + (Rabs l1 - Rabs (SP fn N x)). +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; apply H7. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; + repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; ring. +case (Rcase_abs (sum_f_R0 An N - l2)); intro. +apply Rlt_trans with l2. +apply (Rminus_lt _ _ r0). +apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l; + apply r. +discrR. +rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2). +replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2). +rewrite Rplus_comm; apply H6. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r; + pattern l2 at 2 in |- *; rewrite double_var; + repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr; + unfold Rdiv in |- *; ring. +apply Rle_lt_trans with (Rabs (SP fn N x - l1)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2. +apply H4; unfold ge, N in |- *; apply le_max_l. +apply H5; unfold ge, N in |- *; apply le_max_r. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with l2. +rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1); + [ apply r | ring ]. +apply Rinv_0_lt_compat; prove_sup0. +intros; induction n0 as [| n0 Hrecn0]. +unfold SP in |- *; simpl in |- *; apply H1. +unfold SP in |- *; simpl in |- *. +apply Rle_trans with + (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)). +apply Rabs_triang. +apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)). +do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))). +apply Rplus_le_compat_l; apply Hrecn0. +apply Rplus_le_compat_l; apply H1. +Qed.
\ No newline at end of file diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index 12644ae37..5534cde45 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -14,83 +14,84 @@ Require Export Raxioms. Require Export ZArithRing. -Require Omega. +Require Import Omega. Require Export Field. Open Local Scope Z_scope. Open Local Scope R_scope. -Implicit Variable Type r:R. +Implicit Type r : R. (***************************************************************************) (** Instantiating Ring tactic on reals *) (***************************************************************************) -Lemma RTheory : (Ring_Theory Rplus Rmult R1 R0 Ropp [x,y:R]false). - Split. - Exact Rplus_sym. - Symmetry; Apply Rplus_assoc. - Exact Rmult_sym. - Symmetry; Apply Rmult_assoc. - Intro; Apply Rplus_Ol. - Intro; Apply Rmult_1l. - Exact Rplus_Ropp_r. - Intros. - Rewrite Rmult_sym. - Rewrite (Rmult_sym n p). - Rewrite (Rmult_sym m p). - Apply Rmult_Rplus_distr. - Intros; Contradiction. +Lemma RTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false). + split. + exact Rplus_comm. + symmetry in |- *; apply Rplus_assoc. + exact Rmult_comm. + symmetry in |- *; apply Rmult_assoc. + intro; apply Rplus_0_l. + intro; apply Rmult_1_l. + exact Rplus_opp_r. + intros. + rewrite Rmult_comm. + rewrite (Rmult_comm n p). + rewrite (Rmult_comm m p). + apply Rmult_plus_distr_l. + intros; contradiction. Defined. -Add Field R Rplus Rmult R1 R0 Ropp [x,y:R]false Rinv RTheory Rinv_l - with minus:=Rminus div:=Rdiv. +Add Field R Rplus Rmult 1 0 Ropp (fun x y:R => false) Rinv RTheory Rinv_l + with minus := Rminus div := Rdiv. (**************************************************************************) (** Relation between orders and equality *) (**************************************************************************) (**********) -Lemma Rlt_antirefl:(r:R)~``r<r``. - Generalize Rlt_antisym. Intuition EAuto. +Lemma Rlt_irrefl : forall r, ~ r < r. + generalize Rlt_asym. intuition eauto. Qed. -Hints Resolve Rlt_antirefl : real. +Hint Resolve Rlt_irrefl: real. -Lemma Rle_refl : (x:R) ``x<=x``. -Intro; Right; Reflexivity. +Lemma Rle_refl : forall r, r <= r. +intro; right; reflexivity. Qed. -Lemma Rlt_not_eq:(r1,r2:R)``r1<r2``->``r1<>r2``. - Red; Intros r1 r2 H H0; Apply (Rlt_antirefl r1). - Pattern 2 r1; Rewrite H0; Trivial. +Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2. + red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1). + pattern r1 at 2 in |- *; rewrite H0; trivial. Qed. -Lemma Rgt_not_eq:(r1,r2:R)``r1>r2``->``r1<>r2``. -Intros; Apply sym_not_eqT; Apply Rlt_not_eq; Auto with real. +Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2. +intros; apply sym_not_eq; apply Rlt_not_eq; auto with real. Qed. (**********) -Lemma imp_not_Req:(r1,r2:R)(``r1<r2``\/ ``r1>r2``) -> ``r1<>r2``. -Generalize Rlt_not_eq Rgt_not_eq. Intuition EAuto. +Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2. +generalize Rlt_not_eq Rgt_not_eq. intuition eauto. Qed. -Hints Resolve imp_not_Req : real. +Hint Resolve Rlt_dichotomy_converse: real. (** Reasoning by case on equalities and order *) (**********) -Lemma Req_EM:(r1,r2:R)(r1==r2)\/``r1<>r2``. -Intros ; Generalize (total_order_T r1 r2) imp_not_Req ; Intuition EAuto 3. +Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2. +intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse; + intuition eauto 3. Qed. -Hints Resolve Req_EM : real. +Hint Resolve Req_dec: real. (**********) -Lemma total_order:(r1,r2:R)``r1<r2``\/(r1==r2)\/``r1>r2``. -Intros;Generalize (total_order_T r1 r2);Tauto. +Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2. +intros; generalize (total_order_T r1 r2); tauto. Qed. (**********) -Lemma not_Req:(r1,r2:R)``r1<>r2``->(``r1<r2``\/``r1>r2``). -Intros; Generalize (total_order_T r1 r2) ; Tauto. +Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2. +intros; generalize (total_order_T r1 r2); tauto. Qed. @@ -99,152 +100,154 @@ Qed. (*********************************************************************************) (**********) -Lemma Rlt_le:(r1,r2:R)``r1<r2``-> ``r1<=r2``. -Intros ; Red ; Tauto. +Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2. +intros; red in |- *; tauto. Qed. -Hints Resolve Rlt_le : real. +Hint Resolve Rlt_le: real. (**********) -Lemma Rle_ge : (r1,r2:R)``r1<=r2`` -> ``r2>=r1``. -NewDestruct 1; Red; Auto with real. +Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1. +destruct 1; red in |- *; auto with real. Qed. -Hints Immediate Rle_ge : real. +Hint Immediate Rle_ge: real. (**********) -Lemma Rge_le : (r1,r2:R)``r1>=r2`` -> ``r2<=r1``. -NewDestruct 1; Red; Auto with real. +Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1. +destruct 1; red in |- *; auto with real. Qed. -Hints Resolve Rge_le : real. +Hint Resolve Rge_le: real. (**********) -Lemma not_Rle:(r1,r2:R)~``r1<=r2`` -> ``r2<r1``. -Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rle; Tauto. +Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1. +intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto. Qed. -Hints Immediate not_Rle : real. +Hint Immediate Rnot_le_lt: real. -Lemma not_Rge:(r1,r2:R)~``r1>=r2`` -> ``r1<r2``. -Intros; Apply not_Rle; Auto with real. +Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2. +intros; apply Rnot_le_lt; auto with real. Qed. (**********) -Lemma Rlt_le_not:(r1,r2:R)``r2<r1`` -> ~``r1<=r2``. -Generalize Rlt_antisym imp_not_Req ; Unfold Rle. -Intuition EAuto 3. +Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2. +generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *. +intuition eauto 3. Qed. -Lemma Rle_not:(r1,r2:R)``r1>r2`` -> ~``r1<=r2``. -Proof Rlt_le_not. +Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2. +Proof Rlt_not_le. -Hints Immediate Rlt_le_not : real. +Hint Immediate Rlt_not_le: real. -Lemma Rle_not_lt: (r1, r2:R) ``r2 <= r1`` -> ~``r1<r2``. -Intros r1 r2. Generalize (Rlt_antisym r1 r2) (imp_not_Req r1 r2). -Unfold Rle; Intuition. +Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2. +intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2). +unfold Rle in |- *; intuition. Qed. (**********) -Lemma Rlt_ge_not:(r1,r2:R)``r1<r2`` -> ~``r1>=r2``. -Generalize Rlt_le_not. Unfold Rle Rge. Intuition EAuto 3. +Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2. +generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3. Qed. -Hints Immediate Rlt_ge_not : real. +Hint Immediate Rlt_not_ge: real. (**********) -Lemma eq_Rle:(r1,r2:R)r1==r2->``r1<=r2``. -Unfold Rle; Tauto. +Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2. +unfold Rle in |- *; tauto. Qed. -Hints Immediate eq_Rle : real. +Hint Immediate Req_le: real. -Lemma eq_Rge:(r1,r2:R)r1==r2->``r1>=r2``. -Unfold Rge; Tauto. +Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2. +unfold Rge in |- *; tauto. Qed. -Hints Immediate eq_Rge : real. +Hint Immediate Req_ge: real. -Lemma eq_Rle_sym:(r1,r2:R)r2==r1->``r1<=r2``. -Unfold Rle; Auto. +Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2. +unfold Rle in |- *; auto. Qed. -Hints Immediate eq_Rle_sym : real. +Hint Immediate Req_le_sym: real. -Lemma eq_Rge_sym:(r1,r2:R)r2==r1->``r1>=r2``. -Unfold Rge; Auto. +Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2. +unfold Rge in |- *; auto. Qed. -Hints Immediate eq_Rge_sym : real. +Hint Immediate Req_ge_sym: real. -Lemma Rle_antisym : (r1,r2:R)``r1<=r2`` -> ``r2<=r1``-> r1==r2. -Intros r1 r2; Generalize (Rlt_antisym r1 r2) ; Unfold Rle ; Intuition. +Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2. +intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition. Qed. -Hints Resolve Rle_antisym : real. +Hint Resolve Rle_antisym: real. (**********) -Lemma Rle_le_eq:(r1,r2:R)(``r1<=r2``/\``r2<=r1``)<->(r1==r2). -Intuition. +Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2. +intuition. Qed. -Lemma Rlt_rew : (x,x',y,y':R)``x==x'``->``x'<y'`` -> `` y' == y`` -> ``x < y``. -Intros x x' y y'; Intros; Replace x with x'; Replace y with y'; Assumption. +Lemma Rlt_eq_compat : + forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3. +intros x x' y y'; intros; replace x with x'; replace y with y'; assumption. Qed. (**********) -Lemma Rle_trans:(r1,r2,r3:R) ``r1<=r2``->``r2<=r3``->``r1<=r3``. -Generalize trans_eqT Rlt_trans Rlt_rew. -Unfold Rle. -Intuition EAuto 2. +Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3. +generalize trans_eq Rlt_trans Rlt_eq_compat. +unfold Rle in |- *. +intuition eauto 2. Qed. (**********) -Lemma Rle_lt_trans:(r1,r2,r3:R)``r1<=r2``->``r2<r3``->``r1<r3``. -Generalize Rlt_trans Rlt_rew. -Unfold Rle. -Intuition EAuto 2. +Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3. +generalize Rlt_trans Rlt_eq_compat. +unfold Rle in |- *. +intuition eauto 2. Qed. (**********) -Lemma Rlt_le_trans:(r1,r2,r3:R)``r1<r2``->``r2<=r3``->``r1<r3``. -Generalize Rlt_trans Rlt_rew; Unfold Rle; Intuition EAuto 2. +Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3. +generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2. Qed. (** Decidability of the order *) -Lemma total_order_Rlt:(r1,r2:R)(sumboolT ``r1<r2`` ~(``r1<r2``)). -Intros;Generalize (total_order_T r1 r2) (imp_not_Req r1 r2) ; Intuition. +Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}. +intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2); + intuition. Qed. (**********) -Lemma total_order_Rle:(r1,r2:R)(sumboolT ``r1<=r2`` ~(``r1<=r2``)). -Intros r1 r2. -Generalize (total_order_T r1 r2) (imp_not_Req r1 r2). -Intuition EAuto 4 with real. +Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}. +intros r1 r2. +generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2). +intuition eauto 4 with real. Qed. (**********) -Lemma total_order_Rgt:(r1,r2:R)(sumboolT ``r1>r2`` ~(``r1>r2``)). -Intros;Unfold Rgt;Intros;Apply total_order_Rlt. +Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}. +intros; unfold Rgt in |- *; intros; apply Rlt_dec. Qed. (**********) -Lemma total_order_Rge:(r1,r2:R)(sumboolT (``r1>=r2``) ~(``r1>=r2``)). -Intros;Generalize (total_order_Rle r2 r1);Intuition. +Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}. +intros; generalize (Rle_dec r2 r1); intuition. Qed. -Lemma total_order_Rlt_Rle:(r1,r2:R)(sumboolT ``r1<r2`` ``r2<=r1``). -Intros;Generalize (total_order_T r1 r2); Intuition. +Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}. +intros; generalize (total_order_T r1 r2); intuition. Qed. -Lemma Rle_or_lt: (n, m:R)(Rle n m) \/ (Rlt m n). -Intros n m; Elim (total_order_Rlt_Rle m n);Auto with real. +Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1. +intros n m; elim (Rlt_le_dec m n); auto with real. Qed. -Lemma total_order_Rle_Rlt_eq :(r1,r2:R)``r1<=r2``-> - (sumboolT ``r1<r2`` ``r1==r2``). -Intros r1 r2 H;Generalize (total_order_T r1 r2); Intuition. +Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}. +intros r1 r2 H; generalize (total_order_T r1 r2); intuition. Qed. (**********) -Lemma inser_trans_R:(n,m,p,q:R)``n<=m<p``-> (sumboolT ``n<=m<q`` ``q<=m<p``). -Intros n m p q; Intros; Generalize (total_order_Rlt_Rle m q); Intuition. +Lemma inser_trans_R : + forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}. +intros n m p q; intros; generalize (Rlt_le_dec m q); intuition. Qed. (****************************************************************) @@ -255,53 +258,51 @@ Qed. (** Addition *) (*********************************************************) -Lemma Rplus_ne:(r:R)``r+0==r``/\``0+r==r``. -Intro;Split;Ring. +Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r. +intro; split; ring. Qed. -Hints Resolve Rplus_ne : real v62. +Hint Resolve Rplus_ne: real v62. -Lemma Rplus_Or:(r:R)``r+0==r``. -Intro; Ring. +Lemma Rplus_0_r : forall r, r + 0 = r. +intro; ring. Qed. -Hints Resolve Rplus_Or : real. +Hint Resolve Rplus_0_r: real. (**********) -Lemma Rplus_Ropp_l:(r:R)``(-r)+r==0``. - Intro; Ring. +Lemma Rplus_opp_l : forall r, - r + r = 0. + intro; ring. Qed. -Hints Resolve Rplus_Ropp_l : real. +Hint Resolve Rplus_opp_l: real. (**********) -Lemma Rplus_Ropp:(x,y:R)``x+y==0``->``y== -x``. - Intros x y H; Replace y with ``(-x+x)+y``; - [ Rewrite -> Rplus_assoc; Rewrite -> H; Ring - | Ring ]. +Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1. + intros x y H; replace y with (- x + x + y); + [ rewrite Rplus_assoc; rewrite H; ring | ring ]. Qed. (*i New i*) -Hint eqT_R_congr : real := Resolve (congr_eqT R). +Hint Resolve (f_equal (A:=R)): real. -Lemma Rplus_plus_r:(r,r1,r2:R)(r1==r2)->``r+r1==r+r2``. - Auto with real. +Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2. + auto with real. Qed. -(*i Old i*)Hints Resolve Rplus_plus_r : v62. +(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62. (**********) -Lemma r_Rplus_plus:(r,r1,r2:R)``r+r1==r+r2``->r1==r2. - Intros; Transitivity ``(-r+r)+r1``. - Ring. - Transitivity ``(-r+r)+r2``. - Repeat Rewrite -> Rplus_assoc; Rewrite <- H; Reflexivity. - Ring. +Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2. + intros; transitivity (- r + r + r1). + ring. + transitivity (- r + r + r2). + repeat rewrite Rplus_assoc; rewrite <- H; reflexivity. + ring. Qed. -Hints Resolve r_Rplus_plus : real. +Hint Resolve Rplus_eq_reg_l: real. (**********) -Lemma Rplus_ne_i:(r,b:R)``r+b==r`` -> ``b==0``. - Intros r b; Pattern 2 r; Replace r with ``r+0``; - EAuto with real. +Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0. + intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real. Qed. (***********************************************************) @@ -309,119 +310,119 @@ Qed. (***********************************************************) (**********) -Lemma Rinv_r:(r:R)``r<>0``->``r* (/r)==1``. - Intros; Rewrite -> Rmult_sym; Auto with real. +Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1. + intros; rewrite Rmult_comm; auto with real. Qed. -Hints Resolve Rinv_r : real. +Hint Resolve Rinv_r: real. -Lemma Rinv_l_sym:(r:R)``r<>0``->``1==(/r) * r``. - Symmetry; Auto with real. +Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r. + symmetry in |- *; auto with real. Qed. -Lemma Rinv_r_sym:(r:R)``r<>0``->``1==r* (/r)``. - Symmetry; Auto with real. +Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r. + symmetry in |- *; auto with real. Qed. -Hints Resolve Rinv_l_sym Rinv_r_sym : real. +Hint Resolve Rinv_l_sym Rinv_r_sym: real. (**********) -Lemma Rmult_Or :(r:R) ``r*0==0``. -Intro; Ring. +Lemma Rmult_0_r : forall r, r * 0 = 0. +intro; ring. Qed. -Hints Resolve Rmult_Or : real v62. +Hint Resolve Rmult_0_r: real v62. (**********) -Lemma Rmult_Ol:(r:R) ``0*r==0``. -Intro; Ring. +Lemma Rmult_0_l : forall r, 0 * r = 0. +intro; ring. Qed. -Hints Resolve Rmult_Ol : real v62. +Hint Resolve Rmult_0_l: real v62. (**********) -Lemma Rmult_ne:(r:R)``r*1==r``/\``1*r==r``. -Intro;Split;Ring. +Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r. +intro; split; ring. Qed. -Hints Resolve Rmult_ne : real v62. +Hint Resolve Rmult_ne: real v62. (**********) -Lemma Rmult_1r:(r:R)(``r*1==r``). -Intro; Ring. +Lemma Rmult_1_r : forall r, r * 1 = r. +intro; ring. Qed. -Hints Resolve Rmult_1r : real. +Hint Resolve Rmult_1_r: real. (**********) -Lemma Rmult_mult_r:(r,r1,r2:R)r1==r2->``r*r1==r*r2``. - Auto with real. +Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2. + auto with real. Qed. -(*i OLD i*)Hints Resolve Rmult_mult_r : v62. +(*i OLD i*)Hint Resolve Rmult_eq_compat_l: v62. (**********) -Lemma r_Rmult_mult:(r,r1,r2:R)(``r*r1==r*r2``)->``r<>0``->(r1==r2). - Intros; Transitivity ``(/r * r)*r1``. - Rewrite Rinv_l; Auto with real. - Transitivity ``(/r * r)*r2``. - Repeat Rewrite Rmult_assoc; Rewrite H; Trivial. - Rewrite Rinv_l; Auto with real. +Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2. + intros; transitivity (/ r * r * r1). + rewrite Rinv_l; auto with real. + transitivity (/ r * r * r2). + repeat rewrite Rmult_assoc; rewrite H; trivial. + rewrite Rinv_l; auto with real. Qed. (**********) -Lemma without_div_Od:(r1,r2:R)``r1*r2==0`` -> ``r1==0`` \/ ``r2==0``. - Intros; Case (Req_EM r1 ``0``); [Intro Hz | Intro Hnotz]. - Auto. - Right; Apply r_Rmult_mult with r1; Trivial. - Rewrite H; Auto with real. +Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0. + intros; case (Req_dec r1 0); [ intro Hz | intro Hnotz ]. + auto. + right; apply Rmult_eq_reg_l with r1; trivial. + rewrite H; auto with real. Qed. (**********) -Lemma without_div_Oi:(r1,r2:R) ``r1==0``\/``r2==0`` -> ``r1*r2==0``. - Intros r1 r2 [H | H]; Rewrite H; Auto with real. +Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0. + intros r1 r2 [H| H]; rewrite H; auto with real. Qed. -Hints Resolve without_div_Oi : real. +Hint Resolve Rmult_eq_0_compat: real. (**********) -Lemma without_div_Oi1:(r1,r2:R) ``r1==0`` -> ``r1*r2==0``. - Auto with real. +Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0. + auto with real. Qed. (**********) -Lemma without_div_Oi2:(r1,r2:R) ``r2==0`` -> ``r1*r2==0``. - Auto with real. +Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0. + auto with real. Qed. (**********) -Lemma without_div_O_contr:(r1,r2:R)``r1*r2<>0`` -> ``r1<>0`` /\ ``r2<>0``. -Intros r1 r2 H; Split; Red; Intro; Apply H; Auto with real. +Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0. +intros r1 r2 H; split; red in |- *; intro; apply H; auto with real. Qed. (**********) -Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. -Red; Intros r1 r2 (H1,H2) H. -Case (without_div_Od r1 r2); Auto with real. +Lemma Rmult_integral_contrapositive : + forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. +red in |- *; intros r1 r2 [H1 H2] H. +case (Rmult_integral r1 r2); auto with real. Qed. -Hints Resolve mult_non_zero : real. +Hint Resolve Rmult_integral_contrapositive: real. (**********) -Lemma Rmult_Rplus_distrl: - (r1,r2,r3:R) ``(r1+r2)*r3 == (r1*r3)+(r2*r3)``. -Intros; Ring. +Lemma Rmult_plus_distr_r : + forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3. +intros; ring. Qed. (** Square function *) (***********) -Definition Rsqr:R->R:=[r:R]``r*r``. -V7only[Notation "x ²" := (Rsqr x) (at level 2,left associativity).]. +Definition Rsqr r : R := r * r. (***********) -Lemma Rsqr_O:(Rsqr ``0``)==``0``. - Unfold Rsqr; Auto with real. +Lemma Rsqr_0 : Rsqr 0 = 0. + unfold Rsqr in |- *; auto with real. Qed. (***********) -Lemma Rsqr_r_R0:(r:R)(Rsqr r)==``0``->``r==0``. -Unfold Rsqr;Intros;Elim (without_div_Od r r H);Trivial. +Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0. +unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial. Qed. (*********************************************************) @@ -429,736 +430,725 @@ Qed. (*********************************************************) (**********) -Lemma eq_Ropp:(r1,r2:R)(r1==r2)->``-r1 == -r2``. - Auto with real. +Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2. + auto with real. Qed. -Hints Resolve eq_Ropp : real. +Hint Resolve Ropp_eq_compat: real. (**********) -Lemma Ropp_O:``-0==0``. - Ring. +Lemma Ropp_0 : -0 = 0. + ring. Qed. -Hints Resolve Ropp_O : real v62. +Hint Resolve Ropp_0: real v62. (**********) -Lemma eq_RoppO:(r:R)``r==0``-> ``-r==0``. - Intros; Rewrite -> H; Auto with real. +Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0. + intros; rewrite H; auto with real. Qed. -Hints Resolve eq_RoppO : real. +Hint Resolve Ropp_eq_0_compat: real. (**********) -Lemma Ropp_Ropp:(r:R)``-(-r)==r``. - Intro; Ring. +Lemma Ropp_involutive : forall r, - - r = r. + intro; ring. Qed. -Hints Resolve Ropp_Ropp : real. +Hint Resolve Ropp_involutive: real. (*********) -Lemma Ropp_neq:(r:R)``r<>0``->``-r<>0``. -Red;Intros r H H0. -Apply H. -Transitivity ``-(-r)``; Auto with real. +Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0. +red in |- *; intros r H H0. +apply H. +transitivity (- - r); auto with real. Qed. -Hints Resolve Ropp_neq : real. +Hint Resolve Ropp_neq_0_compat: real. (**********) -Lemma Ropp_distr1:(r1,r2:R)``-(r1+r2)==(-r1 + -r2)``. - Intros; Ring. +Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2. + intros; ring. Qed. -Hints Resolve Ropp_distr1 : real. +Hint Resolve Ropp_plus_distr: real. (** Opposite and multiplication *) -Lemma Ropp_mul1:(r1,r2:R)``(-r1)*r2 == -(r1*r2)``. - Intros; Ring. +Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2). + intros; ring. Qed. -Hints Resolve Ropp_mul1 : real. +Hint Resolve Ropp_mult_distr_l_reverse: real. (**********) -Lemma Ropp_mul2:(r1,r2:R)``(-r1)*(-r2)==r1*r2``. - Intros; Ring. +Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2. + intros; ring. Qed. -Hints Resolve Ropp_mul2 : real. +Hint Resolve Rmult_opp_opp: real. -Lemma Ropp_mul3 : (r1,r2:R) ``r1*(-r2) == -(r1*r2)``. -Intros; Rewrite <- Ropp_mul1; Ring. +Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2). +intros; rewrite <- Ropp_mult_distr_l_reverse; ring. Qed. (** Substraction *) -Lemma minus_R0:(r:R)``r-0==r``. -Intro;Ring. +Lemma Rminus_0_r : forall r, r - 0 = r. +intro; ring. Qed. -Hints Resolve minus_R0 : real. +Hint Resolve Rminus_0_r: real. -Lemma Rminus_Ropp:(r:R)``0-r==-r``. -Intro;Ring. +Lemma Rminus_0_l : forall r, 0 - r = - r. +intro; ring. Qed. -Hints Resolve Rminus_Ropp : real. +Hint Resolve Rminus_0_l: real. (**********) -Lemma Ropp_distr2:(r1,r2:R)``-(r1-r2)==r2-r1``. - Intros; Ring. +Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1. + intros; ring. Qed. -Hints Resolve Ropp_distr2 : real. +Hint Resolve Ropp_minus_distr: real. -Lemma Ropp_distr3:(r1,r2:R)``-(r2-r1)==r1-r2``. -Intros; Ring. +Lemma Ropp_minus_distr' : forall r1 r2, - (r2 - r1) = r1 - r2. +intros; ring. Qed. -Hints Resolve Ropp_distr3 : real. +Hint Resolve Ropp_minus_distr': real. (**********) -Lemma eq_Rminus:(r1,r2:R)(r1==r2)->``r1-r2==0``. - Intros; Rewrite H; Ring. +Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0. + intros; rewrite H; ring. Qed. -Hints Resolve eq_Rminus : real. +Hint Resolve Rminus_diag_eq: real. (**********) -Lemma Rminus_eq:(r1,r2:R)``r1-r2==0`` -> r1==r2. - Intros r1 r2; Unfold Rminus; Rewrite -> Rplus_sym; Intro. - Rewrite <- (Ropp_Ropp r2); Apply (Rplus_Ropp (Ropp r2) r1 H). +Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2. + intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro. + rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H). Qed. -Hints Immediate Rminus_eq : real. +Hint Immediate Rminus_diag_uniq: real. -Lemma Rminus_eq_right:(r1,r2:R)``r2-r1==0`` -> r1==r2. -Intros;Generalize (Rminus_eq r2 r1 H);Clear H;Intro H;Rewrite H;Ring. +Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2. +intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H; + ring. Qed. -Hints Immediate Rminus_eq_right : real. +Hint Immediate Rminus_diag_uniq_sym: real. -Lemma Rplus_Rminus: (p,q:R)``p+(q-p)``==q. -Intros; Ring. +Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2. +intros; ring. Qed. -Hints Resolve Rplus_Rminus:real. +Hint Resolve Rplus_minus: real. (**********) -Lemma Rminus_eq_contra:(r1,r2:R)``r1<>r2``->``r1-r2<>0``. -Red; Intros r1 r2 H H0. -Apply H; Auto with real. +Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0. +red in |- *; intros r1 r2 H H0. +apply H; auto with real. Qed. -Hints Resolve Rminus_eq_contra : real. +Hint Resolve Rminus_eq_contra: real. -Lemma Rminus_not_eq:(r1,r2:R)``r1-r2<>0``->``r1<>r2``. -Red; Intros; Elim H; Apply eq_Rminus; Auto. +Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2. +red in |- *; intros; elim H; apply Rminus_diag_eq; auto. Qed. -Hints Resolve Rminus_not_eq : real. +Hint Resolve Rminus_not_eq: real. -Lemma Rminus_not_eq_right:(r1,r2:R)``r2-r1<>0`` -> ``r1<>r2``. -Red; Intros;Elim H;Rewrite H0; Ring. +Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2. +red in |- *; intros; elim H; rewrite H0; ring. Qed. -Hints Resolve Rminus_not_eq_right : real. +Hint Resolve Rminus_not_eq_right: real. -V7only [Notation not_sym := (sym_not_eq R).]. (**********) -Lemma Rminus_distr: (x,y,z:R) ``x*(y-z)==(x*y) - (x*z)``. -Intros; Ring. +Lemma Rmult_minus_distr_l : + forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3. +intros; ring. Qed. (** Inverse *) -Lemma Rinv_R1:``/1==1``. -Field;Auto with real. +Lemma Rinv_1 : / 1 = 1. +field; auto with real. Qed. -Hints Resolve Rinv_R1 : real. +Hint Resolve Rinv_1: real. (*********) -Lemma Rinv_neq_R0:(r:R)``r<>0``->``(/r)<>0``. -Red; Intros; Apply R1_neq_R0. -Replace ``1`` with ``(/r) * r``; Auto with real. +Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0. +red in |- *; intros; apply R1_neq_R0. +replace 1 with (/ r * r); auto with real. Qed. -Hints Resolve Rinv_neq_R0 : real. +Hint Resolve Rinv_neq_0_compat: real. (*********) -Lemma Rinv_Rinv:(r:R)``r<>0``->``/(/r)==r``. -Intros;Field;Auto with real. +Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r. +intros; field; auto with real. Qed. -Hints Resolve Rinv_Rinv : real. +Hint Resolve Rinv_involutive: real. (*********) -Lemma Rinv_Rmult:(r1,r2:R)``r1<>0``->``r2<>0``->``/(r1*r2)==(/r1)*(/r2)``. -Intros;Field;Auto with real. +Lemma Rinv_mult_distr : + forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2. +intros; field; auto with real. Qed. (*********) -Lemma Ropp_Rinv:(r:R)``r<>0``->``-(/r)==/(-r)``. -Intros;Field;Auto with real. +Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r. +intros; field; auto with real. Qed. -Lemma Rinv_r_simpl_r : (r1,r2:R)``r1<>0``->``r1*(/r1)*r2==r2``. -Intros; Transitivity ``1*r2``; Auto with real. -Rewrite Rinv_r; Auto with real. +Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2. +intros; transitivity (1 * r2); auto with real. +rewrite Rinv_r; auto with real. Qed. -Lemma Rinv_r_simpl_l : (r1,r2:R)``r1<>0``->``r2*r1*(/r1)==r2``. -Intros; Transitivity ``r2*1``; Auto with real. -Transitivity ``r2*(r1*/r1)``; Auto with real. +Lemma Rinv_r_simpl_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2. +intros; transitivity (r2 * 1); auto with real. +transitivity (r2 * (r1 * / r1)); auto with real. Qed. -Lemma Rinv_r_simpl_m : (r1,r2:R)``r1<>0``->``r1*r2*(/r1)==r2``. -Intros; Transitivity ``r2*1``; Auto with real. -Transitivity ``r2*(r1*/r1)``; Auto with real. -Ring. +Lemma Rinv_r_simpl_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2. +intros; transitivity (r2 * 1); auto with real. +transitivity (r2 * (r1 * / r1)); auto with real. +ring. Qed. -Hints Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m : real. +Hint Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m: real. (*********) -Lemma Rinv_Rmult_simpl:(a,b,c:R)``a<>0``->``(a*(/b))*(c*(/a))==c*(/b)``. -Intros a b c; Intros. -Transitivity ``(a*/a)*(c*(/b))``; Auto with real. -Ring. +Lemma Rinv_mult_simpl : + forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2. +intros a b c; intros. +transitivity (a * / a * (c * / b)); auto with real. +ring. Qed. (** Order and addition *) -Lemma Rlt_compatibility_r:(r,r1,r2:R)``r1<r2``->``r1+r<r2+r``. -Intros. -Rewrite (Rplus_sym r1 r); Rewrite (Rplus_sym r2 r); Auto with real. +Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r. +intros. +rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real. Qed. -Hints Resolve Rlt_compatibility_r : real. +Hint Resolve Rplus_lt_compat_r: real. (**********) -Lemma Rlt_anti_compatibility: (r,r1,r2:R)``r+r1 < r+r2`` -> ``r1<r2``. -Intros; Cut ``(-r+r)+r1 < (-r+r)+r2``. -Rewrite -> Rplus_Ropp_l. -Elim (Rplus_ne r1); Elim (Rplus_ne r2); Intros; Rewrite <- H3; - Rewrite <- H1; Auto with zarith real. -Rewrite -> Rplus_assoc; Rewrite -> Rplus_assoc; - Apply (Rlt_compatibility ``-r`` ``r+r1`` ``r+r2`` H). +Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2. +intros; cut (- r + r + r1 < - r + r + r2). +rewrite Rplus_opp_l. +elim (Rplus_ne r1); elim (Rplus_ne r2); intros; rewrite <- H3; rewrite <- H1; + auto with zarith real. +rewrite Rplus_assoc; rewrite Rplus_assoc; + apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H). Qed. (**********) -Lemma Rle_compatibility:(r,r1,r2:R)``r1<=r2`` -> ``r+r1 <= r+r2 ``. -Unfold Rle; Intros; Elim H; Intro. -Left; Apply (Rlt_compatibility r r1 r2 H0). -Right; Rewrite <- H0; Auto with zarith real. +Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2. +unfold Rle in |- *; intros; elim H; intro. +left; apply (Rplus_lt_compat_l r r1 r2 H0). +right; rewrite <- H0; auto with zarith real. Qed. (**********) -Lemma Rle_compatibility_r:(r,r1,r2:R)``r1<=r2`` -> ``r1+r<=r2+r``. -Unfold Rle; Intros; Elim H; Intro. -Left; Apply (Rlt_compatibility_r r r1 r2 H0). -Right; Rewrite <- H0; Auto with real. +Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r. +unfold Rle in |- *; intros; elim H; intro. +left; apply (Rplus_lt_compat_r r r1 r2 H0). +right; rewrite <- H0; auto with real. Qed. -Hints Resolve Rle_compatibility Rle_compatibility_r : real. +Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real. (**********) -Lemma Rle_anti_compatibility: (r,r1,r2:R)``r+r1<=r+r2`` -> ``r1<=r2``. -Unfold Rle; Intros; Elim H; Intro. -Left; Apply (Rlt_anti_compatibility r r1 r2 H0). -Right; Apply (r_Rplus_plus r r1 r2 H0). +Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2. +unfold Rle in |- *; intros; elim H; intro. +left; apply (Rplus_lt_reg_r r r1 r2 H0). +right; apply (Rplus_eq_reg_l r r1 r2 H0). Qed. (**********) -Lemma sum_inequa_Rle_lt:(a,x,b,c,y,d:R)``a<=x`` -> ``x<b`` -> - ``c<y`` -> ``y<=d`` -> ``a+c < x+y < b+d``. -Intros;Split. -Apply Rlt_le_trans with ``a+y``; Auto with real. -Apply Rlt_le_trans with ``b+y``; Auto with real. +Lemma sum_inequa_Rle_lt : + forall a x b c y d:R, + a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d. +intros; split. +apply Rlt_le_trans with (a + y); auto with real. +apply Rlt_le_trans with (b + y); auto with real. Qed. (*********) -Lemma Rplus_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<r4`` -> ``r1+r3 < r2+r4``. -Intros; Apply Rlt_trans with ``r2+r3``; Auto with real. +Lemma Rplus_lt_compat : + forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4. +intros; apply Rlt_trans with (r2 + r3); auto with real. Qed. -Lemma Rplus_le:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<=r4`` -> ``r1+r3 <= r2+r4``. -Intros; Apply Rle_trans with ``r2+r3``; Auto with real. +Lemma Rplus_le_compat : + forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. +intros; apply Rle_trans with (r2 + r3); auto with real. Qed. (*********) -Lemma Rplus_lt_le_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<=r4`` -> - ``r1+r3 < r2+r4``. -Intros; Apply Rlt_le_trans with ``r2+r3``; Auto with real. +Lemma Rplus_lt_le_compat : + forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4. +intros; apply Rlt_le_trans with (r2 + r3); auto with real. Qed. (*********) -Lemma Rplus_le_lt_lt:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<r4`` -> - ``r1+r3 < r2+r4``. -Intros; Apply Rle_lt_trans with ``r2+r3``; Auto with real. +Lemma Rplus_le_lt_compat : + forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. +intros; apply Rle_lt_trans with (r2 + r3); auto with real. Qed. -Hints Immediate Rplus_lt Rplus_le Rplus_lt_le_lt Rplus_le_lt_lt : real. +Hint Immediate Rplus_lt_compat Rplus_le_compat Rplus_lt_le_compat + Rplus_le_lt_compat: real. (** Order and Opposite *) (**********) -Lemma Rgt_Ropp:(r1,r2:R) ``r1 > r2`` -> ``-r1 < -r2``. -Unfold Rgt; Intros. -Apply (Rlt_anti_compatibility ``r2+r1``). -Replace ``r2+r1+(-r1)`` with r2. -Replace ``r2+r1+(-r2)`` with r1. -Trivial. -Ring. -Ring. +Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2. +unfold Rgt in |- *; intros. +apply (Rplus_lt_reg_r (r2 + r1)). +replace (r2 + r1 + - r1) with r2. +replace (r2 + r1 + - r2) with r1. +trivial. +ring. +ring. Qed. -Hints Resolve Rgt_Ropp. +Hint Resolve Ropp_gt_lt_contravar. (**********) -Lemma Rlt_Ropp:(r1,r2:R) ``r1 < r2`` -> ``-r1 > -r2``. -Unfold Rgt; Auto with real. +Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2. +unfold Rgt in |- *; auto with real. Qed. -Hints Resolve Rlt_Ropp : real. +Hint Resolve Ropp_lt_gt_contravar: real. -Lemma Ropp_Rlt: (x,y:R) ``-y < -x`` ->``x<y``. -Intros x y H'. -Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp y); Auto with real. +Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2. +intros x y H'. +rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); + auto with real. Qed. -Hints Immediate Ropp_Rlt : real. +Hint Immediate Ropp_lt_cancel: real. -Lemma Rlt_Ropp1:(r1,r2:R) ``r2 < r1`` -> ``-r1 < -r2``. -Auto with real. +Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2. +auto with real. Qed. -Hints Resolve Rlt_Ropp1 : real. +Hint Resolve Ropp_lt_contravar: real. (**********) -Lemma Rle_Ropp:(r1,r2:R) ``r1 <= r2`` -> ``-r1 >= -r2``. -Unfold Rge; Intros r1 r2 [H|H]; Auto with real. +Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2. +unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. Qed. -Hints Resolve Rle_Ropp : real. +Hint Resolve Ropp_le_ge_contravar: real. -Lemma Ropp_Rle: (x,y:R) ``-y <= -x`` ->``x <= y``. -Intros x y H. -Elim H;Auto with real. -Intro H1;Rewrite <-(Ropp_Ropp x);Rewrite <-(Ropp_Ropp y);Rewrite H1; - Auto with real. +Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2. +intros x y H. +elim H; auto with real. +intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); + rewrite H1; auto with real. Qed. -Hints Immediate Ropp_Rle : real. +Hint Immediate Ropp_le_cancel: real. -Lemma Rle_Ropp1:(r1,r2:R) ``r2 <= r1`` -> ``-r1 <= -r2``. -Intros r1 r2 H;Elim H;Auto with real. +Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2. +intros r1 r2 H; elim H; auto with real. Qed. -Hints Resolve Rle_Ropp1 : real. +Hint Resolve Ropp_le_contravar: real. (**********) -Lemma Rge_Ropp:(r1,r2:R) ``r1 >= r2`` -> ``-r1 <= -r2``. -Unfold Rge; Intros r1 r2 [H|H]; Auto with real. +Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2. +unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. Qed. -Hints Resolve Rge_Ropp : real. +Hint Resolve Ropp_ge_le_contravar: real. (**********) -Lemma Rlt_RO_Ropp:(r:R) ``0 < r`` -> ``0 > -r``. -Intros; Replace ``0`` with ``-0``; Auto with real. +Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r. +intros; replace 0 with (-0); auto with real. Qed. -Hints Resolve Rlt_RO_Ropp : real. +Hint Resolve Ropp_0_lt_gt_contravar: real. (**********) -Lemma Rgt_RO_Ropp:(r:R) ``0 > r`` -> ``0 < -r``. -Intros; Replace ``0`` with ``-0``; Auto with real. +Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r. +intros; replace 0 with (-0); auto with real. Qed. -Hints Resolve Rgt_RO_Ropp : real. +Hint Resolve Ropp_0_gt_lt_contravar: real. (**********) -Lemma Rgt_RoppO:(r:R)``r>0``->``(-r)<0``. -Intros; Rewrite <- Ropp_O; Auto with real. +Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0. +intros; rewrite <- Ropp_0; auto with real. Qed. (**********) -Lemma Rlt_RoppO:(r:R)``r<0``->``-r>0``. -Intros; Rewrite <- Ropp_O; Auto with real. +Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0. +intros; rewrite <- Ropp_0; auto with real. Qed. -Hints Resolve Rgt_RoppO Rlt_RoppO: real. +Hint Resolve Ropp_lt_gt_0_contravar Ropp_gt_lt_0_contravar: real. (**********) -Lemma Rle_RO_Ropp:(r:R) ``0 <= r`` -> ``0 >= -r``. -Intros; Replace ``0`` with ``-0``; Auto with real. +Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r. +intros; replace 0 with (-0); auto with real. Qed. -Hints Resolve Rle_RO_Ropp : real. +Hint Resolve Ropp_0_le_ge_contravar: real. (**********) -Lemma Rge_RO_Ropp:(r:R) ``0 >= r`` -> ``0 <= -r``. -Intros; Replace ``0`` with ``-0``; Auto with real. +Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r. +intros; replace 0 with (-0); auto with real. Qed. -Hints Resolve Rge_RO_Ropp : real. +Hint Resolve Ropp_0_ge_le_contravar: real. (** Order and multiplication *) -Lemma Rlt_monotony_r:(r,r1,r2:R)``0<r`` -> ``r1 < r2`` -> ``r1*r < r2*r``. -Intros; Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real. +Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r. +intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real. Qed. -Hints Resolve Rlt_monotony_r. +Hint Resolve Rmult_lt_compat_r. -Lemma Rlt_monotony_contra: (z, x, y:R) ``0<z`` ->``z*x<z*y`` ->``x<y``. -Intros z x y H H0. -Case (total_order x y); Intros Eq0; Auto; Elim Eq0; Clear Eq0; Intros Eq0. - Rewrite Eq0 in H0;ElimType False;Apply (Rlt_antirefl ``z*y``);Auto. -Generalize (Rlt_monotony z y x H Eq0);Intro;ElimType False; - Generalize (Rlt_trans ``z*x`` ``z*y`` ``z*x`` H0 H1);Intro; - Apply (Rlt_antirefl ``z*x``);Auto. +Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2. +intros z x y H H0. +case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0. + rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto. +generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False; + generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); + intro; apply (Rlt_irrefl (z * x)); auto. Qed. -V7only [ -Notation Rlt_monotony_rev := Rlt_monotony_contra. -]. -Lemma Rlt_anti_monotony:(r,r1,r2:R)``r < 0`` -> ``r1 < r2`` -> ``r*r1 > r*r2``. -Intros; Replace r with ``-(-r)``; Auto with real. -Rewrite (Ropp_mul1 ``-r``); Rewrite (Ropp_mul1 ``-r``). -Apply Rlt_Ropp; Auto with real. +Lemma Rmult_lt_gt_compat_neg_l : + forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2. +intros; replace r with (- - r); auto with real. +rewrite (Ropp_mult_distr_l_reverse (- r)); + rewrite (Ropp_mult_distr_l_reverse (- r)). +apply Ropp_lt_gt_contravar; auto with real. Qed. (**********) -Lemma Rle_monotony: - (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r*r1 <= r*r2``. -Intros r r1 r2 H H0; NewDestruct H; NewDestruct H0; Unfold Rle; Auto with real. -Right; Rewrite <- H; Do 2 Rewrite Rmult_Ol; Reflexivity. +Lemma Rmult_le_compat_l : + forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. +intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *; + auto with real. +right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity. Qed. -Hints Resolve Rle_monotony : real. +Hint Resolve Rmult_le_compat_l: real. -Lemma Rle_monotony_r: - (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r1*r <= r2*r``. -Intros r r1 r2 H; -Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real. +Lemma Rmult_le_compat_r : + forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. +intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); + auto with real. Qed. -Hints Resolve Rle_monotony_r : real. +Hint Resolve Rmult_le_compat_r: real. -Lemma Rle_monotony_contra: - (z, x, y:R) ``0<z`` ->``z*x<=z*y`` ->``x<=y``. -Intros z x y H H0;Case H0; Auto with real. -Intros H1; Apply Rlt_le. -Apply Rlt_monotony_contra with z := z;Auto. -Intros H1;Replace x with (Rmult (Rinv z) (Rmult z x)); Auto with real. -Replace y with (Rmult (Rinv z) (Rmult z y)). - Rewrite H1;Auto with real. -Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real. -Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real. +Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2. +intros z x y H H0; case H0; auto with real. +intros H1; apply Rlt_le. +apply Rmult_lt_reg_l with (r := z); auto. +intros H1; replace x with (/ z * (z * x)); auto with real. +replace y with (/ z * (z * y)). + rewrite H1; auto with real. +rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. +rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. Qed. -Lemma Rle_anti_monotony1 - :(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r2 <= r*r1``. -Intros; Replace r with ``-(-r)``; Auto with real. -Do 2 Rewrite (Ropp_mul1 ``-r``). -Apply Rle_Ropp1; Auto with real. +Lemma Rmult_le_compat_neg_l : + forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1. +intros; replace r with (- - r); auto with real. +do 2 rewrite (Ropp_mult_distr_l_reverse (- r)). +apply Ropp_le_contravar; auto with real. Qed. -Hints Resolve Rle_anti_monotony1 : real. +Hint Resolve Rmult_le_compat_neg_l: real. -Lemma Rle_anti_monotony - :(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r1 >= r*r2``. -Intros; Apply Rle_ge; Auto with real. +Lemma Rmult_le_ge_compat_neg_l : + forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2. +intros; apply Rle_ge; auto with real. Qed. -Hints Resolve Rle_anti_monotony : real. +Hint Resolve Rmult_le_ge_compat_neg_l: real. -Lemma Rle_Rmult_comp: - (x, y, z, t:R) ``0 <= x`` -> ``0 <= z`` -> ``x <= y`` -> ``z <= t`` -> - ``x*z <= y*t``. -Intros x y z t H' H'0 H'1 H'2. -Apply Rle_trans with r2 := ``x*t``; Auto with real. -Repeat Rewrite [x:?](Rmult_sym x t). -Apply Rle_monotony; Auto. -Apply Rle_trans with z; Auto. +Lemma Rmult_le_compat : + forall r1 r2 r3 r4, + 0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4. +intros x y z t H' H'0 H'1 H'2. +apply Rle_trans with (r2 := x * t); auto with real. +repeat rewrite (fun x => Rmult_comm x t). +apply Rmult_le_compat_l; auto. +apply Rle_trans with z; auto. Qed. -Hints Resolve Rle_Rmult_comp :real. +Hint Resolve Rmult_le_compat: real. -Lemma Rmult_lt:(r1,r2,r3,r4:R)``r3>0`` -> ``r2>0`` -> - `` r1 < r2`` -> ``r3 < r4`` -> ``r1*r3 < r2*r4``. -Intros; Apply Rlt_trans with ``r2*r3``; Auto with real. +Lemma Rmult_gt_0_lt_compat : + forall r1 r2 r3 r4, + r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +intros; apply Rlt_trans with (r2 * r3); auto with real. Qed. (*********) -Lemma Rmult_lt_0 - :(r1,r2,r3,r4:R)``r3>=0``->``r2>0``->``r1<r2``->``r3<r4``->``r1*r3<r2*r4``. -Intros; Apply Rle_lt_trans with ``r2*r3``; Auto with real. +Lemma Rmult_ge_0_gt_0_lt_compat : + forall r1 r2 r3 r4, + r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +intros; apply Rle_lt_trans with (r2 * r3); auto with real. Qed. (** Order and Substractions *) -Lemma Rlt_minus:(r1,r2:R)``r1 < r2`` -> ``r1-r2 < 0``. -Intros; Apply (Rlt_anti_compatibility ``r2``). -Replace ``r2+(r1-r2)`` with r1. -Replace ``r2+0`` with r2; Auto with real. -Ring. +Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0. +intros; apply (Rplus_lt_reg_r r2). +replace (r2 + (r1 - r2)) with r1. +replace (r2 + 0) with r2; auto with real. +ring. Qed. -Hints Resolve Rlt_minus : real. +Hint Resolve Rlt_minus: real. (**********) -Lemma Rle_minus:(r1,r2:R)``r1 <= r2`` -> ``r1-r2 <= 0``. -NewDestruct 1; Unfold Rle; Auto with real. +Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0. +destruct 1; unfold Rle in |- *; auto with real. Qed. (**********) -Lemma Rminus_lt:(r1,r2:R)``r1-r2 < 0`` -> ``r1 < r2``. -Intros; Replace r1 with ``r1-r2+r2``. -Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real. -Ring. +Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2. +intros; replace r1 with (r1 - r2 + r2). +pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. +ring. Qed. (**********) -Lemma Rminus_le:(r1,r2:R)``r1-r2 <= 0`` -> ``r1 <= r2``. -Intros; Replace r1 with ``r1-r2+r2``. -Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real. -Ring. +Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2. +intros; replace r1 with (r1 - r2 + r2). +pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. +ring. Qed. (**********) -Lemma tech_Rplus:(r,s:R)``0<=r`` -> ``0<s`` -> ``r+s<>0``. -Intros; Apply sym_not_eqT; Apply Rlt_not_eq. -Rewrite Rplus_sym; Replace ``0`` with ``0+0``; Auto with real. +Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0. +intros; apply sym_not_eq; apply Rlt_not_eq. +rewrite Rplus_comm; replace 0 with (0 + 0); auto with real. Qed. -Hints Immediate tech_Rplus : real. +Hint Immediate tech_Rplus: real. (** Order and the square function *) -Lemma pos_Rsqr:(r:R)``0<=(Rsqr r)``. -Intro; Case (total_order_Rlt_Rle 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. +Lemma Rle_0_sqr : forall r, 0 <= Rsqr r. +intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro. +replace (r * r) with (- r * - r); auto with real. +replace 0 with (- r * 0); auto with real. +replace 0 with (0 * r); auto with real. Qed. (***********) -Lemma pos_Rsqr1:(r:R)``r<>0``->``0<(Rsqr r)``. -Intros; Case (not_Req 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. +Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r. +intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro. +replace (r * r) with (- r * - r); auto with real. +replace 0 with (- r * 0); auto with real. +replace 0 with (0 * r); auto with real. Qed. -Hints Resolve pos_Rsqr pos_Rsqr1 : real. +Hint Resolve Rle_0_sqr Rlt_0_sqr: real. (** Zero is less than one *) -Lemma Rlt_R0_R1:``0<1``. -Replace ``1`` with ``(Rsqr 1)``; Auto with real. -Unfold Rsqr; Auto with real. +Lemma Rlt_0_1 : 0 < 1. +replace 1 with (Rsqr 1); auto with real. +unfold Rsqr in |- *; auto with real. Qed. -Hints Resolve Rlt_R0_R1 : real. +Hint Resolve Rlt_0_1: real. -Lemma Rle_R0_R1:``0<=1``. -Left. -Exact Rlt_R0_R1. +Lemma Rle_0_1 : 0 <= 1. +left. +exact Rlt_0_1. Qed. (** Order and inverse *) -Lemma Rlt_Rinv:(r:R)``0<r``->``0</r``. -Intros; Apply not_Rle; Red; Intros. -Absurd ``1<=0``; Auto with real. -Replace ``1`` with ``r*(/r)``; Auto with real. -Replace ``0`` with ``r*0``; Auto with real. +Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r. +intros; apply Rnot_le_lt; red in |- *; intros. +absurd (1 <= 0); auto with real. +replace 1 with (r * / r); auto with real. +replace 0 with (r * 0); auto with real. Qed. -Hints Resolve Rlt_Rinv : real. +Hint Resolve Rinv_0_lt_compat: real. (*********) -Lemma Rlt_Rinv2:(r:R)``r < 0``->``/r < 0``. -Intros; Apply not_Rle; Red; Intros. -Absurd ``1<=0``; Auto with real. -Replace ``1`` with ``r*(/r)``; Auto with real. -Replace ``0`` with ``r*0``; Auto with real. +Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0. +intros; apply Rnot_le_lt; red in |- *; intros. +absurd (1 <= 0); auto with real. +replace 1 with (r * / r); auto with real. +replace 0 with (r * 0); auto with real. Qed. -Hints Resolve Rlt_Rinv2 : real. +Hint Resolve Rinv_lt_0_compat: real. (*********) -Lemma Rinv_lt:(r1,r2:R)``0 < r1*r2`` -> ``r1 < r2`` -> ``/r2 < /r1``. -Intros; Apply Rlt_monotony_rev with ``r1*r2``; Auto with real. -Case (without_div_O_contr r1 r2 ); Intros; Auto with real. -Replace ``r1*r2*/r2`` with r1. -Replace ``r1*r2*/r1`` with r2; Trivial. -Symmetry; Auto with real. -Symmetry; Auto with real. -Qed. - -Lemma Rlt_Rinv_R1: (x, y:R) ``1 <= x`` -> ``x<y`` ->``/y< /x``. -Intros x y H' H'0. -Cut (Rlt R0 x); [Intros Lt0 | Apply Rlt_le_trans with r2 := R1]; - Auto with real. -Apply Rlt_monotony_contra with z := x; Auto with real. -Rewrite (Rmult_sym x (Rinv x)); Rewrite Rinv_l; Auto with real. -Apply Rlt_monotony_contra with z := y; Auto with real. -Apply Rlt_trans with r2:=x;Auto. -Cut ``y*(x*/y)==x``. -Intro H1;Rewrite H1;Rewrite (Rmult_1r y);Auto. -Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite (Rmult_sym y (Rinv y)); - Rewrite Rinv_l; Auto with real. -Apply imp_not_Req; Right. -Red; Apply Rlt_trans with r2 := x; Auto with real. -Qed. -Hints Resolve Rlt_Rinv_R1 :real. +Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1. +intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real. +case (Rmult_neq_0_reg r1 r2); intros; auto with real. +replace (r1 * r2 * / r2) with r1. +replace (r1 * r2 * / r1) with r2; trivial. +symmetry in |- *; auto with real. +symmetry in |- *; auto with real. +Qed. + +Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1. +intros x y H' H'0. +cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ]; + auto with real. +apply Rmult_lt_reg_l with (r := x); auto with real. +rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real. +apply Rmult_lt_reg_l with (r := y); auto with real. +apply Rlt_trans with (r2 := x); auto. +cut (y * (x * / y) = x). +intro H1; rewrite H1; rewrite (Rmult_1_r y); auto. +rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y)); + rewrite Rinv_l; auto with real. +apply Rlt_dichotomy_converse; right. +red in |- *; apply Rlt_trans with (r2 := x); auto with real. +Qed. +Hint Resolve Rinv_1_lt_contravar: real. (*********************************************************) (** Greater *) (*********************************************************) (**********) -Lemma Rge_ge_eq:(r1,r2:R)``r1 >= r2`` -> ``r2 >= r1`` -> r1==r2. -Intros; Apply Rle_antisym; Auto with real. +Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2. +intros; apply Rle_antisym; auto with real. Qed. (**********) -Lemma Rlt_not_ge:(r1,r2:R)~(``r1<r2``)->``r1>=r2``. -Intros; Unfold Rge; Elim (total_order r1 r2); Intro. -Absurd ``r1<r2``; Trivial. -Case H0; Auto. +Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2. +intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro. +absurd (r1 < r2); trivial. +case H0; auto. Qed. (**********) -Lemma Rnot_lt_le:(r1,r2:R)~(``r1<r2``)->``r2<=r1``. -Intros; Apply Rge_le; Apply Rlt_not_ge; Assumption. +Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1. +intros; apply Rge_le; apply Rnot_lt_ge; assumption. Qed. (**********) -Lemma Rgt_not_le:(r1,r2:R)~(``r1>r2``)->``r1<=r2``. -Intros r1 r2 H; Apply Rge_le. -Exact (Rlt_not_ge r2 r1 H). +Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2. +intros r1 r2 H; apply Rge_le. +exact (Rnot_lt_ge r2 r1 H). Qed. (**********) -Lemma Rgt_ge:(r1,r2:R)``r1>r2`` -> ``r1 >= r2``. -Red; Auto with real. +Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2. +red in |- *; auto with real. Qed. -V7only [ -(**********) -Lemma Rlt_sym:(r1,r2:R)``r1<r2`` <-> ``r2>r1``. -Split; Unfold Rgt; Auto with real. -Qed. - -(**********) -Lemma Rle_sym1:(r1,r2:R)``r1<=r2``->``r2>=r1``. -Proof Rle_ge. - -Notation "'Rle_sym2' a b c" := (Rge_le b a c) - (at level 10, a,b,c at level 9, only parsing). -Notation Rle_sym2 := Rge_le (only parsing). -(* -(**********) -Lemma Rle_sym2:(r1,r2:R)``r2>=r1`` -> ``r1<=r2``. -Proof [r1,r2](Rge_le r2 r1). -*) - -(**********) -Lemma Rle_sym:(r1,r2:R)``r1<=r2``<->``r2>=r1``. -Split; Auto with real. -Qed. -]. (**********) -Lemma Rge_gt_trans:(r1,r2,r3:R)``r1>=r2``->``r2>r3``->``r1>r3``. -Unfold Rgt; Intros; Apply Rlt_le_trans with r2; Auto with real. +Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3. +unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real. Qed. (**********) -Lemma Rgt_ge_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>=r3`` -> ``r1>r3``. -Unfold Rgt; Intros; Apply Rle_lt_trans with r2; Auto with real. +Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3. +unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real. Qed. (**********) -Lemma Rgt_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>r3`` -> ``r1>r3``. -Unfold Rgt; Intros; Apply Rlt_trans with r2; Auto with real. +Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3. +unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real. Qed. (**********) -Lemma Rge_trans:(r1,r2,r3:R)``r1>=r2`` -> ``r2>=r3`` -> ``r1>=r3``. -Intros; Apply Rle_ge. -Apply Rle_trans with r2; Auto with real. +Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3. +intros; apply Rle_ge. +apply Rle_trans with r2; auto with real. Qed. (**********) -Lemma Rlt_r_plus_R1:(r:R)``0<=r`` -> ``0<r+1``. -Intros. -Apply Rlt_le_trans with ``1``; Auto with real. -Pattern 1 ``1``; Replace ``1`` with ``0+1``; Auto with real. +Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1. +intros. +apply Rlt_le_trans with 1; auto with real. +pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real. Qed. -Hints Resolve Rlt_r_plus_R1: real. +Hint Resolve Rle_lt_0_plus_1: real. (**********) -Lemma Rlt_r_r_plus_R1:(r:R)``r<r+1``. -Intros. -Pattern 1 r; Replace r with ``r+0``; Auto with real. +Lemma Rlt_plus_1 : forall r, r < r + 1. +intros. +pattern r at 1 in |- *; replace r with (r + 0); auto with real. Qed. -Hints Resolve Rlt_r_r_plus_R1: real. +Hint Resolve Rlt_plus_1: real. (**********) -Lemma tech_Rgt_minus:(r1,r2:R)``0<r2``->``r1>r1-r2``. -Red; Unfold Rminus; Intros. -Pattern 2 r1; Replace r1 with ``r1+0``; Auto with real. +Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2. +red in |- *; unfold Rminus in |- *; intros. +pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real. Qed. (***********) -Lemma Rgt_plus_plus_r:(r,r1,r2:R)``r1>r2``->``r+r1 > r+r2``. -Unfold Rgt; Auto with real. +Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2. +unfold Rgt in |- *; auto with real. Qed. -Hints Resolve Rgt_plus_plus_r : real. +Hint Resolve Rplus_gt_compat_l: real. (***********) -Lemma Rgt_r_plus_plus:(r,r1,r2:R)``r+r1 > r+r2`` -> ``r1 > r2``. -Unfold Rgt; Intros; Apply (Rlt_anti_compatibility r r2 r1 H). +Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2. +unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H). Qed. (***********) -Lemma Rge_plus_plus_r:(r,r1,r2:R)``r1>=r2`` -> ``r+r1 >= r+r2``. -Intros; Apply Rle_ge; Auto with real. +Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2. +intros; apply Rle_ge; auto with real. Qed. -Hints Resolve Rge_plus_plus_r : real. +Hint Resolve Rplus_ge_compat_l: real. (***********) -Lemma Rge_r_plus_plus:(r,r1,r2:R)``r+r1 >= r+r2`` -> ``r1>=r2``. -Intros; Apply Rle_ge; Apply Rle_anti_compatibility with r; Auto with real. +Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2. +intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real. Qed. (***********) -Lemma Rge_monotony: - (x,y,z:R) ``z>=0`` -> ``x>=y`` -> ``x*z >= y*z``. -Intros x y z; Intros; Apply Rle_ge; Apply Rle_monotony_r; Apply Rge_le; Assumption. +Lemma Rmult_ge_compat_r : + forall r r1 r2, r2 >= 0 -> r >= r1 -> r * r2 >= r1 * r2. +intros x y z; intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le; + assumption. Qed. (***********) -Lemma Rgt_minus:(r1,r2:R)``r1>r2`` -> ``r1-r2 > 0``. -Intros; Replace ``0`` with ``r2-r2``; Auto with real. -Unfold Rgt Rminus; Auto with real. +Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0. +intros; replace 0 with (r2 - r2); auto with real. +unfold Rgt, Rminus in |- *; auto with real. Qed. (*********) -Lemma minus_Rgt:(r1,r2:R)``r1-r2 > 0`` -> ``r1>r2``. -Intros; Replace r2 with ``r2+0``; Auto with real. -Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real. +Lemma minus_Rgt : forall r1 r2, r1 - r2 > 0 -> r1 > r2. +intros; replace r2 with (r2 + 0); auto with real. +intros; replace r1 with (r2 + (r1 - r2)); auto with real. Qed. (**********) -Lemma Rge_minus:(r1,r2:R)``r1>=r2`` -> ``r1-r2 >= 0``. -Unfold Rge; Intros; Elim H; Intro. -Left; Apply (Rgt_minus r1 r2 H0). -Right; Apply (eq_Rminus r1 r2 H0). +Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0. +unfold Rge in |- *; intros; elim H; intro. +left; apply (Rgt_minus r1 r2 H0). +right; apply (Rminus_diag_eq r1 r2 H0). Qed. (*********) -Lemma minus_Rge:(r1,r2:R)``r1-r2 >= 0`` -> ``r1>=r2``. -Intros; Replace r2 with ``r2+0``; Auto with real. -Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real. +Lemma minus_Rge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2. +intros; replace r2 with (r2 + 0); auto with real. +intros; replace r1 with (r2 + (r1 - r2)); auto with real. Qed. (*********) -Lemma Rmult_gt:(r1,r2:R)``r1>0`` -> ``r2>0`` -> ``r1*r2>0``. -Unfold Rgt;Intros. -Replace ``0`` with ``0*r2``; Auto with real. +Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0. +unfold Rgt in |- *; intros. +replace 0 with (0 * r2); auto with real. Qed. (*********) -Lemma Rmult_lt_pos:(x,y:R)``0<x`` -> ``0<y`` -> ``0<x*y``. -Proof Rmult_gt. +Lemma Rmult_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 * r2. +Proof Rmult_gt_0_compat. (***********) -Lemma Rplus_eq_R0_l:(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``. -Intros a b [H|H] H0 H1; Auto with real. -Absurd ``0<a+b``. -Rewrite H1; Auto with real. -Replace ``0`` with ``0+0``; Auto with real. +Lemma Rplus_eq_0_l : + forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0. +intros a b [H| H] H0 H1; auto with real. +absurd (0 < a + b). +rewrite H1; auto with real. +replace 0 with (0 + 0); auto with real. Qed. -Lemma Rplus_eq_R0 - :(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``/\``b==0``. -Intros a b; Split. -Apply Rplus_eq_R0_l with b; Auto with real. -Apply Rplus_eq_R0_l with a; Auto with real. -Rewrite Rplus_sym; Auto with real. +Lemma Rplus_eq_R0 : + forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0. +intros a b; split. +apply Rplus_eq_0_l with b; auto with real. +apply Rplus_eq_0_l with a; auto with real. +rewrite Rplus_comm; auto with real. Qed. (***********) -Lemma Rplus_Rsr_eq_R0_l:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``. -Intros a b; Intros; Apply Rsqr_r_R0; Apply Rplus_eq_R0_l with (Rsqr b); Auto with real. +Lemma Rplus_sqr_eq_0_l : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0. +intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b); + auto with real. Qed. -Lemma Rplus_Rsr_eq_R0:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``/\``b==0``. -Intros a b; Split. -Apply Rplus_Rsr_eq_R0_l with b; Auto with real. -Apply Rplus_Rsr_eq_R0_l with a; Auto with real. -Rewrite Rplus_sym; Auto with real. +Lemma Rplus_sqr_eq_0 : + forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0. +intros a b; split. +apply Rplus_sqr_eq_0_l with b; auto with real. +apply Rplus_sqr_eq_0_l with a; auto with real. +rewrite Rplus_comm; auto with real. Qed. @@ -1167,448 +1157,476 @@ Qed. (**********************************************************) (**********) -Lemma S_INR:(n:nat)(INR (S n))==``(INR n)+1``. -Intro; Case n; Auto with real. +Lemma S_INR : forall n:nat, INR (S n) = INR n + 1. +intro; case n; auto with real. Qed. (**********) -Lemma S_O_plus_INR:(n:nat) - (INR (plus (S O) n))==``(INR (S O))+(INR n)``. -Intro; Simpl; Case n; Intros; Auto with real. +Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n. +intro; simpl in |- *; case n; intros; auto with real. Qed. (**********) -Lemma plus_INR:(n,m:nat)(INR (plus n m))==``(INR n)+(INR m)``. -Intros n m; Induction n. -Simpl; Auto with real. -Replace (plus (S n) m) with (S (plus n m)); Auto with arith. -Repeat Rewrite S_INR. -Rewrite Hrecn; Ring. +Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. +intros n m; induction n as [| n Hrecn]. +simpl in |- *; auto with real. +replace (S n + m)%nat with (S (n + m)); auto with arith. +repeat rewrite S_INR. +rewrite Hrecn; ring. Qed. (**********) -Lemma minus_INR:(n,m:nat)(le m n)->(INR (minus n m))==``(INR n)-(INR m)``. -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. -Rewrite H0; Ring. +Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m. +intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real. +intros; rewrite <- minus_n_O; auto with real. +intros; repeat rewrite S_INR; simpl in |- *. +rewrite H0; ring. Qed. (*********) -Lemma mult_INR:(n,m:nat)(INR (mult n m))==(Rmult (INR n) (INR m)). -Intros n m; Induction n. -Simpl; Auto with real. -Intros; Repeat Rewrite S_INR; Simpl. -Rewrite plus_INR; Rewrite Hrecn; Ring. +Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m. +intros n m; induction n as [| n Hrecn]. +simpl in |- *; auto with real. +intros; repeat rewrite S_INR; simpl in |- *. +rewrite plus_INR; rewrite Hrecn; ring. Qed. -Hints Resolve plus_INR minus_INR mult_INR : real. +Hint Resolve plus_INR minus_INR mult_INR: real. (*********) -Lemma lt_INR_0:(n:nat)(lt O n)->``0 < (INR n)``. -Induction 1; Intros; Auto with real. -Rewrite S_INR; Auto with real. +Lemma lt_INR_0 : forall n:nat, (0 < n)%nat -> 0 < INR n. +simple induction 1; intros; auto with real. +rewrite S_INR; auto with real. Qed. -Hints Resolve lt_INR_0: real. +Hint Resolve lt_INR_0: real. -Lemma lt_INR:(n,m:nat)(lt n m)->``(INR n) < (INR m)``. -Induction 1; Intros; Auto with real. -Rewrite S_INR; Auto with real. -Rewrite S_INR; Apply Rlt_trans with (INR m0); Auto with real. +Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m. +simple induction 1; intros; auto with real. +rewrite S_INR; auto with real. +rewrite S_INR; apply Rlt_trans with (INR m0); auto with real. Qed. -Hints Resolve lt_INR: real. +Hint Resolve lt_INR: real. -Lemma INR_lt_1:(n:nat)(lt (S O) n)->``1 < (INR n)``. -Intros;Replace ``1`` with (INR (S O));Auto with real. +Lemma INR_lt_1 : forall n:nat, (1 < n)%nat -> 1 < INR n. +intros; replace 1 with (INR 1); auto with real. Qed. -Hints Resolve INR_lt_1: real. +Hint Resolve INR_lt_1: real. (**********) -Lemma INR_pos : (p:positive)``0<(INR (convert p))``. -Intro; Apply lt_INR_0. -Simpl; Auto with real. -Apply compare_convert_O. +Lemma INR_pos : forall p:positive, 0 < INR (nat_of_P p). +intro; apply lt_INR_0. +simpl in |- *; auto with real. +apply lt_O_nat_of_P. Qed. -Hints Resolve INR_pos : real. +Hint Resolve INR_pos: real. (**********) -Lemma pos_INR:(n:nat)``0 <= (INR n)``. -Intro n; Case n. -Simpl; Auto with real. -Auto with arith real. +Lemma pos_INR : forall n:nat, 0 <= INR n. +intro n; case n. +simpl in |- *; auto with real. +auto with arith real. Qed. -Hints Resolve pos_INR: real. +Hint Resolve pos_INR: real. -Lemma INR_lt:(n,m:nat)``(INR n) < (INR m)``->(lt n m). -Double Induction n m;Intros. -Simpl;ElimType False;Apply (Rlt_antirefl R0);Auto. -Auto with arith. -Generalize (pos_INR (S n0));Intro;Cut (INR O)==R0; - [Intro H2;Rewrite H2 in H0;Idtac|Simpl;Trivial]. -Generalize (Rle_lt_trans ``0`` (INR (S n0)) ``0`` H1 H0);Intro; - ElimType False;Apply (Rlt_antirefl R0);Auto. -Do 2 Rewrite S_INR in H1;Cut ``(INR n1) < (INR n0)``. -Intro H2;Generalize (H0 n0 H2);Intro;Auto with arith. -Apply (Rlt_anti_compatibility ``1`` (INR n1) (INR n0)). -Rewrite Rplus_sym;Rewrite (Rplus_sym ``1`` (INR n0));Trivial. +Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat. +double induction n m; intros. +simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto. +auto with arith. +generalize (pos_INR (S n0)); intro; cut (INR 0 = 0); + [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. +generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False; + apply (Rlt_irrefl 0); auto. +do 2 rewrite S_INR in H1; cut (INR n1 < INR n0). +intro H2; generalize (H0 n0 H2); intro; auto with arith. +apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)). +rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial. Qed. -Hints Resolve INR_lt: real. +Hint Resolve INR_lt: real. (*********) -Lemma le_INR:(n,m:nat)(le n m)->``(INR n)<=(INR m)``. -Induction 1; Intros; Auto with real. -Rewrite S_INR. -Apply Rle_trans with (INR m0); Auto with real. +Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m. +simple induction 1; intros; auto with real. +rewrite S_INR. +apply Rle_trans with (INR m0); auto with real. Qed. -Hints Resolve le_INR: real. +Hint Resolve le_INR: real. (**********) -Lemma not_INR_O:(n:nat)``(INR n)<>0``->~n=O. -Red; Intros n H H1. -Apply H. -Rewrite H1; Trivial. +Lemma not_INR_O : forall n:nat, INR n <> 0 -> n <> 0%nat. +red in |- *; intros n H H1. +apply H. +rewrite H1; trivial. Qed. -Hints Immediate not_INR_O : real. +Hint Immediate not_INR_O: real. (**********) -Lemma not_O_INR:(n:nat)~n=O->``(INR n)<>0``. -Intro n; Case n. -Intro; Absurd (0)=(0); Trivial. -Intros; Rewrite S_INR. -Apply Rgt_not_eq; Red; Auto with real. +Lemma not_O_INR : forall n:nat, n <> 0%nat -> INR n <> 0. +intro n; case n. +intro; absurd (0%nat = 0%nat); trivial. +intros; rewrite S_INR. +apply Rgt_not_eq; red in |- *; auto with real. Qed. -Hints Resolve not_O_INR : real. +Hint Resolve not_O_INR: real. -Lemma not_nm_INR:(n,m:nat)~n=m->``(INR n)<>(INR m)``. -Intros n m H; Case (le_or_lt n m); Intros H1. -Case (le_lt_or_eq ? ? H1); Intros H2. -Apply imp_not_Req; Auto with real. -ElimType False;Auto. -Apply sym_not_eqT; Apply imp_not_Req; Auto with real. +Lemma not_nm_INR : forall n m:nat, n <> m -> INR n <> INR m. +intros n m H; case (le_or_lt n m); intros H1. +case (le_lt_or_eq _ _ H1); intros H2. +apply Rlt_dichotomy_converse; auto with real. +elimtype False; auto. +apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real. Qed. -Hints Resolve not_nm_INR : real. +Hint Resolve not_nm_INR: real. -Lemma INR_eq: (n,m:nat)(INR n)==(INR m)->n=m. -Intros;Case (le_or_lt n m); Intros H1. -Case (le_lt_or_eq ? ? H1); Intros H2;Auto. -Cut ~n=m. -Intro H3;Generalize (not_nm_INR n m H3);Intro H4; - ElimType False;Auto. -Omega. -Symmetry;Cut ~m=n. -Intro H3;Generalize (not_nm_INR m n H3);Intro H4; - ElimType False;Auto. -Omega. +Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m. +intros; case (le_or_lt n m); intros H1. +case (le_lt_or_eq _ _ H1); intros H2; auto. +cut (n <> m). +intro H3; generalize (not_nm_INR n m H3); intro H4; elimtype False; auto. +omega. +symmetry in |- *; cut (m <> n). +intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto. +omega. Qed. -Hints Resolve INR_eq : real. +Hint Resolve INR_eq: real. -Lemma INR_le: (n, m : nat) (Rle (INR n) (INR m)) -> (le n m). -Intros;Elim H;Intro. -Generalize (INR_lt n m H0);Intro;Auto with arith. -Generalize (INR_eq n m H0);Intro;Rewrite H1;Auto. +Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat. +intros; elim H; intro. +generalize (INR_lt n m H0); intro; auto with arith. +generalize (INR_eq n m H0); intro; rewrite H1; auto. Qed. -Hints Resolve INR_le : real. +Hint Resolve INR_le: real. -Lemma not_1_INR:(n:nat)~n=(S O)->``(INR n)<>1``. -Replace ``1`` with (INR (S O)); Auto with real. +Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1. +replace 1 with (INR 1); auto with real. Qed. -Hints Resolve not_1_INR : real. +Hint Resolve not_1_INR: real. (**********************************************************) (** Injection from [Z] to [R] *) (**********************************************************) -V7only [ -(**********) -Definition Z_of_nat := inject_nat. -Notation INZ:=Z_of_nat. -]. (**********) -Lemma IZN:(z:Z)(`0<=z`)->(Ex [m:nat] z=(INZ m)). -Intros z; Unfold INZ; Apply inject_nat_complete; Assumption. +Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat | n = Z_of_nat m. +intros z; idtac; apply Z_of_nat_complete; assumption. Qed. (**********) -Lemma INR_IZR_INZ:(n:nat)(INR n)==(IZR (INZ n)). -Induction n; Auto with real. -Intros; Simpl; Rewrite bij1; Auto with real. +Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n). +simple induction n; auto with real. +intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; + auto with real. Qed. -Lemma plus_IZR_NEG_POS : - (p,q:positive)(IZR `(POS p)+(NEG q)`)==``(IZR (POS p))+(IZR (NEG q))``. -Intros. -Case (lt_eq_lt_dec (convert p) (convert q)). -Intros [H | H]; Simpl. -Rewrite convert_compare_INFERIEUR; Simpl; Trivial. -Rewrite (true_sub_convert q p). -Rewrite minus_INR; Auto with arith; Ring. -Apply ZC2; Apply convert_compare_INFERIEUR; Trivial. -Rewrite (convert_intro p q); Trivial. -Rewrite convert_compare_EGAL; Simpl; Auto with real. -Intro H; Simpl. -Rewrite convert_compare_SUPERIEUR; Simpl; Auto with arith. -Rewrite (true_sub_convert p q). -Rewrite minus_INR; Auto with arith; Ring. -Apply ZC2; Apply convert_compare_INFERIEUR; Trivial. +Lemma plus_IZR_NEG_POS : + forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q). +intros. +case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)). +intros [H| H]; simpl in |- *. +rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial. +rewrite (nat_of_P_minus_morphism q p). +rewrite minus_INR; auto with arith; ring. +apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. +rewrite (nat_of_P_inj p q); trivial. +rewrite Pcompare_refl; simpl in |- *; auto with real. +intro H; simpl in |- *. +rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *; + auto with arith. +rewrite (nat_of_P_minus_morphism p q). +rewrite minus_INR; auto with arith; ring. +apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. Qed. (**********) -Lemma plus_IZR:(z,t:Z)(IZR `z+t`)==``(IZR z)+(IZR t)``. -Intro z; NewDestruct z; Intro t; NewDestruct t; Intros; Auto with real. -Simpl; Intros; Rewrite convert_add; Auto with real. -Apply plus_IZR_NEG_POS. -Rewrite Zplus_sym; Rewrite Rplus_sym; Apply plus_IZR_NEG_POS. -Simpl; Intros; Rewrite convert_add; Rewrite plus_INR; Auto with real. +Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m. +intro z; destruct z; intro t; destruct t; intros; auto with real. +simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real. +apply plus_IZR_NEG_POS. +rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS. +simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR; + auto with real. Qed. (**********) -Lemma mult_IZR:(z,t:Z)(IZR `z*t`)==``(IZR z)*(IZR t)``. -Intros z t; Case z; Case t; Simpl; Auto with real. -Intros t1 z1; Rewrite times_convert; Auto with real. -Intros t1 z1; Rewrite times_convert; Auto with real. -Rewrite Rmult_sym. -Rewrite Ropp_mul1; Auto with real. -Apply eq_Ropp; Rewrite mult_sym; Auto with real. -Intros t1 z1; Rewrite times_convert; Auto with real. -Rewrite Ropp_mul1; Auto with real. -Intros t1 z1; Rewrite times_convert; Auto with real. -Rewrite Ropp_mul2; Auto with real. +Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m. +intros z t; case z; case t; simpl in |- *; auto with real. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +rewrite Rmult_comm. +rewrite Ropp_mult_distr_l_reverse; auto with real. +apply Ropp_eq_compat; rewrite mult_comm; auto with real. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +rewrite Ropp_mult_distr_l_reverse; auto with real. +intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. +rewrite Rmult_opp_opp; auto with real. Qed. (**********) -Lemma Ropp_Ropp_IZR:(z:Z)(IZR (`-z`))==``-(IZR z)``. -Intro z; Case z; Simpl; Auto with real. +Lemma Ropp_Ropp_IZR : forall n:Z, IZR (- n) = - IZR n. +intro z; case z; simpl in |- *; auto with real. Qed. (**********) -Lemma Z_R_minus:(z1,z2:Z)``(IZR z1)-(IZR z2)``==(IZR `z1-z2`). -Intros z1 z2; Unfold Rminus; Unfold Zminus. -Rewrite <-(Ropp_Ropp_IZR z2); Symmetry; Apply plus_IZR. +Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m). +intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *. +rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR. Qed. (**********) -Lemma lt_O_IZR:(z:Z)``0 < (IZR z)``->`0<z`. -Intro z; Case z; Simpl; Intros. -Absurd ``0<0``; Auto with real. -Unfold Zlt; Simpl; Trivial. -Case Rlt_le_not with 1:=H. -Replace ``0`` with ``-0``; Auto with real. +Lemma lt_O_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z. +intro z; case z; simpl in |- *; intros. +absurd (0 < 0); auto with real. +unfold Zlt in |- *; simpl in |- *; trivial. +case Rlt_not_le with (1 := H). +replace 0 with (-0); auto with real. Qed. (**********) -Lemma lt_IZR:(z1,z2:Z)``(IZR z1)<(IZR z2)``->`z1<z2`. -Intros z1 z2 H; Apply Zlt_O_minus_lt. -Apply lt_O_IZR. -Rewrite <- Z_R_minus. -Exact (Rgt_minus (IZR z2) (IZR z1) H). +Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z. +intros z1 z2 H; apply Zlt_O_minus_lt. +apply lt_O_IZR. +rewrite <- Z_R_minus. +exact (Rgt_minus (IZR z2) (IZR z1) H). Qed. (**********) -Lemma eq_IZR_R0:(z:Z)``(IZR z)==0``->`z=0`. -Intro z; NewDestruct z; Simpl; Intros; Auto with zarith. -Case (Rlt_not_eq ``0`` (INR (convert p))); Auto with real. -Case (Rlt_not_eq ``-(INR (convert p))`` ``0`` ); Auto with real. -Apply Rgt_RoppO. Unfold Rgt; Apply INR_pos. +Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z. +intro z; destruct z; simpl in |- *; intros; auto with zarith. +case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real. +case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real. +apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos. Qed. (**********) -Lemma eq_IZR:(z1,z2:Z)(IZR z1)==(IZR z2)->z1=z2. -Intros z1 z2 H;Generalize (eq_Rminus (IZR z1) (IZR z2) H); - Rewrite (Z_R_minus z1 z2);Intro;Generalize (eq_IZR_R0 `z1-z2` H0); - Intro;Omega. +Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m. +intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H); + rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); + intro; omega. Qed. (**********) -Lemma not_O_IZR:(z:Z)`z<>0`->``(IZR z)<>0``. -Intros z H; Red; Intros H0; Case H. -Apply eq_IZR; Auto. +Lemma not_O_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0. +intros z H; red in |- *; intros H0; case H. +apply eq_IZR; auto. Qed. (*********) -Lemma le_O_IZR:(z:Z)``0<= (IZR z)``->`0<=z`. -Unfold Rle; Intros z [H|H]. -Red;Intro;Apply (Zlt_le_weak `0` z (lt_O_IZR z H)); Assumption. -Rewrite (eq_IZR_R0 z); Auto with zarith real. +Lemma le_O_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z. +unfold Rle in |- *; intros z [H| H]. +red in |- *; intro; apply (Zlt_le_weak 0 z (lt_O_IZR z H)); assumption. +rewrite (eq_IZR_R0 z); auto with zarith real. Qed. (**********) -Lemma le_IZR:(z1,z2:Z)``(IZR z1)<=(IZR z2)``->`z1<=z2`. -Unfold Rle; Intros z1 z2 [H|H]. -Apply (Zlt_le_weak z1 z2); Auto with real. -Apply lt_IZR; Trivial. -Rewrite (eq_IZR z1 z2); Auto with zarith real. +Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z. +unfold Rle in |- *; intros z1 z2 [H| H]. +apply (Zlt_le_weak z1 z2); auto with real. +apply lt_IZR; trivial. +rewrite (eq_IZR z1 z2); auto with zarith real. Qed. (**********) -Lemma le_IZR_R1:(z:Z)``(IZR z)<=1``-> `z<=1`. -Pattern 1 ``1``; Replace ``1`` with (IZR `1`); Intros; Auto. -Apply le_IZR; Trivial. +Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z. +pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto. +apply le_IZR; trivial. Qed. (**********) -Lemma IZR_ge: (m,n:Z) `m>= n` -> ``(IZR m)>=(IZR n)``. -Intros m n H; Apply Rlt_not_ge;Red;Intro. -Generalize (lt_IZR m n H0); Intro; Omega. +Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m. +intros m n H; apply Rnot_lt_ge; red in |- *; intro. +generalize (lt_IZR m n H0); intro; omega. Qed. -Lemma IZR_le: (m,n:Z) `m<= n` -> ``(IZR m)<=(IZR n)``. -Intros m n H;Apply Rgt_not_le;Red;Intro. -Unfold Rgt in H0;Generalize (lt_IZR n m H0); Intro; Omega. +Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m. +intros m n H; apply Rnot_gt_le; red in |- *; intro. +unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega. Qed. -Lemma IZR_lt: (m,n:Z) `m< n` -> ``(IZR m)<(IZR n)``. -Intros m n H;Cut `m<=n`. -Intro H0;Elim (IZR_le m n H0);Intro;Auto. -Generalize (eq_IZR m n H1);Intro;ElimType False;Omega. -Omega. +Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m. +intros m n H; cut (m <= n)%Z. +intro H0; elim (IZR_le m n H0); intro; auto. +generalize (eq_IZR m n H1); intro; elimtype False; omega. +omega. Qed. -Lemma one_IZR_lt1 : (z:Z)``-1<(IZR z)<1``->`z=0`. -Intros z (H1,H2). -Apply Zle_antisym. -Apply Zlt_n_Sm_le; Apply lt_IZR; Trivial. -Replace `0` with (Zs `-1`); Trivial. -Apply Zlt_le_S; Apply lt_IZR; Trivial. +Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z. +intros z [H1 H2]. +apply Zle_antisym. +apply Zlt_succ_le; apply lt_IZR; trivial. +replace 0%Z with (Zsucc (-1)); trivial. +apply Zlt_le_succ; apply lt_IZR; trivial. Qed. -Lemma one_IZR_r_R1 - : (r:R)(z,x:Z)``r<(IZR z)<=r+1``->``r<(IZR x)<=r+1``->z=x. -Intros r z x (H1,H2) (H3,H4). -Cut `z-x=0`; Auto with zarith. -Apply one_IZR_lt1. -Rewrite <- Z_R_minus; Split. -Replace ``-1`` with ``r-(r+1)``. -Unfold Rminus; Apply Rplus_lt_le_lt; Auto with real. -Ring. -Replace ``1`` with ``(r+1)-r``. -Unfold Rminus; Apply Rplus_le_lt_lt; Auto with real. -Ring. +Lemma one_IZR_r_R1 : + forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m. +intros r z x [H1 H2] [H3 H4]. +cut ((z - x)%Z = 0%Z); auto with zarith. +apply one_IZR_lt1. +rewrite <- Z_R_minus; split. +replace (-1) with (r - (r + 1)). +unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real. +ring. +replace 1 with (r + 1 - r). +unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real. +ring. Qed. (**********) -Lemma single_z_r_R1: - (r:R)(z,x:Z)``r<(IZR z)``->``(IZR z)<=r+1``->``r<(IZR x)``-> - ``(IZR x)<=r+1``->z=x. -Intros; Apply one_IZR_r_R1 with r; Auto. +Lemma single_z_r_R1 : + forall r (n m:Z), + r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m. +intros; apply one_IZR_r_R1 with r; auto. Qed. (**********) -Lemma tech_single_z_r_R1 - :(r:R)(z:Z)``r<(IZR z)``->``(IZR z)<=r+1`` - -> (Ex [s:Z] (~s=z/\``r<(IZR s)``/\``(IZR s)<=r+1``))->False. -Intros r z H1 H2 (s, (H3,(H4,H5))). -Apply H3; Apply single_z_r_R1 with r; Trivial. +Lemma tech_single_z_r_R1 : + forall r (n:Z), + r < IZR n -> + IZR n <= r + 1 -> + ( exists s : Z | s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False. +intros r z H1 H2 [s [H3 [H4 H5]]]. +apply H3; apply single_z_r_R1 with r; trivial. Qed. (*****************************************************************) (** Definitions of new types *) (*****************************************************************) -Record nonnegreal : Type := mknonnegreal { -nonneg :> R; -cond_nonneg : ``0<=nonneg`` }. +Record nonnegreal : Type := mknonnegreal + {nonneg :> R; cond_nonneg : 0 <= nonneg}. -Record posreal : Type := mkposreal { -pos :> R; -cond_pos : ``0<pos`` }. +Record posreal : Type := mkposreal {pos :> R; cond_pos : 0 < pos}. -Record nonposreal : Type := mknonposreal { -nonpos :> R; -cond_nonpos : ``nonpos<=0`` }. +Record nonposreal : Type := mknonposreal + {nonpos :> R; cond_nonpos : nonpos <= 0}. -Record negreal : Type := mknegreal { -neg :> R; -cond_neg : ``neg<0`` }. +Record negreal : Type := mknegreal {neg :> R; cond_neg : neg < 0}. -Record nonzeroreal : Type := mknonzeroreal { -nonzero :> R; -cond_nonzero : ~``nonzero==0`` }. +Record nonzeroreal : Type := mknonzeroreal + {nonzero :> R; cond_nonzero : nonzero <> 0}. (**********) -Lemma prod_neq_R0 : (x,y:R) ~``x==0``->~``y==0``->~``x*y==0``. -Intros x y; Intros; Red; Intro; Generalize (without_div_Od x y H1); Intro; Elim H2; Intro; [Rewrite H3 in H; Elim H | Rewrite H3 in H0; Elim H0]; Reflexivity. +Lemma prod_neq_R0 : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0. +intros x y; intros; red in |- *; intro; generalize (Rmult_integral x y H1); + intro; elim H2; intro; + [ rewrite H3 in H; elim H | rewrite H3 in H0; elim H0 ]; + reflexivity. Qed. (*********) -Lemma Rmult_le_pos : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x*y``. -Intros x y H H0; Rewrite <- (Rmult_Ol x); Rewrite <- (Rmult_sym x); Apply (Rle_monotony x R0 y H H0). +Lemma Rmult_le_pos : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2. +intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x); + apply (Rmult_le_compat_l x 0 y H H0). Qed. -Lemma double : (x:R) ``2*x==x+x``. -Intro; Ring. +Lemma double : forall r1, 2 * r1 = r1 + r1. +intro; ring. Qed. -Lemma double_var : (x:R) ``x == x/2 + x/2``. -Intro; Rewrite <- double; Unfold Rdiv; Rewrite <- Rmult_assoc; Symmetry; Apply Rinv_r_simpl_m. -Replace ``2`` with (INR (2)); [Apply not_O_INR; Discriminate | Unfold INR; Ring]. +Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2. +intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + symmetry in |- *; apply Rinv_r_simpl_m. +replace 2 with (INR 2); + [ apply not_O_INR; discriminate | unfold INR in |- *; ring ]. Qed. (**********************************************************) (** Other rules about < and <= *) (**********************************************************) -Lemma gt0_plus_gt0_is_gt0 : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``. -Intros x y; Intros; Apply Rlt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption]. -Qed. - -Lemma ge0_plus_gt0_is_gt0 : (x,y:R) ``0<=x`` -> ``0<y`` -> ``0<x+y``. -Intros x y; Intros; Apply Rle_lt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption]. -Qed. - -Lemma gt0_plus_ge0_is_gt0 : (x,y:R) ``0<x`` -> ``0<=y`` -> ``0<x+y``. -Intros x y; Intros; Rewrite <- Rplus_sym; Apply ge0_plus_gt0_is_gt0; Assumption. -Qed. - -Lemma ge0_plus_ge0_is_ge0 : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x+y``. -Intros x y; Intros; Apply Rle_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption]. -Qed. - -Lemma plus_le_is_le : (x,y,z:R) ``0<=y`` -> ``x+y<=z`` -> ``x<=z``. -Intros x y z; Intros; Apply Rle_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption]. -Qed. - -Lemma plus_lt_is_lt : (x,y,z:R) ``0<=y`` -> ``x+y<z`` -> ``x<z``. -Intros x y z; Intros; Apply Rle_lt_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption]. -Qed. - -Lemma Rmult_lt2 : (r1,r2,r3,r4:R) ``0<=r1`` -> ``0<=r3`` -> ``r1<r2`` -> ``r3<r4`` -> ``r1*r3<r2*r4``. -Intros; Apply Rle_lt_trans with ``r2*r3``; [Apply Rle_monotony_r; [Assumption | Left; Assumption] | Apply Rlt_monotony; [Apply Rle_lt_trans with r1; Assumption | Assumption]]. -Qed. - -Lemma le_epsilon : (x,y:R) ((eps : R) ``0<eps``->``x<=y+eps``) -> ``x<=y``. -Intros x y; Intros; Elim (total_order x y); Intro. -Left; Assumption. -Elim H0; Intro. -Right; Assumption. -Clear H0; Generalize (Rgt_minus x y H1); Intro H2; Change ``0<x-y`` in H2. -Cut ``0<2``. -Intro. -Generalize (Rmult_lt_pos ``x-y`` ``/2`` H2 (Rlt_Rinv ``2`` H0)); Intro H3; Generalize (H ``(x-y)*/2`` H3); Replace ``y+(x-y)*/2`` with ``(y+x)*/2``. -Intro H4; Generalize (Rle_monotony ``2`` x ``(y+x)*/2`` (Rlt_le ``0`` ``2`` H0) H4); Rewrite <- (Rmult_sym ``((y+x)*/2)``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Replace ``2*x`` with ``x+x``. -Rewrite (Rplus_sym y); Intro H5; Apply Rle_anti_compatibility with x; Assumption. -Ring. -Replace ``2`` with (INR (S (S O))); [Apply not_O_INR; Discriminate | Ring]. -Pattern 2 y; Replace y with ``y/2+y/2``. -Unfold Rminus Rdiv. -Repeat Rewrite Rmult_Rplus_distrl. -Ring. -Cut (z:R) ``2*z == z + z``. -Intro. -Rewrite <- (H4 ``y/2``). -Unfold Rdiv. -Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m. -Replace ``2`` with (INR (2)). -Apply not_O_INR. -Discriminate. -Unfold INR; Reflexivity. -Intro; Ring. -Cut ~(O=(2)); [Intro H0; Generalize (lt_INR_0 (2) (neq_O_lt (2) H0)); Unfold INR; Intro; Assumption | Discriminate]. -Qed. - -(**********) -Lemma complet_weak : (E:R->Prop) (bound E) -> (ExT [x:R] (E x)) -> (ExT [m:R] (is_lub E m)). -Intros; Elim (complet E H H0); Intros; Split with x; Assumption. -Qed. +Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2. +intros x y; intros; apply Rlt_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; + assumption ]. +Qed. + +Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2. +intros x y; intros; apply Rle_lt_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; + assumption ]. +Qed. + +Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2. +intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat; + assumption. +Qed. + +Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2. +intros x y; intros; apply Rle_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption ]. +Qed. + +Lemma plus_le_is_le : forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3. +intros x y z; intros; apply Rle_trans with (x + y); + [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption + | assumption ]. +Qed. + +Lemma plus_lt_is_lt : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3. +intros x y z; intros; apply Rle_lt_trans with (x + y); + [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption + | assumption ]. +Qed. + +Lemma Rmult_le_0_lt_compat : + forall r1 r2 r3 r4, + 0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +intros; apply Rle_lt_trans with (r2 * r3); + [ apply Rmult_le_compat_r; [ assumption | left; assumption ] + | apply Rmult_lt_compat_l; + [ apply Rle_lt_trans with r1; assumption | assumption ] ]. +Qed. + +Lemma le_epsilon : + forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2. +intros x y; intros; elim (Rtotal_order x y); intro. +left; assumption. +elim H0; intro. +right; assumption. +clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2. +cut (0 < 2). +intro. +generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0)); + intro H3; generalize (H ((x - y) * / 2) H3); + replace (y + (x - y) * / 2) with ((y + x) * / 2). +intro H4; + generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4); + rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; replace (2 * x) with (x + x). +rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. +ring. +replace 2 with (INR 2); [ apply not_O_INR; discriminate | ring ]. +pattern y at 2 in |- *; replace y with (y / 2 + y / 2). +unfold Rminus, Rdiv in |- *. +repeat rewrite Rmult_plus_distr_r. +ring. +cut (forall z:R, 2 * z = z + z). +intro. +rewrite <- (H4 (y / 2)). +unfold Rdiv in |- *. +rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +replace 2 with (INR 2). +apply not_O_INR. +discriminate. +unfold INR in |- *; reflexivity. +intro; ring. +cut (0%nat <> 2%nat); + [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *; + intro; assumption + | discriminate ]. +Qed. + +(**********) +Lemma completeness_weak : + forall E:R -> Prop, + bound E -> ( exists x : R | E x) -> exists m : R | is_lub E m. +intros; elim (completeness E H H0); intros; split with x; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v index 6e6f2716b..40848009a 100644 --- a/theories/Reals/RList.v +++ b/theories/Reals/RList.v @@ -8,420 +8,737 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. Open Local Scope R_scope. Inductive Rlist : Type := -| nil : Rlist -| cons : R -> Rlist -> Rlist. - -Fixpoint In [x:R;l:Rlist] : Prop := -Cases l of -| nil => False -| (cons a l') => ``x==a``\/(In x l') end. - -Fixpoint Rlength [l:Rlist] : nat := -Cases l of -| nil => O -| (cons a l') => (S (Rlength l')) end. - -Fixpoint MaxRlist [l:Rlist] : R := - Cases l of - | nil => R0 - | (cons a l1) => - Cases l1 of - | nil => a - | (cons a' l2) => (Rmax a (MaxRlist l1)) - end -end. - -Fixpoint MinRlist [l:Rlist] : R := -Cases l of - | nil => R1 - | (cons a l1) => - Cases l1 of - | nil => a - | (cons a' l2) => (Rmin a (MinRlist l1)) - end -end. - -Lemma MaxRlist_P1 : (l:Rlist;x:R) (In x l)->``x<=(MaxRlist l)``. -Intros; Induction l. -Simpl in H; Elim H. -Induction l. -Simpl in H; Elim H; Intro. -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; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro. -Apply Hrecl; Simpl; Tauto. -Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real]. -Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro. -Apply Hrecl; Simpl; Tauto. -Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real]. -Reflexivity. -Qed. - -Fixpoint AbsList [l:Rlist] : R->Rlist := -[x:R] Cases l of -| nil => nil -| (cons a l') => (cons ``(Rabsolu (a-x))/2`` (AbsList l' x)) -end. - -Lemma MinRlist_P1 : (l:Rlist;x:R) (In x l)->``(MinRlist l)<=x``. -Intros; Induction l. -Simpl in H; Elim H. -Induction l. -Simpl in H; Elim H; Intro. -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; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro. -Apply Rle_trans with (MinRlist (cons r0 l)). -Assumption. -Apply Hrecl; Simpl; Tauto. -Apply Hrecl; Simpl; Tauto. -Apply Rle_trans with (MinRlist (cons r0 l)). -Apply Rmin_r. -Apply Hrecl; Simpl; Tauto. -Reflexivity. -Qed. - -Lemma AbsList_P1 : (l:Rlist;x,y:R) (In y l) -> (In ``(Rabsolu (y-x))/2`` (AbsList l x)). -Intros; Induction l. -Elim H. -Simpl; Simpl in H; Elim H; Intro. -Left; Rewrite H0; Reflexivity. -Right; Apply Hrecl; Assumption. -Qed. - -Lemma MinRlist_P2 : (l:Rlist) ((y:R)(In y l)->``0<y``)->``0<(MinRlist l)``. -Intros; Induction l. -Apply Rlt_R0_R1. -Induction l. -Simpl; Apply H; Simpl; Tauto. -Replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). -Unfold Rmin; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro. -Apply H; Simpl; Tauto. -Apply Hrecl; Intros; Apply H; Simpl; Simpl in H0; Tauto. -Reflexivity. -Qed. - -Lemma AbsList_P2 : (l:Rlist;x,y:R) (In y (AbsList l x)) -> (EXT z : R | (In z l)/\``y==(Rabsolu (z-x))/2``). -Intros; Induction l. -Elim H. -Elim H; Intro. -Exists r; Split. -Simpl; Tauto. -Assumption. -Assert H1 := (Hrecl H0); Elim H1; Intros; Elim H2; Clear H2; Intros; Exists x0; Simpl; Simpl in H2; Tauto. -Qed. - -Lemma MaxRlist_P2 : (l:Rlist) (EXT y:R | (In y l)) -> (In (MaxRlist l) l). -Intros; Induction l. -Simpl in H; Elim H; Trivial. -Induction l. -Simpl; Left; Reflexivity. -Change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))); Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro. -Right; Apply Hrecl; Exists r0; Left; Reflexivity. -Left; Reflexivity. -Qed. - -Fixpoint pos_Rl [l:Rlist] : nat->R := -[i:nat] Cases l of -| nil => R0 -| (cons a l') => - Cases i of - | O => a - | (S i') => (pos_Rl l' i') - end -end. - -Lemma pos_Rl_P1 : (l:Rlist;a:R) (lt O (Rlength l)) -> (pos_Rl (cons a l) (Rlength l))==(pos_Rl l (pred (Rlength l))). -Intros; Induction l; [Elim (lt_n_O ? H) | Simpl; Case (Rlength l); [Reflexivity | Intro; Reflexivity]]. -Qed. - -Lemma pos_Rl_P2 : (l:Rlist;x:R) (In x l)<->(EX i:nat | (lt i (Rlength l))/\x==(pos_Rl l i)). -Intros; Induction l. -Split; Intro; [Elim H | Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H1)]. -Split; Intro. -Elim H; Intro. -Exists O; Split; [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; 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; Apply S_pred with O; Assumption. -Exists (pred x0); Split; [Simpl in H1; Apply lt_S_n; Rewrite H5; Assumption | Rewrite <- H5 in H2; Simpl in H2; Assumption]. -Qed. - -Lemma Rlist_P1 : (l:Rlist;P:R->R->Prop) ((x:R)(In x l)->(EXT y:R | (P x y))) -> (EXT l':Rlist | (Rlength l)=(Rlength l')/\(i:nat) (lt i (Rlength l))->(P (pos_Rl l i) (pos_Rl l' i))). -Intros; Induction l. -Exists nil; Intros; Split; [Reflexivity | Intros; Simpl in H0; Elim (lt_n_O ? H0)]. -Assert H0 : (In r (cons r l)). -Simpl; Left; Reflexivity. -Assert H1 := (H ? H0); Assert H2 : (x:R)(In x l)->(EXT y:R | (P x y)). -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; Rewrite H5; Reflexivity. -Intros; Elim (zerop i); Intro. -Rewrite a; Simpl; Assumption. -Assert H8 : i=(S (pred i)). -Apply S_pred with O; Assumption. -Rewrite H8; Simpl; Apply H6; Simpl in H7; Apply lt_S_n; Rewrite <- H8; Assumption. -Qed. - -Definition ordered_Rlist [l:Rlist] : Prop := (i:nat) (lt i (pred (Rlength l))) -> (Rle (pos_Rl l i) (pos_Rl l (S i))). - -Fixpoint insert [l:Rlist] : R->Rlist := -[x:R] Cases l of -| nil => (cons x nil) -| (cons a l') => - Cases (total_order_Rle a x) of - | (leftT _) => (cons a (insert l' x)) - | (rightT _) => (cons x l) - end -end. - -Fixpoint cons_Rlist [l:Rlist] : Rlist->Rlist := -[k:Rlist] Cases l of -| nil => k -| (cons a l') => (cons a (cons_Rlist l' k)) end. - -Fixpoint cons_ORlist [k:Rlist] : Rlist->Rlist := -[l:Rlist] Cases k of -| nil => l -| (cons a k') => (cons_ORlist k' (insert l a)) -end. - -Fixpoint app_Rlist [l:Rlist] : (R->R)->Rlist := -[f:R->R] Cases l of -| nil => nil -| (cons a l') => (cons (f a) (app_Rlist l' f)) -end. - -Fixpoint mid_Rlist [l:Rlist] : R->Rlist := -[x:R] Cases l of -| nil => nil -| (cons a l') => (cons ``(x+a)/2`` (mid_Rlist l' a)) -end. - -Definition Rtail [l:Rlist] : Rlist := -Cases l of -| nil => nil -| (cons a l') => l' -end. - -Definition FF [l:Rlist;f:R->R] : Rlist := -Cases l of -| nil => nil -| (cons a l') => (app_Rlist (mid_Rlist l' a) f) -end. - -Lemma RList_P0 : (l:Rlist;a:R) ``(pos_Rl (insert l a) O) == a`` \/ ``(pos_Rl (insert l a) O) == (pos_Rl l O)``. -Intros; Induction l; [Left; Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Right; Reflexivity | Left; Reflexivity]]. -Qed. - -Lemma RList_P1 : (l:Rlist;a:R) (ordered_Rlist l) -> (ordered_Rlist (insert l a)). -Intros; Induction l. -Simpl; Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0). -Simpl; Case (total_order_Rle r a); Intro. -Assert H1 : (ordered_Rlist l). -Unfold ordered_Rlist; Unfold ordered_Rlist in H; Intros; Assert H1 : (lt (S i) (pred (Rlength (cons r l)))); [Simpl; Replace (Rlength l) with (S (pred (Rlength l))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; 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; Intros; Induction i. -Simpl; Assert H3 := (RList_P0 l a); Elim H3; Intro. -Rewrite H4; Assumption. -Induction l; [Simpl; Assumption | Rewrite H4; Apply (H O); 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 O; Apply neq_O_lt; Red; Intro; Rewrite <- H3 in H0; Elim (lt_n_O ? H0)]. -Unfold ordered_Rlist; Intros; Induction i; [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 : (l1,l2:Rlist) (ordered_Rlist l2) ->(ordered_Rlist (cons_ORlist l1 l2)). -Induction l1; [Intros; Simpl; Apply H | Intros; Simpl; Apply H; Apply RList_P1; Assumption]. -Qed. - -Lemma RList_P3 : (l:Rlist;x:R) (In x l) <-> (EX i:nat | x==(pos_Rl l i)/\(lt i (Rlength l))). -Intros; Split; Intro; Induction l. -Elim H. -Elim H; Intro; [Exists O; Split; [Apply H0 | Simpl; Apply lt_O_Sn] | Elim (Hrecl H0); Intros; Elim H1; Clear H1; Intros; Exists (S x0); Split; [Apply H1 | Simpl; Apply lt_n_S; Assumption]]. -Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H2). -Simpl; Elim H; Intros; Elim H0; Clear H0; Intros; Induction x0; [Left; Apply H0 | Right; Apply Hrecl; Exists x0; Split; [Apply H0 | Simpl in H1; Apply lt_S_n; Assumption]]. -Qed. - -Lemma RList_P4 : (l1:Rlist;a:R) (ordered_Rlist (cons a l1)) -> (ordered_Rlist l1). -Intros; Unfold ordered_Rlist; Intros; Apply (H (S i)); Simpl; Replace (Rlength l1) with (S (pred (Rlength l1))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H1 in H0; Elim (lt_n_O ? H0)]. -Qed. - -Lemma RList_P5 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``(pos_Rl l O)<=x``. -Intros; Induction l; [Elim H0 | Simpl; Elim H0; Intro; [Rewrite H1; Right; Reflexivity | Apply Rle_trans with (pos_Rl l O); [Apply (H O); Simpl; Induction l; [Elim H1 | Simpl; Apply lt_O_Sn] | Apply Hrecl; [EApply RList_P4; Apply H | Assumption]]]]. -Qed. - -Lemma RList_P6 : (l:Rlist) (ordered_Rlist l)<->((i,j:nat)(le i j)->(lt j (Rlength l))->``(pos_Rl l i)<=(pos_Rl l j)``). -Induction l; Split; Intro. -Intros; Right; Reflexivity. -Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0). -Intros; Induction i; [Induction j; [Right; Reflexivity | Simpl; Apply Rle_trans with (pos_Rl r0 O); [Apply (H0 O); 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 | Apply le_O_n | Simpl in H2; Apply lt_S_n; Assumption]]] | Induction j; [Elim (le_Sn_O ? H1) | 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; Intros; Apply H0; [Apply le_n_Sn | Simpl; Simpl in H1; Apply lt_n_S; Assumption]. -Qed. - -Lemma RList_P7 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``x<=(pos_Rl l (pred (Rlength l)))``. -Intros; Assert H1 := (RList_P6 l); Elim H1; Intros H2 _; Assert H3 := (H2 H); Clear H1 H2; Assert H1 := (RList_P3 l x); Elim H1; Clear H1; Intros; Assert H4 := (H1 H0); Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Rewrite H4; Assert H6 : (Rlength l)=(S (pred (Rlength l))). -Apply S_pred with O; 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; Intro; Rewrite <- H7 in H5; Elim (lt_n_O ? H5)]. -Qed. - -Lemma RList_P8 : (l:Rlist;a,x:R) (In x (insert l a)) <-> x==a\/(In x l). -Induction l. -Intros; Split; Intro; Simpl in H; Apply H. -Intros; Split; Intro; [Simpl in H0; Generalize H0; Case (total_order_Rle r a); Intros; [Simpl in H1; Elim H1; Intro; [Right; Left; Assumption |Elim (H a x); Intros; Elim (H3 H2); Intro; [Left; Assumption | Right; Right; Assumption]] | Simpl in H1; Decompose [or] H1; [Left; Assumption | Right; Left; Assumption | Right; Right; Assumption]] | Simpl; Case (total_order_Rle r a); Intro; [Simpl in H0; Decompose [or] H0; [Right; Elim (H a x); Intros; Apply H3; Left | Left | Right; Elim (H a x); Intros; Apply H3; Right] | Simpl in H0; Decompose [or] H0; [Left | Right; Left | Right; Right]]; Assumption]. -Qed. - -Lemma RList_P9 : (l1,l2:Rlist;x:R) (In x (cons_ORlist l1 l2)) <-> (In x l1)\/(In x l2). -Induction l1. -Intros; Split; Intro; [Simpl in H; Right; Assumption | Simpl; Elim H; Intro; [Elim H0 | Assumption]]. -Intros; Split. -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; Elim (H (insert l2 r) x); Intros _ H1; Apply H1; Elim H0; Intro; [Elim H2; Intro; [Right; Elim (RList_P8 l2 r x); Intros _ H4; Apply H4; Left; Assumption | Left; Assumption] | Right; Elim (RList_P8 l2 r x); Intros _ H3; Apply H3; Right; Assumption]. -Qed. - -Lemma RList_P10 : (l:Rlist;a:R) (Rlength (insert l a))==(S (Rlength l)). -Intros; Induction l; [Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Simpl; Rewrite Hrecl; Reflexivity | Reflexivity]]. -Qed. - -Lemma RList_P11 : (l1,l2:Rlist) (Rlength (cons_ORlist l1 l2))=(plus (Rlength l1) (Rlength l2)). -Induction l1; [Intro; Reflexivity | 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. - -Lemma RList_P12 : (l:Rlist;i:nat;f:R->R) (lt i (Rlength l)) -> (pos_Rl (app_Rlist l f) i)==(f (pos_Rl l i)). -Induction l; [Intros; Elim (lt_n_O ? H) | Intros; Induction i; [Reflexivity | Simpl; Apply H; Apply lt_S_n; Apply H0]]. -Qed. - -Lemma RList_P13 : (l:Rlist;i:nat;a:R) (lt i (pred (Rlength l))) -> ``(pos_Rl (mid_Rlist l a) (S i)) == ((pos_Rl l i)+(pos_Rl l (S i)))/2``. -Induction l. -Intros; Simpl in H; Elim (lt_n_O ? H). -Induction r0. -Intros; Simpl in H0; Elim (lt_n_O ? H0). -Intros; Simpl in H1; Induction i. -Reflexivity. -Change ``(pos_Rl (mid_Rlist (cons r1 r2) r) (S i)) == ((pos_Rl (cons r1 r2) i)+(pos_Rl (cons r1 r2) (S i)))/2``; Apply H0; Simpl; Apply lt_S_n; Assumption. -Qed. - -Lemma RList_P14 : (l:Rlist;a:R) (Rlength (mid_Rlist l a))=(Rlength l). -Induction l; Intros; [Reflexivity | Simpl; Rewrite (H r); Reflexivity]. -Qed. - -Lemma RList_P15 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 O)==(pos_Rl l2 O) -> (pos_Rl (cons_ORlist l1 l2) O)==(pos_Rl l1 O). -Intros; Apply Rle_antisym. -Induction l1; [Simpl; Simpl in H1; Right; Symmetry; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (0))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (0)) (cons r l1))\/(In (pos_Rl (cons r l1) (0)) l2); [Left; Left; Reflexivity | Assert H5 := (H3 H4); Apply RList_P5; [Apply RList_P2; Assumption | Assumption]]]. -Induction l1; [Simpl; Simpl in H1; Right; Assumption | Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (0)) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (0))); Intros; Apply H3; Exists O; Split; [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 | Rewrite H1; Apply RList_P5; Assumption]]]. -Qed. - -Lemma RList_P16 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 (pred (Rlength l2))) -> (pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))))==(pos_Rl l1 (pred (Rlength l1))). -Intros; Apply Rle_antisym. -Induction l1. -Simpl; Simpl in H1; Right; Symmetry; Assumption. -Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2)))) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Apply H3; Exists (pred (Rlength (cons_ORlist (cons r l1) l2))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn] | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Assert H5 := (H3 H2); Elim H5; Intro; [Apply RList_P7; Assumption | Rewrite H1; Apply RList_P7; Assumption]]. -Induction l1. -Simpl; Simpl in H1; Right; Assumption. -Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1))\/(In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); [Left; Change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)); Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); Intros; Apply H5; Exists (Rlength l1); Split; [Reflexivity | Simpl; Apply lt_n_Sn] | Assert H5 := (H3 H4); Apply RList_P7; [Apply RList_P2; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H7; Left; Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H9; Exists (pred (Rlength (cons r l1))); Split; [Reflexivity | Simpl; Apply lt_n_Sn]]]. -Qed. - -Lemma RList_P17 : (l1:Rlist;x:R;i:nat) (ordered_Rlist l1) -> (In x l1) -> ``(pos_Rl l1 i)<x`` -> (lt i (pred (Rlength l1))) -> ``(pos_Rl l1 (S i))<=x``. -Induction l1. -Intros; Elim H0. -Intros; Induction i. -Simpl; Elim H1; Intro; [Simpl in H2; Rewrite H4 in H2; Elim (Rlt_antirefl ? H2) | Apply RList_P5; [Apply RList_P4 with r; Assumption | Assumption]]. -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 O); [Apply (H0 O); 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 | Simpl in H3; Apply lt_S_n; Apply lt_trans with (Rlength r0); [Apply H3 | Apply lt_n_Sn]]] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H2))]. -Apply H; Try Assumption; [Apply RList_P4 with r; Assumption | Simpl in H3; Apply lt_S_n; Replace (S (pred (Rlength r0))) with (Rlength r0); [Apply H3 | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H5 in H3; Elim (lt_n_O ? H3)]]. -Qed. - -Lemma RList_P18 : (l:Rlist;f:R->R) (Rlength (app_Rlist l f))=(Rlength l). -Induction l; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity]. -Qed. - -Lemma RList_P19 : (l:Rlist) ~l==nil -> (EXT r:R | (EXT r0:Rlist | l==(cons r r0))). -Intros; Induction l; [Elim H; Reflexivity | Exists r; Exists l; Reflexivity]. -Qed. - -Lemma RList_P20 : (l:Rlist) (le (2) (Rlength l)) -> (EXT r:R | (EXT r1:R | (EXT l':Rlist | l==(cons r (cons r1 l'))))). -Intros; Induction l; [Simpl in H; Elim (le_Sn_O ? H) | Induction l; [Simpl in H; Elim (le_Sn_O ? (le_S_n ? ? H)) | Exists r; Exists r0; Exists l; Reflexivity]]. -Qed. - -Lemma RList_P21 : (l,l':Rlist) l==l' -> (Rtail l)==(Rtail l'). -Intros; Rewrite H; Reflexivity. -Qed. - -Lemma RList_P22 : (l1,l2:Rlist) ~l1==nil -> (pos_Rl (cons_Rlist l1 l2) O)==(pos_Rl l1 O). -Induction l1; [Intros; Elim H; Reflexivity | Intros; Reflexivity]. -Qed. - -Lemma RList_P23 : (l1,l2:Rlist) (Rlength (cons_Rlist l1 l2))==(plus (Rlength l1) (Rlength l2)). -Induction l1; [Intro; Reflexivity | Intros; Simpl; Rewrite H; Reflexivity]. -Qed. - -Lemma RList_P24 : (l1,l2:Rlist) ~l2==nil -> (pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2)))) == (pos_Rl l2 (pred (Rlength l2))). -Induction l1. -Intros; Reflexivity. -Intros; Rewrite <- (H l2 H0); Induction l2. -Elim H0; Reflexivity. -Do 2 Rewrite RList_P23; Replace (plus (Rlength (cons r r0)) (Rlength (cons r1 l2))) with (S (S (plus (Rlength r0) (Rlength l2)))); [Replace (plus (Rlength r0) (Rlength (cons r1 l2))) with (S (plus (Rlength r0) (Rlength l2))); [Reflexivity | Simpl; Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring] | Simpl; Apply INR_eq; Do 3 Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring]. -Qed. - -Lemma RList_P25 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> ``(pos_Rl l1 (pred (Rlength l1)))<=(pos_Rl l2 O)`` -> (ordered_Rlist (cons_Rlist l1 l2)). -Induction l1. -Intros; Simpl; Assumption. -Induction r0. -Intros; Simpl; Simpl in H2; Unfold ordered_Rlist; Intros; Simpl in H3. -Induction i. -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 O; 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; Intros; Simpl in H4; Induction i. -Simpl; Apply (H1 O); 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))``; Apply (H i); Simpl; Apply lt_S_n; Assumption. -Qed. - -Lemma RList_P26 : (l1,l2:Rlist;i:nat) (lt i (Rlength l1)) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l1 i). -Induction l1. -Intros; Elim (lt_n_O ? H). -Intros; Induction i. -Apply RList_P22; Discriminate. -Apply (H l2 i); Simpl in H0; Apply lt_S_n; Assumption. -Qed. - -Lemma RList_P27 : (l1,l2,l3:Rlist) (cons_Rlist l1 (cons_Rlist l2 l3))==(cons_Rlist (cons_Rlist l1 l2) l3). -Induction l1; Intros; [Reflexivity | Simpl; Rewrite (H l2 l3); Reflexivity]. -Qed. - -Lemma RList_P28 : (l:Rlist) (cons_Rlist l nil)==l. -Induction l; [Reflexivity | Intros; Simpl; Rewrite H; Reflexivity]. -Qed. - -Lemma RList_P29 : (l2,l1:Rlist;i:nat) (le (Rlength l1) i) -> (lt i (Rlength (cons_Rlist l1 l2))) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l2 (minus i (Rlength l1))). -Induction l2. -Intros; Rewrite RList_P28 in H0; Elim (lt_n_n ? (le_lt_trans ? ? ? H H0)). -Intros; Replace (cons_Rlist l1 (cons r r0)) with (cons_Rlist (cons_Rlist l1 (cons r nil)) r0). -Inversion H0. -Rewrite <- minus_n_n; Simpl; Rewrite RList_P26. -Clear l2 r0 H i H0 H1 H2; Induction l1. -Reflexivity. -Simpl; Assumption. -Rewrite RList_P23; Rewrite plus_sym; Simpl; Apply lt_n_Sn. -Replace (minus (S m) (Rlength l1)) with (S (minus (S m) (S (Rlength l1)))). -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_sym; Simpl; Rewrite <- H3; Apply le_n_S; Assumption. -Repeat Rewrite RList_P23; Simpl; Rewrite RList_P23 in H1; Rewrite plus_sym in H1; Simpl in H1; Rewrite (plus_sym (Rlength l1)); Simpl; Rewrite plus_sym; Apply H1. -Rewrite RList_P23; Rewrite plus_sym; Reflexivity. -Change (S (minus m (Rlength l1)))=(minus (S m) (Rlength l1)); Apply minus_Sn_m; Assumption. -Replace (cons r r0) with (cons_Rlist (cons r nil) r0); [Symmetry; Apply RList_P27 | Reflexivity]. -Qed. + | nil : Rlist + | cons : R -> Rlist -> Rlist. + +Fixpoint In (x:R) (l:Rlist) {struct l} : Prop := + match l with + | nil => False + | cons a l' => x = a \/ In x l' + end. + +Fixpoint Rlength (l:Rlist) : nat := + match l with + | nil => 0%nat + | cons a l' => S (Rlength l') + end. + +Fixpoint MaxRlist (l:Rlist) : R := + match l with + | nil => 0 + | cons a l1 => + match l1 with + | nil => a + | cons a' l2 => Rmax a (MaxRlist l1) + end + end. + +Fixpoint MinRlist (l:Rlist) : R := + match l with + | nil => 1 + | cons a l1 => + match l1 with + | nil => a + | cons a' l2 => Rmin a (MinRlist l1) + end + end. + +Lemma MaxRlist_P1 : forall (l:Rlist) (x:R), In x l -> x <= MaxRlist l. +intros; induction l as [| r l Hrecl]. +simpl in H; elim H. +induction l as [| r0 l Hrecl0]. +simpl in H; elim H; intro. +simpl in |- *; right; assumption. +elim H0. +replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))). +simpl in H; decompose [or] H. +rewrite H0; apply RmaxLess1. +unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. +apply Hrecl; simpl in |- *; tauto. +apply Rle_trans with (MaxRlist (cons r0 l)); + [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. +unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. +apply Hrecl; simpl in |- *; tauto. +apply Rle_trans with (MaxRlist (cons r0 l)); + [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. +reflexivity. +Qed. + +Fixpoint AbsList (l:Rlist) (x:R) {struct l} : Rlist := + match l with + | nil => nil + | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x) + end. + +Lemma MinRlist_P1 : forall (l:Rlist) (x:R), In x l -> MinRlist l <= x. +intros; induction l as [| r l Hrecl]. +simpl in H; elim H. +induction l as [| r0 l Hrecl0]. +simpl in H; elim H; intro. +simpl in |- *; right; symmetry in |- *; assumption. +elim H0. +replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). +simpl in H; decompose [or] H. +rewrite H0; apply Rmin_l. +unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. +apply Rle_trans with (MinRlist (cons r0 l)). +assumption. +apply Hrecl; simpl in |- *; tauto. +apply Hrecl; simpl in |- *; tauto. +apply Rle_trans with (MinRlist (cons r0 l)). +apply Rmin_r. +apply Hrecl; simpl in |- *; tauto. +reflexivity. +Qed. + +Lemma AbsList_P1 : + forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x). +intros; induction l as [| r l Hrecl]. +elim H. +simpl in |- *; simpl in H; elim H; intro. +left; rewrite H0; reflexivity. +right; apply Hrecl; assumption. +Qed. + +Lemma MinRlist_P2 : + forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l. +intros; induction l as [| r l Hrecl]. +apply Rlt_0_1. +induction l as [| r0 l Hrecl0]. +simpl in |- *; apply H; simpl in |- *; tauto. +replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). +unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. +apply H; simpl in |- *; tauto. +apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto. +reflexivity. +Qed. + +Lemma AbsList_P2 : + forall (l:Rlist) (x y:R), + In y (AbsList l x) -> exists z : R | In z l /\ y = Rabs (z - x) / 2. +intros; induction l as [| r l Hrecl]. +elim H. +elim H; intro. +exists r; split. +simpl in |- *; tauto. +assumption. +assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros; + exists x0; simpl in |- *; simpl in H2; tauto. +Qed. + +Lemma MaxRlist_P2 : + forall l:Rlist, ( exists y : R | In y l) -> In (MaxRlist l) l. +intros; induction l as [| r l Hrecl]. +simpl in H; elim H; trivial. +induction l as [| r0 l Hrecl0]. +simpl in |- *; left; reflexivity. +change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *; + unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); + intro. +right; apply Hrecl; exists r0; left; reflexivity. +left; reflexivity. +Qed. + +Fixpoint pos_Rl (l:Rlist) (i:nat) {struct l} : R := + match l with + | nil => 0 + | cons a l' => match i with + | O => a + | S i' => pos_Rl l' i' + end + end. + +Lemma pos_Rl_P1 : + forall (l:Rlist) (a:R), + (0 < Rlength l)%nat -> + pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)). +intros; induction l as [| r l Hrecl]; + [ elim (lt_n_O _ H) + | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ]. +Qed. + +Lemma pos_Rl_P2 : + forall (l:Rlist) (x:R), + In x l <-> ( exists i : nat | (i < Rlength l)%nat /\ x = pos_Rl l i). +intros; induction l as [| r l Hrecl]. +split; intro; + [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ]. +split; intro. +elim H; intro. +exists 0%nat; split; + [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ]. +elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros; + exists (S x0); split; + [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ]. +elim H; intros; elim H0; intros; elim (zerop x0); intro. +rewrite a in H2; simpl in H2; left; assumption. +right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0). +symmetry in |- *; apply S_pred with 0%nat; assumption. +exists (pred x0); split; + [ simpl in H1; apply lt_S_n; rewrite H5; assumption + | rewrite <- H5 in H2; simpl in H2; assumption ]. +Qed. + +Lemma Rlist_P1 : + forall (l:Rlist) (P:R -> R -> Prop), + (forall x:R, In x l -> exists y : R | P x y) -> + exists l' : Rlist + | Rlength l = Rlength l' /\ + (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)). +intros; induction l as [| r l Hrecl]. +exists nil; intros; split; + [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ]. +assert (H0 : In r (cons r l)). +simpl in |- *; left; reflexivity. +assert (H1 := H _ H0); + assert (H2 : forall x:R, In x l -> exists y : R | P x y). +intros; apply H; simpl in |- *; right; assumption. +assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0); + intros; elim H5; clear H5; intros; split. +simpl in |- *; rewrite H5; reflexivity. +intros; elim (zerop i); intro. +rewrite a; simpl in |- *; assumption. +assert (H8 : i = S (pred i)). +apply S_pred with 0%nat; assumption. +rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8; + assumption. +Qed. + +Definition ordered_Rlist (l:Rlist) : Prop := + forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <= pos_Rl l (S i). + +Fixpoint insert (l:Rlist) (x:R) {struct l} : Rlist := + match l with + | nil => cons x nil + | cons a l' => + match Rle_dec a x with + | left _ => cons a (insert l' x) + | right _ => cons x l + end + end. + +Fixpoint cons_Rlist (l k:Rlist) {struct l} : Rlist := + match l with + | nil => k + | cons a l' => cons a (cons_Rlist l' k) + end. + +Fixpoint cons_ORlist (k l:Rlist) {struct k} : Rlist := + match k with + | nil => l + | cons a k' => cons_ORlist k' (insert l a) + end. + +Fixpoint app_Rlist (l:Rlist) (f:R -> R) {struct l} : Rlist := + match l with + | nil => nil + | cons a l' => cons (f a) (app_Rlist l' f) + end. + +Fixpoint mid_Rlist (l:Rlist) (x:R) {struct l} : Rlist := + match l with + | nil => nil + | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a) + end. + +Definition Rtail (l:Rlist) : Rlist := + match l with + | nil => nil + | cons a l' => l' + end. + +Definition FF (l:Rlist) (f:R -> R) : Rlist := + match l with + | nil => nil + | cons a l' => app_Rlist (mid_Rlist l' a) f + end. + +Lemma RList_P0 : + forall (l:Rlist) (a:R), + pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0. +intros; induction l as [| r l Hrecl]; + [ left; reflexivity + | simpl in |- *; case (Rle_dec r a); intro; + [ right; reflexivity | left; reflexivity ] ]. +Qed. + +Lemma RList_P1 : + forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a). +intros; induction l as [| r l Hrecl]. +simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0; + elim (lt_n_O _ H0). +simpl in |- *; case (Rle_dec r a); intro. +assert (H1 : ordered_Rlist l). +unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros; + assert (H1 : (S i < pred (Rlength (cons r l)))%nat); + [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ] + | apply (H _ H1) ]. +assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro. +rewrite H4; assumption. +induction l as [| r1 l Hrecl0]; + [ simpl in |- *; assumption + | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ]. +simpl in |- *; apply H2; simpl in H0; apply lt_S_n; + replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a)); + [ assumption + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H3 in H0; elim (lt_n_O _ H0) ]. +unfold ordered_Rlist in |- *; intros; induction i as [| i Hreci]; + [ simpl in |- *; auto with real + | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H; + simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ]. +Qed. + +Lemma RList_P2 : + forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2). +simple induction l1; + [ intros; simpl in |- *; apply H + | intros; simpl in |- *; apply H; apply RList_P1; assumption ]. +Qed. + +Lemma RList_P3 : + forall (l:Rlist) (x:R), + In x l <-> ( exists i : nat | x = pos_Rl l i /\ (i < Rlength l)%nat). +intros; split; intro; + [ induction l as [| r l Hrecl] | induction l as [| r l Hrecl] ]. +elim H. +elim H; intro; + [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ] + | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split; + [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ]. +elim H; intros; elim H0; intros; elim (lt_n_O _ H2). +simpl in |- *; elim H; intros; elim H0; clear H0; intros; + induction x0 as [| x0 Hrecx0]; + [ left; apply H0 + | right; apply Hrecl; exists x0; split; + [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ]. +Qed. + +Lemma RList_P4 : + forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1. +intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *; + replace (Rlength l1) with (S (pred (Rlength l1))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ]. +Qed. + +Lemma RList_P5 : + forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x. +intros; induction l as [| r l Hrecl]; + [ elim H0 + | simpl in |- *; elim H0; intro; + [ rewrite H1; right; reflexivity + | apply Rle_trans with (pos_Rl l 0); + [ apply (H 0%nat); simpl in |- *; induction l as [| r0 l Hrecl0]; + [ elim H1 | simpl in |- *; apply lt_O_Sn ] + | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ]. +Qed. + +Lemma RList_P6 : + forall l:Rlist, + ordered_Rlist l <-> + (forall i j:nat, + (i <= j)%nat -> (j < Rlength l)%nat -> pos_Rl l i <= pos_Rl l j). +simple induction l; split; intro. +intros; right; reflexivity. +unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0). +intros; induction i as [| i Hreci]; + [ induction j as [| j Hrecj]; + [ right; reflexivity + | simpl in |- *; apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt; + red in |- *; intro; rewrite <- H3 in H2; + assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4) + | elim H; intros; apply H3; + [ apply RList_P4 with r; assumption + | apply le_O_n + | simpl in H2; apply lt_S_n; assumption ] ] ] + | induction j as [| j Hrecj]; + [ elim (le_Sn_O _ H1) + | simpl in |- *; elim H; intros; apply H3; + [ apply RList_P4 with r; assumption + | apply le_S_n; assumption + | simpl in H2; apply lt_S_n; assumption ] ] ]. +unfold ordered_Rlist in |- *; intros; apply H0; + [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ]. +Qed. + +Lemma RList_P7 : + forall (l:Rlist) (x:R), + ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)). +intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H); + clear H1 H2; assert (H1 := RList_P3 l x); elim H1; + clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; + intros; elim H4; clear H4; intros; rewrite H4; + assert (H6 : Rlength l = S (pred (Rlength l))). +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H6 in H5; elim (lt_n_O _ H5). +apply H3; + [ rewrite H6 in H5; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5; + elim (lt_n_O _ H5) ]. +Qed. + +Lemma RList_P8 : + forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l. +simple induction l. +intros; split; intro; simpl in H; apply H. +intros; split; intro; + [ simpl in H0; generalize H0; case (Rle_dec r a); intros; + [ simpl in H1; elim H1; intro; + [ right; left; assumption + | elim (H a x); intros; elim (H3 H2); intro; + [ left; assumption | right; right; assumption ] ] + | simpl in H1; decompose [or] H1; + [ left; assumption + | right; left; assumption + | right; right; assumption ] ] + | simpl in |- *; case (Rle_dec r a); intro; + [ simpl in H0; decompose [or] H0; + [ right; elim (H a x); intros; apply H3; left + | left + | right; elim (H a x); intros; apply H3; right ] + | simpl in H0; decompose [or] H0; [ left | right; left | right; right ] ]; + assumption ]. +Qed. + +Lemma RList_P9 : + forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2. +simple induction l1. +intros; split; intro; + [ simpl in H; right; assumption + | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ]. +intros; split. +simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0); + elim H3; intro; + [ left; right; assumption + | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro; + [ left; left; assumption | right; assumption ] ]. +intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1; + elim H0; intro; + [ elim H2; intro; + [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption + | left; assumption ] + | right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption ]. +Qed. + +Lemma RList_P10 : + forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l). +intros; induction l as [| r l Hrecl]; + [ reflexivity + | simpl in |- *; case (Rle_dec r a); intro; + [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ]. +Qed. + +Lemma RList_P11 : + forall l1 l2:Rlist, + Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat. +simple induction l1; + [ intro; reflexivity + | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10; + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ]. +Qed. + +Lemma RList_P12 : + forall (l:Rlist) (i:nat) (f:R -> R), + (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i). +simple induction l; + [ intros; elim (lt_n_O _ H) + | intros; induction i as [| i Hreci]; + [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ]. +Qed. + +Lemma RList_P13 : + forall (l:Rlist) (i:nat) (a:R), + (i < pred (Rlength l))%nat -> + pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2. +simple induction l. +intros; simpl in H; elim (lt_n_O _ H). +simple induction r0. +intros; simpl in H0; elim (lt_n_O _ H0). +intros; simpl in H1; induction i as [| i Hreci]. +reflexivity. +change + (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) = + (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2) + in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption. +Qed. + +Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l. +simple induction l; intros; + [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ]. +Qed. + +Lemma RList_P15 : + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0. +intros; apply Rle_antisym. +induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; simpl in H1; right; symmetry in |- *; assumption + | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros; + assert + (H4 : + In (pos_Rl (cons r l1) 0) (cons r l1) \/ In (pos_Rl (cons r l1) 0) l2); + [ left; left; reflexivity + | assert (H5 := H3 H4); apply RList_P5; + [ apply RList_P2; assumption | assumption ] ] ]. +induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; simpl in H1; right; assumption + | assert + (H2 : + In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2)); + [ elim + (RList_P3 (cons_ORlist (cons r l1) l2) + (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + intros; apply H3; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ] + | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + intros; assert (H5 := H3 H2); elim H5; intro; + [ apply RList_P5; assumption + | rewrite H1; apply RList_P5; assumption ] ] ]. +Qed. + +Lemma RList_P16 : + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 (pred (Rlength l2)) -> + pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))) = + pos_Rl l1 (pred (Rlength l1)). +intros; apply Rle_antisym. +induction l1 as [| r l1 Hrecl1]. +simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. +assert + (H2 : + In + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2)))) + (cons_ORlist (cons r l1) l2)); + [ elim + (RList_P3 (cons_ORlist (cons r l1) l2) + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2))))); + intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ] + | elim + (RList_P9 (cons r l1) l2 + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2))))); + intros; assert (H5 := H3 H2); elim H5; intro; + [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ]. +induction l1 as [| r l1 Hrecl1]. +simpl in |- *; simpl in H1; right; assumption. +elim + (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; + assert + (H4 : + In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/ + In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); + [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *; + elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); + intros; apply H5; exists (Rlength l1); split; + [ reflexivity | simpl in |- *; apply lt_n_Sn ] + | assert (H5 := H3 H4); apply RList_P7; + [ apply RList_P2; assumption + | elim + (RList_P9 (cons r l1) l2 + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H7; left; + elim + (RList_P3 (cons r l1) + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H9; exists (pred (Rlength (cons r l1))); + split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ]. +Qed. + +Lemma RList_P17 : + forall (l1:Rlist) (x:R) (i:nat), + ordered_Rlist l1 -> + In x l1 -> + pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x. +simple induction l1. +intros; elim H0. +intros; induction i as [| i Hreci]. +simpl in |- *; elim H1; intro; + [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2) + | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ]. +simpl in |- *; simpl in H2; elim H1; intro. +rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i); + [ apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt; + red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3) + | elim (RList_P6 r0); intros; apply H5; + [ apply RList_P4 with r; assumption + | apply le_O_n + | simpl in H3; apply lt_S_n; apply lt_trans with (Rlength r0); + [ apply H3 | apply lt_n_Sn ] ] ] + | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ]. +apply H; try assumption; + [ apply RList_P4 with r; assumption + | simpl in H3; apply lt_S_n; + replace (S (pred (Rlength r0))) with (Rlength r0); + [ apply H3 + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ]. +Qed. + +Lemma RList_P18 : + forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l. +simple induction l; intros; + [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma RList_P19 : + forall l:Rlist, + l <> nil -> exists r : R | ( exists r0 : Rlist | l = cons r r0). +intros; induction l as [| r l Hrecl]; + [ elim H; reflexivity | exists r; exists l; reflexivity ]. +Qed. + +Lemma RList_P20 : + forall l:Rlist, + (2 <= Rlength l)%nat -> + exists r : R + | ( exists r1 : R | ( exists l' : Rlist | l = cons r (cons r1 l'))). +intros; induction l as [| r l Hrecl]; + [ simpl in H; elim (le_Sn_O _ H) + | induction l as [| r0 l Hrecl0]; + [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H)) + | exists r; exists r0; exists l; reflexivity ] ]. +Qed. + +Lemma RList_P21 : forall l l':Rlist, l = l' -> Rtail l = Rtail l'. +intros; rewrite H; reflexivity. +Qed. + +Lemma RList_P22 : + forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0. +simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ]. +Qed. + +Lemma RList_P23 : + forall l1 l2:Rlist, + Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat. +simple induction l1; + [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma RList_P24 : + forall l1 l2:Rlist, + l2 <> nil -> + pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) = + pos_Rl l2 (pred (Rlength l2)). +simple induction l1. +intros; reflexivity. +intros; rewrite <- (H l2 H0); induction l2 as [| r1 l2 Hrecl2]. +elim H0; reflexivity. +do 2 rewrite RList_P23; + replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with + (S (S (Rlength r0 + Rlength l2))); + [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with + (S (Rlength r0 + Rlength l2)); + [ reflexivity + | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ] + | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ]. +Qed. + +Lemma RList_P25 : + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 -> + ordered_Rlist (cons_Rlist l1 l2). +simple induction l1. +intros; simpl in |- *; assumption. +simple induction r0. +intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros; + simpl in H3. +induction i as [| i Hreci]. +simpl in |- *; assumption. +change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n; + replace (S (pred (Rlength l2))) with (Rlength l2); + [ assumption + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H4 in H3; elim (lt_n_O _ H3) ]. +intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)). +apply H0; try assumption. +apply RList_P4 with r; assumption. +unfold ordered_Rlist in |- *; intros; simpl in H4; + induction i as [| i Hreci]. +simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn. +change + (pos_Rl (cons_Rlist (cons r1 r2) l2) i <= + pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; + apply (H i); simpl in |- *; apply lt_S_n; assumption. +Qed. + +Lemma RList_P26 : + forall (l1 l2:Rlist) (i:nat), + (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i. +simple induction l1. +intros; elim (lt_n_O _ H). +intros; induction i as [| i Hreci]. +apply RList_P22; discriminate. +apply (H l2 i); simpl in H0; apply lt_S_n; assumption. +Qed. + +Lemma RList_P27 : + forall l1 l2 l3:Rlist, + cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3. +simple induction l1; intros; + [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ]. +Qed. + +Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l. +simple induction l; + [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. +Qed. + +Lemma RList_P29 : + forall (l2 l1:Rlist) (i:nat), + (Rlength l1 <= i)%nat -> + (i < Rlength (cons_Rlist l1 l2))%nat -> + pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1). +simple induction l2. +intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (le_lt_trans _ _ _ H H0)). +intros; + replace (cons_Rlist l1 (cons r r0)) with + (cons_Rlist (cons_Rlist l1 (cons r nil)) r0). +inversion H0. +rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26. +clear l2 r0 H i H0 H1 H2; induction l1 as [| r0 l1 Hrecl1]. +reflexivity. +simpl in |- *; assumption. +rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn. +replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))). +rewrite H3; simpl in |- *; + replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))). +apply (H (cons_Rlist l1 (cons r nil)) i). +rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3; + apply le_n_S; assumption. +repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1; + rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1)); + simpl in |- *; rewrite plus_comm; apply H1. +rewrite RList_P23; rewrite plus_comm; reflexivity. +change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *; + apply minus_Sn_m; assumption. +replace (cons r r0) with (cons_Rlist (cons r nil) r0); + [ symmetry in |- *; apply RList_P27 | reflexivity ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v index b167b6ef9..37d987855 100644 --- a/theories/Reals/R_Ifp.v +++ b/theories/Reals/R_Ifp.v @@ -13,9 +13,8 @@ (* *) (**********************************************************) -Require Rbase. -Require Omega. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Omega. Open Local Scope R_scope. (*********************************************************) @@ -23,83 +22,81 @@ Open Local Scope R_scope. (*********************************************************) (**********) -Definition Int_part:R->Z:=[r:R](`(up r)-1`). +Definition Int_part (r:R) : Z := (up r - 1)%Z. (**********) -Definition frac_part:R->R:=[r:R](Rminus r (IZR (Int_part r))). +Definition frac_part (r:R) : R := r - IZR (Int_part r). (**********) -Lemma tech_up:(r:R)(z:Z)(Rlt r (IZR z))->(Rle (IZR z) (Rplus r R1))-> - z=(up r). -Intros;Generalize (archimed r);Intro;Elim H1;Intros;Clear H1; - Unfold Rgt in H2;Unfold Rminus in H3; -Generalize (Rle_compatibility r (Rplus (IZR (up r)) - (Ropp r)) R1 H3);Intro;Clear H3; - Rewrite (Rplus_sym (IZR (up r)) (Ropp r)) in H1; - Rewrite <-(Rplus_assoc r (Ropp r) (IZR (up r))) in H1; - Rewrite (Rplus_Ropp_r r) in H1;Elim (Rplus_ne (IZR (up r)));Intros a b; - Rewrite b in H1;Clear a b;Apply (single_z_r_R1 r z (up r));Auto with zarith real. +Lemma tech_up : forall (r:R) (z:Z), r < IZR z -> IZR z <= r + 1 -> z = up r. +intros; generalize (archimed r); intro; elim H1; intros; clear H1; + unfold Rgt in H2; unfold Rminus in H3; + generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); + intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1; + rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1; + rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r))); + intros a b; rewrite b in H1; clear a b; apply (single_z_r_R1 r z (up r)); + auto with zarith real. Qed. (**********) -Lemma up_tech:(r:R)(z:Z)(Rle (IZR z) r)->(Rlt r (IZR `z+1`))-> - `z+1`=(up r). -Intros;Generalize (Rle_compatibility R1 (IZR z) r H);Intro;Clear H; - Rewrite (Rplus_sym R1 (IZR z)) in H1;Rewrite (Rplus_sym R1 r) in H1; - Cut (R1==(IZR `1`));Auto with zarith real. -Intro;Generalize H1;Pattern 1 R1;Rewrite H;Intro;Clear H H1; - Rewrite <-(plus_IZR z `1`) in H2;Apply (tech_up r `z+1`);Auto with zarith real. +Lemma up_tech : + forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r. +intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H; + rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1; + cut (1 = IZR 1); auto with zarith real. +intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1; + rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1)); + auto with zarith real. Qed. (**********) -Lemma fp_R0:(frac_part R0)==R0. -Unfold frac_part; Unfold Int_part; Elim (archimed R0); - Intros; Unfold Rminus; - Elim (Rplus_ne (Ropp (IZR `(up R0)-1`))); Intros a b; - Rewrite b;Clear a b;Rewrite <- Z_R_minus;Cut (up R0)=`1`. -Intro;Rewrite H1; - Rewrite (eq_Rminus (IZR `1`) (IZR `1`) (refl_eqT R (IZR `1`))); - Apply Ropp_O. -Elim (archimed R0);Intros;Clear H2;Unfold Rgt in H1; - Rewrite (minus_R0 (IZR (up R0))) in H0; - Generalize (lt_O_IZR (up R0) H1);Intro;Clear H1; - Generalize (le_IZR_R1 (up R0) H0);Intro;Clear H H0;Omega. +Lemma fp_R0 : frac_part 0 = 0. +unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros; + unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); + intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; + cut (up 0 = 1%Z). +intro; rewrite H1; + rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); + apply Ropp_0. +elim (archimed 0); intros; clear H2; unfold Rgt in H1; + rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1); + intro; clear H1; generalize (le_IZR_R1 (up 0) H0); + intro; clear H H0; omega. Qed. (**********) -Lemma for_base_fp:(r:R)(Rgt (Rminus (IZR (up r)) r) R0)/\ - (Rle (Rminus (IZR (up r)) r) R1). -Intro; Split; - Cut (Rgt (IZR (up r)) r)/\(Rle (Rminus (IZR (up r)) r) R1). -Intro; Elim H; Intros. -Apply (Rgt_minus (IZR (up r)) r H0). -Apply archimed. -Intro; Elim H; Intros. -Exact H1. -Apply archimed. +Lemma for_base_fp : forall r:R, IZR (up r) - r > 0 /\ IZR (up r) - r <= 1. +intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1). +intro; elim H; intros. +apply (Rgt_minus (IZR (up r)) r H0). +apply archimed. +intro; elim H; intros. +exact H1. +apply archimed. Qed. (**********) -Lemma base_fp:(r:R)(Rge (frac_part r) R0)/\(Rlt (frac_part r) R1). -Intro; Unfold frac_part; Unfold Int_part; Split. +Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1. +intro; unfold frac_part in |- *; unfold Int_part in |- *; split. (*sup a O*) -Cut (Rge (Rminus r (IZR (up r))) (Ropp R1)). -Rewrite <- Z_R_minus;Simpl;Intro; Unfold Rminus; - Rewrite Ropp_distr1;Rewrite <-Rplus_assoc; - Fold (Rminus r (IZR (up r))); - Fold (Rminus (Rminus r (IZR (up r))) (Ropp R1)); - Apply Rge_minus;Auto with zarith real. -Rewrite <- Ropp_distr2;Apply Rle_Ropp;Elim (for_base_fp r); Auto with zarith real. +cut (r - IZR (up r) >= -1). +rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *; + apply Rge_minus; auto with zarith real. +rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r); + auto with zarith real. (*inf a 1*) -Cut (Rlt (Rminus r (IZR (up r))) R0). -Rewrite <- Z_R_minus; Simpl;Intro; Unfold Rminus; - Rewrite Ropp_distr1;Rewrite <-Rplus_assoc; - Fold (Rminus r (IZR (up r)));Rewrite Ropp_Ropp; - Elim (Rplus_ne R1);Intros a b;Pattern 2 R1;Rewrite <-a;Clear a b; - Rewrite (Rplus_sym (Rminus r (IZR (up r))) R1); - Apply Rlt_compatibility;Auto with zarith real. -Elim (for_base_fp r);Intros;Rewrite <-Ropp_O; - Rewrite<-Ropp_distr2;Apply Rgt_Ropp;Auto with zarith real. +cut (r - IZR (up r) < 0). +rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; + elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; + rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1); + apply Rplus_lt_compat_l; auto with zarith real. +elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr; + apply Ropp_gt_lt_contravar; auto with zarith real. Qed. (*********************************************************) @@ -107,446 +104,442 @@ Qed. (*********************************************************) (**********) -Lemma base_Int_part:(r:R)(Rle (IZR (Int_part r)) r)/\ - (Rgt (Rminus (IZR (Int_part r)) r) (Ropp R1)). -Intro;Unfold Int_part;Elim (archimed r);Intros. -Split;Rewrite <- (Z_R_minus (up r) `1`);Simpl. -Generalize (Rle_minus (Rminus (IZR (up r)) r) R1 H0);Intro; - Unfold Rminus in H1; - Rewrite (Rplus_assoc (IZR (up r)) (Ropp r) (Ropp R1)) in - H1;Rewrite (Rplus_sym (Ropp r) (Ropp R1)) in H1; - Rewrite <-(Rplus_assoc (IZR (up r)) (Ropp R1) (Ropp r)) in - H1;Fold (Rminus (IZR (up r)) R1) in H1; - Fold (Rminus (Rminus (IZR (up r)) R1) r) in H1; - Apply Rminus_le;Auto with zarith real. -Generalize (Rgt_plus_plus_r (Ropp R1) (IZR (up r)) r H);Intro; - Rewrite (Rplus_sym (Ropp R1) (IZR (up r))) in H1; - Generalize (Rgt_plus_plus_r (Ropp r) - (Rplus (IZR (up r)) (Ropp R1)) (Rplus (Ropp R1) r) H1); - Intro;Clear H H0 H1; - Rewrite (Rplus_sym (Ropp r) (Rplus (IZR (up r)) (Ropp R1))) - in H2;Fold (Rminus (IZR (up r)) R1) in H2; - Fold (Rminus (Rminus (IZR (up r)) R1) r) in H2; - Rewrite (Rplus_sym (Ropp r) (Rplus (Ropp R1) r)) in H2; - Rewrite (Rplus_assoc (Ropp R1) r (Ropp r)) in H2; - Rewrite (Rplus_Ropp_r r) in H2;Elim (Rplus_ne (Ropp R1));Intros a b; - Rewrite a in H2;Clear a b;Auto with zarith real. +Lemma base_Int_part : + forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. +intro; unfold Int_part in |- *; elim (archimed r); intros. +split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *. +generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1; + rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1; + rewrite (Rplus_comm (- r) (-1)) in H1; + rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1; + fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1; + apply Rminus_le; auto with zarith real. +generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro; + rewrite (Rplus_comm (-1) (IZR (up r))) in H1; + generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); + intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2; + fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2; + rewrite (Rplus_comm (- r) (-1 + r)) in H2; + rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2; + elim (Rplus_ne (-1)); intros a b; rewrite a in H2; + clear a b; auto with zarith real. Qed. (**********) -Lemma Int_part_INR:(n : nat) (Int_part (INR n)) = (inject_nat n). -Intros n; Unfold Int_part. -Cut (up (INR n)) = (Zplus (inject_nat n) (inject_nat (1))). -Intros H'; Rewrite H'; Simpl; Ring. -Apply sym_equal; Apply tech_up; Auto. -Replace (Zplus (inject_nat n) (inject_nat (1))) with (INZ (S n)). -Repeat Rewrite <- INR_IZR_INZ. -Apply lt_INR; Auto. -Rewrite Zplus_sym; Rewrite <- inj_plus; Simpl; Auto. -Rewrite plus_IZR; Simpl; Auto with real. -Repeat Rewrite <- INR_IZR_INZ; Auto with real. +Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z_of_nat n. +intros n; unfold Int_part in |- *. +cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z). +intros H'; rewrite H'; simpl in |- *; ring. +apply sym_equal; apply tech_up; auto. +replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)). +repeat rewrite <- INR_IZR_INZ. +apply lt_INR; auto. +rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto. +rewrite plus_IZR; simpl in |- *; auto with real. +repeat rewrite <- INR_IZR_INZ; auto with real. Qed. (**********) -Lemma fp_nat:(r:R)(frac_part r)==R0->(Ex [c:Z](r==(IZR c))). -Unfold frac_part;Intros;Split with (Int_part r);Apply Rminus_eq; Auto with zarith real. +Lemma fp_nat : forall r:R, frac_part r = 0 -> exists c : Z | r = IZR c. +unfold frac_part in |- *; intros; split with (Int_part r); + apply Rminus_diag_uniq; auto with zarith real. Qed. (**********) -Lemma R0_fp_O:(r:R)~R0==(frac_part r)->~R0==r. -Red;Intros;Rewrite <- H0 in H;Generalize fp_R0;Intro;Auto with zarith real. +Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r. +red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro; + auto with zarith real. Qed. (**********) -Lemma Rminus_Int_part1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))-> - (Int_part (Rminus r1 r2))=(Zminus (Int_part r1) (Int_part r2)). -Intros;Elim (base_fp r1);Elim (base_fp r2);Intros; - Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0; - Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4; - Rewrite (Ropp_O) in H0; - Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0; - Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2; - Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1; - Unfold Rgt in H2; - Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1) - (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros; - Clear H1;Elim (Rplus_ne R1);Intros a b;Rewrite a in H6;Clear a b H5; - Generalize (Rge_minus (frac_part r1) (frac_part r2) H);Intro;Clear H; - Fold (Rminus (frac_part r1) (frac_part r2)) in H6; - Generalize (Rle_sym2 R0 (Rminus (frac_part r1) (frac_part r2)) H1); - Intro;Clear H1 H3 H4 H0 H2;Unfold frac_part in H6 H; - Unfold Rminus in H6 H; - Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H; - Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus (Ropp r2) (IZR (Int_part r2)))) in H; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2) - (IZR (Int_part r2))) in H; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H; - Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1))) - (IZR (Int_part r2))) in H; - Rewrite <-(Rplus_assoc r1 (Ropp r2) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H; - Fold (Rminus r1 r2) in H;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) - in H;Generalize (Rle_compatibility - (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R0 - (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H);Intro; - Clear H;Rewrite (Rplus_sym (Rminus r1 r2) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0; - Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0; - Unfold Rminus in H0;Fold (Rminus r1 r2) in H0; - Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))) - (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H0; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2)) - (Ropp (IZR (Int_part r1)))) in H0;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in - H0;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H0; - Clear a b; - Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))))); - Intros a b;Rewrite a in H0;Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) - in H0;Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0; - Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; - Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H6; - Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H6; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus (Ropp r2) (IZR (Int_part r2)))) in H6; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2) - (IZR (Int_part r2))) in H6; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H6; - Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1))) - (IZR (Int_part r2))) in H6; - Rewrite <-(Rplus_assoc r1 (Ropp r2) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H6; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H6; - Fold (Rminus r1 r2) in H6;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) - in H6;Generalize (Rlt_compatibility - (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R1 H6); - Intro;Clear H6; - Rewrite (Rplus_sym (Rminus r1 r2) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H; - Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H; - Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H; - Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H; - Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;Clear a b; - Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; - Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; - Cut R1==(IZR `1`);Auto with zarith real. -Intro;Rewrite H1 in H;Clear H1; - Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)` `1`) in H; - Generalize (up_tech (Rminus r1 r2) `(Int_part r1)-(Int_part r2)` - H0 H);Intros;Clear H H0;Unfold 1 Int_part;Omega. +Lemma Rminus_Int_part1 : + forall r1 r2:R, + frac_part r1 >= frac_part r2 -> + Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z. +intros; elim (base_fp r1); elim (base_fp r2); intros; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + intro; clear H4; rewrite Ropp_0 in H0; + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); + intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); + intro; clear H1; unfold Rgt in H2; + generalize + (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); + intro; elim H1; intros; clear H1; elim (Rplus_ne 1); + intros a b; rewrite a in H6; clear a b H5; + generalize (Rge_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H6; + generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); + intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H; + unfold Rminus in H6, H; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; + fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0 + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); + intro; clear H; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H0; unfold Rminus in H0; fold (r1 - r2) in H0; + rewrite + (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) + (IZR (Int_part r2) + - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) + (- IZR (Int_part r1))) in H0; + rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + rewrite b in H0; clear a b; + elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); + intros a b; rewrite a in H0; clear a b; + rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2)); + intros a b; rewrite b in H0; clear a b; + fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H6; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H6; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H6; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; + fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); + intro; clear H6; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H; + rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; + rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + cut (1 = IZR 1); auto with zarith real. +intro; rewrite H1 in H; clear H1; + rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H); + intros; clear H H0; unfold Int_part at 1 in |- *; + omega. Qed. (**********) -Lemma Rminus_Int_part2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))-> - (Int_part (Rminus r1 r2))=(Zminus (Zminus (Int_part r1) (Int_part r2)) `1`). -Intros;Elim (base_fp r1);Elim (base_fp r2);Intros; - Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0; - Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4; - Rewrite (Ropp_O) in H0; - Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0; - Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2; - Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1; - Unfold Rgt in H2; - Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1) - (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros; - Clear H1;Elim (Rplus_ne (Ropp R1));Intros a b;Rewrite b in H5; - Clear a b H6;Generalize (Rlt_minus (frac_part r1) (frac_part r2) H); - Intro;Clear H;Fold (Rminus (frac_part r1) (frac_part r2)) in H5; - Clear H3 H4 H0 H2;Unfold frac_part in H5 H1; - Unfold Rminus in H5 H1; - Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H5; - Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H5; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus (Ropp r2) (IZR (Int_part r2)))) in H5; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2) - (IZR (Int_part r2))) in H5; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H5; - Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1))) - (IZR (Int_part r2))) in H5; - Rewrite <-(Rplus_assoc r1 (Ropp r2) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H5; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H5; - Fold (Rminus r1 r2) in H5;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) - in H5;Generalize (Rlt_compatibility - (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) (Ropp R1) - (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H5); - Intro;Clear H5;Rewrite (Rplus_sym (Rminus r1 r2) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H; - Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H; - Unfold Rminus in H;Fold (Rminus r1 r2) in H; - Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))) - (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2)) - (Ropp (IZR (Int_part r1)))) in H;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in - H;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H; - Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) in H; - Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H; - Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H; - Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H; - Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H1; - Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H1; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus (Ropp r2) (IZR (Int_part r2)))) in H1; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2) - (IZR (Int_part r2))) in H1; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H1; - Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1))) - (IZR (Int_part r2))) in H1; - Rewrite <-(Rplus_assoc r1 (Ropp r2) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H1; - Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H1; - Fold (Rminus r1 r2) in H1;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) - in H1;Generalize (Rlt_compatibility - (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R0 H1); - Intro;Clear H1; - Rewrite (Rplus_sym (Rminus r1 r2) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0; - Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0; - Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; - Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0; - Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;Clear a b; - Rewrite <-(Rplus_Ropp_l R1) in H0; - Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Ropp R1) R1) in H0; - Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H0; - Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; - Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; - Cut R1==(IZR `1`);Auto with zarith real. -Intro;Rewrite H1 in H;Rewrite H1 in H0;Clear H1; - Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H; - Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H0; - Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)-1` `1`) in H0; - Generalize (Rlt_le (IZR `(Int_part r1)-(Int_part r2)-1`) (Rminus r1 r2) H); - Intro;Clear H; - Generalize (up_tech (Rminus r1 r2) `(Int_part r1)-(Int_part r2)-1` - H1 H0);Intros;Clear H0 H1;Unfold 1 Int_part;Omega. +Lemma Rminus_Int_part2 : + forall r1 r2:R, + frac_part r1 < frac_part r2 -> + Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z. +intros; elim (base_fp r1); elim (base_fp r2); intros; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + intro; clear H4; rewrite Ropp_0 in H0; + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); + intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); + intro; clear H1; unfold Rgt in H2; + generalize + (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); + intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); + intros a b; rewrite b in H5; clear a b H6; + generalize (Rlt_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H5; + clear H3 H4 H0 H2; unfold frac_part in H5, H1; unfold Rminus in H5, H1; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H5; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H5; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H5; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H5; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; + fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); + intro; clear H5; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H; unfold Rminus in H; fold (r1 - r2) in H; + rewrite + (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) + (IZR (Int_part r2) + - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) + (- IZR (Int_part r1))) in H; + rewrite (Rplus_opp_l (IZR (Int_part r2))) in H; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H; + fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); + intro; clear H1; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H0; + rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; + rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; + clear a b; rewrite <- (Rplus_opp_l 1) in H0; + rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1) + in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + cut (1 = IZR 1); auto with zarith real. +intro; rewrite H1 in H; rewrite H1 in H0; clear H1; + rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H; + rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0; + rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0; + generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H); + intro; clear H; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); + intros; clear H0 H1; unfold Int_part at 1 in |- *; + omega. Qed. (**********) -Lemma Rminus_fp1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))-> - (frac_part (Rminus r1 r2))==(Rminus (frac_part r1) (frac_part r2)). -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; - Rewrite -> (Ropp_distr1 (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))); - Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))); - Rewrite -> (Ropp_Ropp (IZR (Int_part r2))); - Rewrite -> (Rplus_assoc r1 (Ropp r2) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))); - Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus (Ropp r2) (IZR (Int_part r2)))); - Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1))) - (IZR (Int_part r2))); - Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2) - (IZR (Int_part r2))); - Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real. +Lemma Rminus_fp1 : + forall r1 r2:R, + frac_part r1 >= frac_part r2 -> + frac_part (r1 - r2) = frac_part r1 - frac_part r2. +intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H); + intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + unfold Rminus in |- *; + rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2))); + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); + rewrite (Ropp_involutive (IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + auto with zarith real. Qed. (**********) -Lemma Rminus_fp2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))-> - (frac_part (Rminus r1 r2))== - (Rplus (Rminus (frac_part r1) (frac_part r2)) R1). -Intros;Unfold frac_part;Generalize (Rminus_Int_part2 r1 r2 H);Intro; - Rewrite -> H0; - Rewrite <- (Z_R_minus (Zminus (Int_part r1) (Int_part r2)) `1`); - Rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));Unfold Rminus; - Rewrite -> (Ropp_distr1 (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))) - (Ropp (IZR `1`))); - Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))); - Rewrite -> (Ropp_Ropp (IZR `1`)); - Rewrite -> (Ropp_Ropp (IZR (Int_part r2))); - Rewrite -> (Ropp_distr1 (IZR (Int_part r1))); - Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));Simpl; - Rewrite <- (Rplus_assoc (Rplus r1 (Ropp r2)) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) R1); - Rewrite -> (Rplus_assoc r1 (Ropp r2) - (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))); - Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus (Ropp r2) (IZR (Int_part r2)))); - Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1))) - (IZR (Int_part r2))); - Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2) - (IZR (Int_part r2))); - Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real. +Lemma Rminus_fp2 : + forall r1 r2:R, + frac_part r1 < frac_part r2 -> + frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1. +intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H); + intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1); + rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + unfold Rminus in |- *; + rewrite + (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1)) + ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); + rewrite (Ropp_involutive (IZR 1)); + rewrite (Ropp_involutive (IZR (Int_part r2))); + rewrite (Ropp_plus_distr (IZR (Int_part r1))); + rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *; + rewrite <- + (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1) + ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + auto with zarith real. Qed. (**********) -Lemma plus_Int_part1:(r1,r2:R)(Rge (Rplus (frac_part r1) (frac_part r2)) R1)-> - (Int_part (Rplus r1 r2))=(Zplus (Zplus (Int_part r1) (Int_part r2)) `1`). -Intros; - Generalize (Rle_sym2 R1 (Rplus (frac_part r1) (frac_part r2)) H); - Intro;Clear H;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H H2; - Generalize (Rlt_compatibility (frac_part r2) (frac_part r1) R1 H3); - Intro;Clear H3; - Generalize (Rlt_compatibility R1 (frac_part r2) R1 H1);Intro;Clear H1; - Rewrite (Rplus_sym R1 (frac_part r2)) in H2; - Generalize (Rlt_trans (Rplus (frac_part r2) (frac_part r1)) - (Rplus (frac_part r2) R1) (Rplus R1 R1) H H2);Intro;Clear H H2; - Rewrite (Rplus_sym (frac_part r2) (frac_part r1)) in H1; - Unfold frac_part in H0 H1;Unfold Rminus in H0 H1; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1; - Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))) - r2) in H1; - Rewrite (Rplus_sym - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1; - Rewrite <-(Rplus_assoc r1 r2 - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1; - Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus r2 (Ropp (IZR (Int_part r2))))) in H0; - Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H0; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))) - r2) in H0; - Rewrite (Rplus_sym - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H0; - Rewrite <-(Rplus_assoc r1 r2 - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H0; - Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; - Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - R1 (Rplus (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H0);Intro; - Clear H0; - Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rplus (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) (Rplus R1 R1) H1); - Intro;Clear H1; - Rewrite (Rplus_sym (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H; - Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H; - Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H; - Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H;Clear a b; - Rewrite (Rplus_sym (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0; - Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0; - Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0; - Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H0;Clear a b; - Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1 R1) in - H0;Cut R1==(IZR `1`);Auto with zarith real. -Intro;Rewrite H1 in H0;Rewrite H1 in H;Clear H1; - Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H; - Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0; - Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H; - Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H0; - Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)+1` `1`) in H0; - Generalize (up_tech (Rplus r1 r2) `(Int_part r1)+(Int_part r2)+1` H H0);Intro; - Clear H H0;Unfold 1 Int_part;Omega. +Lemma plus_Int_part1 : + forall r1 r2:R, + frac_part r1 + frac_part r2 >= 1 -> + Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z. +intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H; + elim (base_fp r1); elim (base_fp r2); intros; clear H H2; + generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); + intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); + intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2; + generalize + (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); + intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1; + unfold frac_part in H0, H1; unfold Rminus in H0, H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H1; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H0; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H0; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1 + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); + intro; clear H0; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); + intro; clear H1; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; + clear a b; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; + clear a b; + rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0; + cut (1 = IZR 1); auto with zarith real. +intro; rewrite H1 in H0; rewrite H1 in H; clear H1; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); + intro; clear H H0; unfold Int_part at 1 in |- *; omega. Qed. (**********) -Lemma plus_Int_part2:(r1,r2:R)(Rlt (Rplus (frac_part r1) (frac_part r2)) R1)-> - (Int_part (Rplus r1 r2))=(Zplus (Int_part r1) (Int_part r2)). -Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H1 H3; - Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0; - Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2; - Generalize (Rle_compatibility (frac_part r1) R0 (frac_part r2) H1); - Intro;Clear H1;Elim (Rplus_ne (frac_part r1));Intros a b; - Rewrite a in H2;Clear a b;Generalize (Rle_trans R0 (frac_part r1) - (Rplus (frac_part r1) (frac_part r2)) H0 H2);Intro;Clear H0 H2; - Unfold frac_part in H H1;Unfold Rminus in H H1; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1; - Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))) - r2) in H1; - Rewrite (Rplus_sym - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1; - Rewrite <-(Rplus_assoc r1 r2 - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1; - Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus r2 (Ropp (IZR (Int_part r2))))) in H; - Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H; - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))) - r2) in H; - Rewrite (Rplus_sym - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H; - Rewrite <-(Rplus_assoc r1 r2 - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H; - Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H; - Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - R0 (Rplus (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H1);Intro; - Clear H1; - Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Rplus (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) R1 H); - Intro;Clear H; - Rewrite (Rplus_sym (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H1; - Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H1; - Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H1; - Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H1;Clear a b; - Rewrite (Rplus_sym (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0; - Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0; - Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0; - Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))));Intros a b; - Rewrite a in H0;Clear a b;Elim (Rplus_ne (Rplus r1 r2));Intros a b; - Rewrite b in H0;Clear a b;Cut R1==(IZR `1`);Auto with zarith real. -Intro;Rewrite H in H1;Clear H; - Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0; - Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H1; - Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H1; - Generalize (up_tech (Rplus r1 r2) `(Int_part r1)+(Int_part r2)` H0 H1);Intro; - Clear H0 H1;Unfold 1 Int_part;Omega. +Lemma plus_Int_part2 : + forall r1 r2:R, + frac_part r1 + frac_part r2 < 1 -> + Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z. +intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; + generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); + intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; + rewrite a in H2; clear a b; + generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2); + intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H1; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0 + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); + intro; clear H1; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); + intro; clear H; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H1; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; + clear a b; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; + elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); + intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2)); + intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1); + auto with zarith real. +intro; rewrite H in H1; clear H; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); + intro; clear H0 H1; unfold Int_part at 1 in |- *; + omega. Qed. (**********) -Lemma plus_frac_part1:(r1,r2:R) - (Rge (Rplus (frac_part r1) (frac_part r2)) R1)-> - (frac_part (Rplus r1 r2))== - (Rminus (Rplus (frac_part r1) (frac_part r2)) R1). -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;Unfold 3 4 Rminus; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus r2 (Ropp (IZR (Int_part r2))))); - Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))); - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))) - r2); - Rewrite (Rplus_sym - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2); - Rewrite <-(Rplus_assoc r1 r2 - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))); - Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))); - Unfold Rminus; - Rewrite (Rplus_assoc (Rplus r1 r2) - (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) - (Ropp R1)); - Rewrite <-(Ropp_distr1 (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1); - Trivial with zarith real. +Lemma plus_frac_part1 : + forall r1 r2:R, + frac_part r1 + frac_part r2 >= 1 -> + frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1. +intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro; + rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1); + rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *; + unfold Rminus at 3 4 in |- *; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); + rewrite (Rplus_comm r2 (- IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); + unfold Rminus in |- *; + rewrite + (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1)) + ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1); + trivial with zarith real. Qed. (**********) -Lemma plus_frac_part2:(r1,r2:R) - (Rlt (Rplus (frac_part r1) (frac_part r2)) R1)-> -(frac_part (Rplus r1 r2))==(Rplus (frac_part r1) (frac_part r2)). -Intros;Unfold frac_part; - Generalize (plus_Int_part2 r1 r2 H);Intro;Rewrite H0; - Rewrite (plus_IZR (Int_part r1) (Int_part r2));Unfold 2 3 Rminus; - Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) - (Rplus r2 (Ropp (IZR (Int_part r2))))); - Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))); - Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))) - r2); - Rewrite (Rplus_sym - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2); - Rewrite <-(Rplus_assoc r1 r2 - (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))); - Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));Unfold Rminus; - Trivial with zarith real. -Qed. +Lemma plus_frac_part2 : + forall r1 r2:R, + frac_part r1 + frac_part r2 < 1 -> + frac_part (r1 + r2) = frac_part r1 + frac_part r2. +intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro; + rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2)); + unfold Rminus at 2 3 in |- *; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); + rewrite (Rplus_comm r2 (- IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); + unfold Rminus in |- *; trivial with zarith real. +Qed.
\ No newline at end of file diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v index 0610db3be..1abe6d925 100644 --- a/theories/Reals/R_sqr.v +++ b/theories/Reals/R_sqr.v @@ -8,225 +8,323 @@ (*i $Id$ i*) -Require Rbase. -Require Rbasic_fun. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rbasic_fun. Open Local Scope R_scope. (****************************************************) (* Rsqr : some results *) (****************************************************) -Tactic Definition SqRing := Unfold Rsqr; Ring. +Ltac ring_Rsqr := unfold Rsqr in |- *; ring. -Lemma Rsqr_neg : (x:R) ``(Rsqr x)==(Rsqr (-x))``. -Intros; SqRing. +Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x). +intros; ring_Rsqr. Qed. -Lemma Rsqr_times : (x,y:R) ``(Rsqr (x*y))==(Rsqr x)*(Rsqr y)``. -Intros; SqRing. +Lemma Rsqr_mult : forall x y:R, Rsqr (x * y) = Rsqr x * Rsqr y. +intros; ring_Rsqr. Qed. -Lemma Rsqr_plus : (x,y:R) ``(Rsqr (x+y))==(Rsqr x)+(Rsqr y)+2*x*y``. -Intros; SqRing. +Lemma Rsqr_plus : forall x y:R, Rsqr (x + y) = Rsqr x + Rsqr y + 2 * x * y. +intros; ring_Rsqr. Qed. -Lemma Rsqr_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr x)+(Rsqr y)-2*x*y``. -Intros; SqRing. +Lemma Rsqr_minus : forall x y:R, Rsqr (x - y) = Rsqr x + Rsqr y - 2 * x * y. +intros; ring_Rsqr. Qed. -Lemma Rsqr_neg_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr (y-x))``. -Intros; SqRing. +Lemma Rsqr_neg_minus : forall x y:R, Rsqr (x - y) = Rsqr (y - x). +intros; ring_Rsqr. Qed. -Lemma Rsqr_1 : ``(Rsqr 1)==1``. -SqRing. +Lemma Rsqr_1 : Rsqr 1 = 1. +ring_Rsqr. Qed. -Lemma Rsqr_gt_0_0 : (x:R) ``0<(Rsqr x)`` -> ~``x==0``. -Intros; Red; Intro; Rewrite H0 in H; Rewrite Rsqr_O in H; Elim (Rlt_antirefl ``0`` H). +Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0. +intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H; + elim (Rlt_irrefl 0 H). Qed. -Lemma Rsqr_pos_lt : (x:R) ~(x==R0)->``0<(Rsqr x)``. -Intros; Case (total_order R0 x); Intro; [Unfold Rsqr; Apply Rmult_lt_pos; Assumption | Elim H0; Intro; [Elim H; Symmetry; Exact H1 | Rewrite Rsqr_neg; Generalize (Rlt_Ropp x ``0`` H1); Rewrite Ropp_O; Intro; Unfold Rsqr; Apply Rmult_lt_pos; Assumption]]. +Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x. +intros; case (Rtotal_order 0 x); intro; + [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption + | elim H0; intro; + [ elim H; symmetry in |- *; exact H1 + | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); + rewrite Ropp_0; intro; unfold Rsqr in |- *; + apply Rmult_lt_0_compat; assumption ] ]. Qed. -Lemma Rsqr_div : (x,y:R) ~``y==0`` -> ``(Rsqr (x/y))==(Rsqr x)/(Rsqr y)``. -Intros; Unfold Rsqr. -Unfold Rdiv. -Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc. -Apply Rmult_mult_r. -Pattern 2 x; Rewrite Rmult_sym. -Repeat Rewrite Rmult_assoc. -Apply Rmult_mult_r. -Reflexivity. -Assumption. -Assumption. +Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y. +intros; unfold Rsqr in |- *. +unfold Rdiv in |- *. +rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +apply Rmult_eq_compat_l. +pattern x at 2 in |- *; rewrite Rmult_comm. +repeat rewrite Rmult_assoc. +apply Rmult_eq_compat_l. +reflexivity. +assumption. +assumption. Qed. -Lemma Rsqr_eq_0 : (x:R) ``(Rsqr x)==0`` -> ``x==0``. -Unfold Rsqr; Intros; Generalize (without_div_Od x x H); Intro; Elim H0; Intro ; Assumption. +Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0. +unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro; + elim H0; intro; assumption. Qed. -Lemma Rsqr_minus_plus : (a,b:R) ``(a-b)*(a+b)==(Rsqr a)-(Rsqr b)``. -Intros; SqRing. +Lemma Rsqr_minus_plus : forall a b:R, (a - b) * (a + b) = Rsqr a - Rsqr b. +intros; ring_Rsqr. Qed. -Lemma Rsqr_plus_minus : (a,b:R) ``(a+b)*(a-b)==(Rsqr a)-(Rsqr b)``. -Intros; SqRing. +Lemma Rsqr_plus_minus : forall a b:R, (a + b) * (a - b) = Rsqr a - Rsqr b. +intros; ring_Rsqr. Qed. -Lemma Rsqr_incr_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=x`` -> ``0<=y`` -> ``x<=y``. -Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H1 H1 H2 H2); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H3); Intro; Elim (Rlt_antirefl ``x*x`` H4) | Auto with real]]. +Lemma Rsqr_incr_0 : + forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y. +intros; case (Rle_dec x y); intro; + [ assumption + | cut (y < x); + [ intro; unfold Rsqr in H; + generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); + intro; elim (Rlt_irrefl (x * x) H4) + | auto with real ] ]. Qed. -Lemma Rsqr_incr_0_var : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=y`` -> ``x<=y``. -Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H0 H0 H1 H1); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H2); Intro; Elim (Rlt_antirefl ``x*x`` H3) | Auto with real]]. +Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y. +intros; case (Rle_dec x y); intro; + [ assumption + | cut (y < x); + [ intro; unfold Rsqr in H; + generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); + intro; elim (Rlt_irrefl (x * x) H3) + | auto with real ] ]. Qed. -Lemma Rsqr_incr_1 : (x,y:R) ``x<=y``->``0<=x``->``0<= y``->``(Rsqr x)<=(Rsqr y)``. -Intros; Unfold Rsqr; Apply Rle_Rmult_comp; Assumption. +Lemma Rsqr_incr_1 : + forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y. +intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption. Qed. -Lemma Rsqr_incrst_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)``->``0<=x``->``0<=y``-> ``x<y``. -Intros; Case (total_order x y); Intro; [Assumption | Elim H2; Intro; [Rewrite H3 in H; Elim (Rlt_antirefl (Rsqr y) H) | Generalize (Rmult_lt2 y x y x H1 H1 H3 H3); Intro; Unfold Rsqr in H; Generalize (Rlt_trans ``x*x`` ``y*y`` ``x*x`` H H4); Intro; Elim (Rlt_antirefl ``x*x`` H5)]]. +Lemma Rsqr_incrst_0 : + forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y. +intros; case (Rtotal_order x y); intro; + [ assumption + | elim H2; intro; + [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H) + | generalize (Rmult_le_0_lt_compat y x y x H1 H1 H3 H3); intro; + unfold Rsqr in H; generalize (Rlt_trans (x * x) (y * y) (x * x) H H4); + intro; elim (Rlt_irrefl (x * x) H5) ] ]. Qed. -Lemma Rsqr_incrst_1 : (x,y:R) ``x<y``->``0<=x``->``0<=y``->``(Rsqr x)<(Rsqr y)``. -Intros; Unfold Rsqr; Apply Rmult_lt2; Assumption. +Lemma Rsqr_incrst_1 : + forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y. +intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption. Qed. -Lemma Rsqr_neg_pos_le_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)``->``0<=y``->``-y<=x``. -Intros; Case (case_Rabsolu x); Intro. -Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Rewrite (Rsqr_neg x) in H; Generalize (Rsqr_incr_0 (Ropp x) y H H2 H0); Intro; Rewrite <- (Ropp_Ropp x); Apply Rge_Ropp; Apply Rle_sym1; Assumption. -Apply Rle_trans with ``0``; [Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption | Apply Rle_sym2; Assumption]. -Qed. - -Lemma Rsqr_neg_pos_le_1 : (x,y:R) ``(-y)<=x`` -> ``x<=y`` -> ``0<=y`` -> ``(Rsqr x)<=(Rsqr y)``. -Intros; Case (case_Rabsolu x); Intro. -Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H2); Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H4); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption. -Generalize (Rle_sym2 ``0`` x r); Intro; Apply Rsqr_incr_1; Assumption. -Qed. - -Lemma neg_pos_Rsqr_le : (x,y:R) ``(-y)<=x``->``x<=y``->``(Rsqr x)<=(Rsqr y)``. -Intros; Case (case_Rabsolu x); Intro. -Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H2); Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Generalize (Rle_trans ``0`` ``-x`` y H4 H3); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption. -Generalize (Rle_sym2 ``0`` x r); Intro; Generalize (Rle_trans ``0`` x y H1 H0); Intro; Apply Rsqr_incr_1; Assumption. -Qed. - -Lemma Rsqr_abs : (x:R) ``(Rsqr x)==(Rsqr (Rabsolu x))``. -Intro; Unfold Rabsolu; Case (case_Rabsolu x); Intro; [Apply Rsqr_neg | Reflexivity]. -Qed. - -Lemma Rsqr_le_abs_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``(Rabsolu x)<=(Rabsolu y)``. -Intros; Apply Rsqr_incr_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos]. -Qed. - -Lemma Rsqr_le_abs_1 : (x,y:R) ``(Rabsolu x)<=(Rabsolu y)`` -> ``(Rsqr x)<=(Rsqr y)``. -Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incr_1 (Rabsolu x) (Rabsolu y) H (Rabsolu_pos x) (Rabsolu_pos y)). -Qed. - -Lemma Rsqr_lt_abs_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)`` -> ``(Rabsolu x)<(Rabsolu y)``. -Intros; Apply Rsqr_incrst_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos]. -Qed. - -Lemma Rsqr_lt_abs_1 : (x,y:R) ``(Rabsolu x)<(Rabsolu y)`` -> ``(Rsqr x)<(Rsqr y)``. -Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incrst_1 (Rabsolu x) (Rabsolu y) H (Rabsolu_pos x) (Rabsolu_pos y)). -Qed. - -Lemma Rsqr_inj : (x,y:R) ``0<=x`` -> ``0<=y`` -> (Rsqr x)==(Rsqr y) -> x==y. -Intros; Generalize (Rle_le_eq (Rsqr x) (Rsqr y)); Intro; Elim H2; Intros _ H3; Generalize (H3 H1); Intro; Elim H4; Intros; Apply Rle_antisym; Apply Rsqr_incr_0; Assumption. -Qed. - -Lemma Rsqr_eq_abs_0 : (x,y:R) (Rsqr x)==(Rsqr y) -> (Rabsolu x)==(Rabsolu y). -Intros; Unfold Rabsolu; Case (case_Rabsolu x); Case (case_Rabsolu y); Intros. -Rewrite -> (Rsqr_neg x) in H; Rewrite -> (Rsqr_neg y) in H; Generalize (Rlt_Ropp y ``0`` r); Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intros; Generalize (Rlt_le ``0`` ``-x`` H0); Generalize (Rlt_le ``0`` ``-y`` H1); Intros; Apply Rsqr_inj; Assumption. -Rewrite -> (Rsqr_neg x) in H; Generalize (Rle_sym2 ``0`` y r); Intro; Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Apply Rsqr_inj; Assumption. -Rewrite -> (Rsqr_neg y) in H; Generalize (Rle_sym2 ``0`` x r0); Intro; Generalize (Rlt_Ropp y ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-y`` H1); Intro; Apply Rsqr_inj; Assumption. -Generalize (Rle_sym2 ``0`` x r0); Generalize (Rle_sym2 ``0`` y r); Intros; Apply Rsqr_inj; Assumption. -Qed. - -Lemma Rsqr_eq_asb_1 : (x,y:R) (Rabsolu x)==(Rabsolu y) -> (Rsqr x)==(Rsqr y). -Intros; Cut ``(Rsqr (Rabsolu x))==(Rsqr (Rabsolu y))``. -Intro; Repeat Rewrite <- Rsqr_abs in H0; Assumption. -Rewrite H; Reflexivity. -Qed. - -Lemma triangle_rectangle : (x,y,z:R) ``0<=z``->``(Rsqr x)+(Rsqr y)<=(Rsqr z)``->``-z<=x<=z`` /\``-z<=y<=z``. -Intros; Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H0); Rewrite Rplus_sym in H0; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H0); Intros; Split; [Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption] | Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption]]. -Qed. - -Lemma triangle_rectangle_lt : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<(Rsqr z)`` -> ``(Rabsolu x)<(Rabsolu z)``/\``(Rabsolu y)<(Rabsolu z)``. -Intros; Split; [Generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_lt_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_lt_abs_0; Assumption]. -Qed. - -Lemma triangle_rectangle_le : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<=(Rsqr z)`` -> ``(Rabsolu x)<=(Rabsolu z)``/\``(Rabsolu y)<=(Rabsolu z)``. -Intros; Split; [Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_le_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_le_abs_0; Assumption]. -Qed. - -Lemma Rsqr_inv : (x:R) ~``x==0`` -> ``(Rsqr (/x))==/(Rsqr x)``. -Intros; Unfold Rsqr. -Rewrite Rinv_Rmult; Try Reflexivity Orelse Assumption. -Qed. - -Lemma canonical_Rsqr : (a:nonzeroreal;b,c,x:R) ``a*(Rsqr x)+b*x+c == a* (Rsqr (x+b/(2*a))) + (4*a*c - (Rsqr b))/(4*a)``. -Intros. -Rewrite Rsqr_plus. -Repeat Rewrite Rmult_Rplus_distr. -Repeat Rewrite Rplus_assoc. -Apply Rplus_plus_r. -Unfold Rdiv Rminus. -Replace ``2*1+2*1`` with ``4``; [Idtac | Ring]. -Rewrite (Rmult_Rplus_distrl ``4*a*c`` ``-(Rsqr b)`` ``/(4*a)``). -Rewrite Rsqr_times. -Repeat Rewrite Rinv_Rmult. -Repeat Rewrite (Rmult_sym a). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_sym ``/2``). -Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_sym a). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Repeat Rewrite Rplus_assoc. -Rewrite (Rplus_sym ``(Rsqr b)*((Rsqr (/a*/2))*a)``). -Repeat Rewrite Rplus_assoc. -Rewrite (Rmult_sym x). -Apply Rplus_plus_r. -Rewrite (Rmult_sym ``/a``). -Unfold Rsqr; Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Ring. -Apply (cond_nonzero a). -DiscrR. -Apply (cond_nonzero a). -DiscrR. -DiscrR. -Apply (cond_nonzero a). -DiscrR. -DiscrR. -DiscrR. -Apply (cond_nonzero a). -DiscrR. -Apply (cond_nonzero a). -Qed. - -Lemma Rsqr_eq : (x,y:R) (Rsqr x)==(Rsqr y) -> x==y \/ x==``-y``. -Intros; Unfold Rsqr in H; Generalize (Rplus_plus_r ``-(y*y)`` ``x*x`` ``y*y`` H); Rewrite Rplus_Ropp_l; Replace ``-(y*y)+x*x`` with ``(x-y)*(x+y)``. -Intro; Generalize (without_div_Od ``x-y`` ``x+y`` H0); Intro; Elim H1; Intros. -Left; Apply Rminus_eq; Assumption. -Right; Apply Rminus_eq; Unfold Rminus; Rewrite Ropp_Ropp; Assumption. -Ring. -Qed. +Lemma Rsqr_neg_pos_le_0 : + forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x. +intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H; + generalize (Rsqr_incr_0 (- x) y H H2 H0); intro; + rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; + apply Rle_ge; assumption. +apply Rle_trans with 0; + [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption + | apply Rge_le; assumption ]. +Qed. + +Lemma Rsqr_neg_pos_le_1 : + forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y. +intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Rlt_le 0 (- x) H2); intro; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x); + apply Rsqr_incr_1; assumption. +generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption. +Qed. + +Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y. +intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1); + intro; generalize (Rle_trans 0 (- x) y H4 H3); intro; + rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. +generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro; + apply Rsqr_incr_1; assumption. +Qed. + +Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x). +intro; unfold Rabs in |- *; case (Rcase_abs x); intro; + [ apply Rsqr_neg | reflexivity ]. +Qed. + +Lemma Rsqr_le_abs_0 : forall x y:R, Rsqr x <= Rsqr y -> Rabs x <= Rabs y. +intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs; + [ assumption | apply Rabs_pos | apply Rabs_pos ]. +Qed. + +Lemma Rsqr_le_abs_1 : forall x y:R, Rabs x <= Rabs y -> Rsqr x <= Rsqr y. +intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); + apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). +Qed. + +Lemma Rsqr_lt_abs_0 : forall x y:R, Rsqr x < Rsqr y -> Rabs x < Rabs y. +intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs; + [ assumption | apply Rabs_pos | apply Rabs_pos ]. +Qed. + +Lemma Rsqr_lt_abs_1 : forall x y:R, Rabs x < Rabs y -> Rsqr x < Rsqr y. +intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); + apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). +Qed. + +Lemma Rsqr_inj : forall x y:R, 0 <= x -> 0 <= y -> Rsqr x = Rsqr y -> x = y. +intros; generalize (Rle_le_eq (Rsqr x) (Rsqr y)); intro; elim H2; intros _ H3; + generalize (H3 H1); intro; elim H4; intros; apply Rle_antisym; + apply Rsqr_incr_0; assumption. +Qed. + +Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y. +intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros. +rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H; + generalize (Ropp_lt_gt_contravar y 0 r); + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1); + intros; apply Rsqr_inj; assumption. +rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro; + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; + assumption. +rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro; + generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; + assumption. +generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj; + assumption. +Qed. + +Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y. +intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)). +intro; repeat rewrite <- Rsqr_abs in H0; assumption. +rewrite H; reflexivity. +Qed. + +Lemma triangle_rectangle : + forall x y z:R, + 0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z. +intros; + generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0); + rewrite Rplus_comm in H0; + generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H0); + intros; split; + [ split; + [ apply Rsqr_neg_pos_le_0; assumption + | apply Rsqr_incr_0_var; assumption ] + | split; + [ apply Rsqr_neg_pos_le_0; assumption + | apply Rsqr_incr_0_var; assumption ] ]. +Qed. + +Lemma triangle_rectangle_lt : + forall x y z:R, + Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z. +intros; split; + [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); + intro; apply Rsqr_lt_abs_0; assumption + | rewrite Rplus_comm in H; + generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); + intro; apply Rsqr_lt_abs_0; assumption ]. +Qed. + +Lemma triangle_rectangle_le : + forall x y z:R, + Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z. +intros; split; + [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); + intro; apply Rsqr_le_abs_0; assumption + | rewrite Rplus_comm in H; + generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); + intro; apply Rsqr_le_abs_0; assumption ]. +Qed. + +Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x. +intros; unfold Rsqr in |- *. +rewrite Rinv_mult_distr; try reflexivity || assumption. +Qed. + +Lemma canonical_Rsqr : + forall (a:nonzeroreal) (b c x:R), + a * Rsqr x + b * x + c = + a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a). +intros. +rewrite Rsqr_plus. +repeat rewrite Rmult_plus_distr_l. +repeat rewrite Rplus_assoc. +apply Rplus_eq_compat_l. +unfold Rdiv, Rminus in |- *. +replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ]. +rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))). +rewrite Rsqr_mult. +repeat rewrite Rinv_mult_distr. +repeat rewrite (Rmult_comm a). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm (/ 2)). +rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm a). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +repeat rewrite Rplus_assoc. +rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))). +repeat rewrite Rplus_assoc. +rewrite (Rmult_comm x). +apply Rplus_eq_compat_l. +rewrite (Rmult_comm (/ a)). +unfold Rsqr in |- *; repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +ring. +apply (cond_nonzero a). +discrR. +apply (cond_nonzero a). +discrR. +discrR. +apply (cond_nonzero a). +discrR. +discrR. +discrR. +apply (cond_nonzero a). +discrR. +apply (cond_nonzero a). +Qed. + +Lemma Rsqr_eq : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y. +intros; unfold Rsqr in H; + generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H); + rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)). +intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros. +left; apply Rminus_diag_uniq; assumption. +right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive; + assumption. +ring. +Qed.
\ No newline at end of file diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v index 759e4b164..f4d5ccf1a 100644 --- a/theories/Reals/R_sqrt.v +++ b/theories/Reals/R_sqrt.v @@ -8,244 +8,392 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rsqrt_def. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rsqrt_def. Open Local Scope R_scope. (* Here is a continuous extension of Rsqrt on R *) -Definition sqrt : R->R := [x:R](Cases (case_Rabsolu x) of - (leftT _) => R0 - | (rightT a) => (Rsqrt (mknonnegreal x (Rle_sym2 ? ? a))) end). - -Lemma sqrt_positivity : (x:R) ``0<=x`` -> ``0<=(sqrt x)``. -Intros. -Unfold sqrt. -Case (case_Rabsolu x); Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)). -Apply Rsqrt_positivity. +Definition sqrt (x:R) : R := + match Rcase_abs x with + | left _ => 0 + | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a)) + end. + +Lemma sqrt_positivity : forall x:R, 0 <= x -> 0 <= sqrt x. +intros. +unfold sqrt in |- *. +case (Rcase_abs x); intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). +apply Rsqrt_positivity. Qed. -Lemma sqrt_sqrt : (x:R) ``0<=x`` -> ``(sqrt x)*(sqrt x)==x``. -Intros. -Unfold sqrt. -Case (case_Rabsolu x); Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)). -Rewrite Rsqrt_Rsqrt; Reflexivity. +Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x. +intros. +unfold sqrt in |- *. +case (Rcase_abs x); intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). +rewrite Rsqrt_Rsqrt; reflexivity. Qed. -Lemma sqrt_0 : ``(sqrt 0)==0``. -Apply Rsqr_eq_0; Unfold Rsqr; Apply sqrt_sqrt; Right; Reflexivity. +Lemma sqrt_0 : sqrt 0 = 0. +apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. Qed. -Lemma sqrt_1 : ``(sqrt 1)==1``. -Apply (Rsqr_inj (sqrt R1) R1); [Apply sqrt_positivity; Left | Left | Unfold Rsqr; Rewrite -> sqrt_sqrt; [Ring | Left]]; Apply Rlt_R0_R1. +Lemma sqrt_1 : sqrt 1 = 1. +apply (Rsqr_inj (sqrt 1) 1); + [ apply sqrt_positivity; left + | left + | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; + apply Rlt_0_1. Qed. -Lemma sqrt_eq_0 : (x:R) ``0<=x``->``(sqrt x)==0``->``x==0``. -Intros; Cut ``(Rsqr (sqrt x))==0``. -Intro; Unfold Rsqr in H1; Rewrite -> sqrt_sqrt in H1; Assumption. -Rewrite H0; Apply Rsqr_O. +Lemma sqrt_eq_0 : forall x:R, 0 <= x -> sqrt x = 0 -> x = 0. +intros; cut (Rsqr (sqrt x) = 0). +intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption. +rewrite H0; apply Rsqr_0. Qed. -Lemma sqrt_lem_0 : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==y->``y*y==x``. -Intros; Rewrite <- H1; Apply (sqrt_sqrt x H). +Lemma sqrt_lem_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = y -> y * y = x. +intros; rewrite <- H1; apply (sqrt_sqrt x H). Qed. -Lemma sqtr_lem_1 : (x,y:R) ``0<=x``->``0<=y``->``y*y==x``->(sqrt x)==y. -Intros; Apply Rsqr_inj; [Apply (sqrt_positivity x H) | Assumption | Unfold Rsqr; Rewrite -> H1; Apply (sqrt_sqrt x H)]. +Lemma sqtr_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y. +intros; apply Rsqr_inj; + [ apply (sqrt_positivity x H) + | assumption + | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ]. Qed. -Lemma sqrt_def : (x:R) ``0<=x``->``(sqrt x)*(sqrt x)==x``. -Intros; Apply (sqrt_sqrt x H). +Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x. +intros; apply (sqrt_sqrt x H). Qed. -Lemma sqrt_square : (x:R) ``0<=x``->``(sqrt (x*x))==x``. -Intros; Apply (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (pos_Rsqr x)) H); Unfold Rsqr; Apply (sqrt_sqrt (Rsqr x) (pos_Rsqr x)). +Lemma sqrt_square : forall x:R, 0 <= x -> sqrt (x * x) = x. +intros; + apply + (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H); + unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)). Qed. -Lemma sqrt_Rsqr : (x:R) ``0<=x``->``(sqrt (Rsqr x))==x``. -Intros; Unfold Rsqr; Apply sqrt_square; Assumption. +Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x. +intros; unfold Rsqr in |- *; apply sqrt_square; assumption. Qed. -Lemma sqrt_Rsqr_abs : (x:R) (sqrt (Rsqr x))==(Rabsolu x). -Intro x; Rewrite -> Rsqr_abs; Apply sqrt_Rsqr; Apply Rabsolu_pos. +Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x. +intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos. Qed. -Lemma Rsqr_sqrt : (x:R) ``0<=x``->(Rsqr (sqrt x))==x. -Intros x H1; Unfold Rsqr; Apply (sqrt_sqrt x H1). +Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x. +intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1). Qed. -Lemma sqrt_times : (x,y:R) ``0<=x``->``0<=y``->``(sqrt (x*y))==(sqrt x)*(sqrt y)``. -Intros x y H1 H2; Apply (Rsqr_inj (sqrt (Rmult x y)) (Rmult (sqrt x) (sqrt y)) (sqrt_positivity (Rmult x y) (Rmult_le_pos x y H1 H2)) (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) (sqrt_positivity y H2))); Rewrite Rsqr_times; Repeat Rewrite Rsqr_sqrt; [Ring | Assumption |Assumption | Apply (Rmult_le_pos x y H1 H2)]. +Lemma sqrt_mult : + forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y. +intros x y H1 H2; + apply + (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y) + (sqrt_positivity (x * y) (Rmult_le_pos x y H1 H2)) + (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) + (sqrt_positivity y H2))); rewrite Rsqr_mult; + repeat rewrite Rsqr_sqrt; + [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ]. Qed. -Lemma sqrt_lt_R0 : (x:R) ``0<x`` -> ``0<(sqrt x)``. -Intros x H1; Apply Rsqr_incrst_0; [Rewrite Rsqr_O; Rewrite Rsqr_sqrt ; [Assumption | Left; Assumption] | Right; Reflexivity | Apply (sqrt_positivity x (Rlt_le R0 x H1))]. +Lemma sqrt_lt_R0 : forall x:R, 0 < x -> 0 < sqrt x. +intros x H1; apply Rsqr_incrst_0; + [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ] + | right; reflexivity + | apply (sqrt_positivity x (Rlt_le 0 x H1)) ]. Qed. -Lemma sqrt_div : (x,y:R) ``0<=x``->``0<y``->``(sqrt (x/y))==(sqrt x)/(sqrt y)``. -Intros x y H1 H2; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply (Rmult_le_pos x (Rinv y)); [ Assumption | Generalize (Rlt_Rinv y H2); Clear H2; Intro H2; Left; Assumption] | Apply (Rmult_le_pos (sqrt x) (Rinv (sqrt y))) ; [ Apply (sqrt_positivity x H1) | Generalize (sqrt_lt_R0 y H2); Clear H2; Intro H2; Generalize (Rlt_Rinv (sqrt y) H2); Clear H2; Intro H2; Left; Assumption] | Rewrite Rsqr_div; Repeat Rewrite Rsqr_sqrt; [ Reflexivity | Left; Assumption | Assumption | Generalize (Rlt_Rinv y H2); Intro H3; Generalize (Rlt_le R0 (Rinv y) H3); Intro H4; Apply (Rmult_le_pos x (Rinv y) H1 H4) |Red; Intro H3; Generalize (Rlt_le R0 y H2); Intro H4; Generalize (sqrt_eq_0 y H4 H3); Intro H5; Rewrite H5 in H2; Elim (Rlt_antirefl R0 H2)]]. +Lemma sqrt_div : + forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y. +intros x y H1 H2; apply Rsqr_inj; + [ apply sqrt_positivity; apply (Rmult_le_pos x (/ y)); + [ assumption + | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left; + assumption ] + | apply (Rmult_le_pos (sqrt x) (/ sqrt y)); + [ apply (sqrt_positivity x H1) + | generalize (sqrt_lt_R0 y H2); clear H2; intro H2; + generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; + intro H2; left; assumption ] + | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt; + [ reflexivity + | left; assumption + | assumption + | generalize (Rinv_0_lt_compat y H2); intro H3; + generalize (Rlt_le 0 (/ y) H3); intro H4; + apply (Rmult_le_pos x (/ y) H1 H4) + | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4; + generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2; + elim (Rlt_irrefl 0 H2) ] ]. Qed. -Lemma sqrt_lt_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<(sqrt y)``->``x<y``. -Intros x y H1 H2 H3; Generalize (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption. +Lemma sqrt_lt_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x < sqrt y -> x < y. +intros x y H1 H2 H3; + generalize + (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) + (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; + rewrite (Rsqr_sqrt y H2) in H4; assumption. Qed. -Lemma sqrt_lt_1 : (x,y:R) ``0<=x``->``0<=y``->``x<y``->``(sqrt x)<(sqrt y)``. -Intros x y H1 H2 H3; Apply Rsqr_incrst_0; [Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)]. +Lemma sqrt_lt_1 : forall x y:R, 0 <= x -> 0 <= y -> x < y -> sqrt x < sqrt y. +intros x y H1 H2 H3; apply Rsqr_incrst_0; + [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption + | apply (sqrt_positivity x H1) + | apply (sqrt_positivity y H2) ]. Qed. -Lemma sqrt_le_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<=(sqrt y)``->``x<=y``. -Intros x y H1 H2 H3; Generalize (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption. +Lemma sqrt_le_0 : + forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y. +intros x y H1 H2 H3; + generalize + (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) + (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; + rewrite (Rsqr_sqrt y H2) in H4; assumption. Qed. -Lemma sqrt_le_1 : (x,y:R) ``0<=x``->``0<=y``->``x<=y``->``(sqrt x)<=(sqrt y)``. -Intros x y H1 H2 H3; Apply Rsqr_incr_0; [ Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)]. +Lemma sqrt_le_1 : + forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y. +intros x y H1 H2 H3; apply Rsqr_incr_0; + [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption + | apply (sqrt_positivity x H1) + | apply (sqrt_positivity y H2) ]. Qed. -Lemma sqrt_inj : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==(sqrt y)->x==y. -Intros; Cut ``(Rsqr (sqrt x))==(Rsqr (sqrt y))``. -Intro; Rewrite (Rsqr_sqrt x H) in H2; Rewrite (Rsqr_sqrt y H0) in H2; Assumption. -Rewrite H1; Reflexivity. +Lemma sqrt_inj : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = sqrt y -> x = y. +intros; cut (Rsqr (sqrt x) = Rsqr (sqrt y)). +intro; rewrite (Rsqr_sqrt x H) in H2; rewrite (Rsqr_sqrt y H0) in H2; + assumption. +rewrite H1; reflexivity. Qed. -Lemma sqrt_less : (x:R) ``0<=x``->``1<x``->``(sqrt x)<x``. -Intros x H1 H2; Generalize (sqrt_lt_1 R1 x (Rlt_le R0 R1 (Rlt_R0_R1)) H1 H2); Intro H3; Rewrite sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 2 x; Rewrite <- (sqrt_def x H1); Apply (Rlt_monotony (sqrt x) R1 (sqrt x) (sqrt_lt_R0 x (Rlt_trans R0 R1 x Rlt_R0_R1 H2)) H3). +Lemma sqrt_less : forall x:R, 0 <= x -> 1 < x -> sqrt x < x. +intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *; + rewrite <- (sqrt_def x H1); + apply + (Rmult_lt_compat_l (sqrt x) 1 (sqrt x) + (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3). Qed. -Lemma sqrt_more : (x:R) ``0<x``->``x<1``->``x<(sqrt x)``. -Intros x H1 H2; Generalize (sqrt_lt_1 x R1 (Rlt_le R0 x H1) (Rlt_le R0 R1 (Rlt_R0_R1)) H2); Intro H3; Rewrite sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 1 x; Rewrite <- (sqrt_def x (Rlt_le R0 x H1)); Apply (Rlt_monotony (sqrt x) (sqrt x) R1 (sqrt_lt_R0 x H1) H3). +Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x. +intros x H1 H2; + generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *; + rewrite <- (sqrt_def x (Rlt_le 0 x H1)); + apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3). Qed. -Lemma sqrt_cauchy : (a,b,c,d:R) ``a*c+b*d<=(sqrt ((Rsqr a)+(Rsqr b)))*(sqrt ((Rsqr c)+(Rsqr d)))``. -Intros a b c d; Apply Rsqr_incr_0_var; [Rewrite Rsqr_times; 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 ``(a*a*c*c+b*b*d*d)+(a*a*d*d+b*b*c*c)``; [Apply Rle_compatibility; 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 1 ``2*a*b*c*d``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Replace ``a*a*d*d+b*b*c*c-2*a*b*c*d`` with (Rsqr (Rminus (Rmult a d) (Rmult b c))); [Apply pos_Rsqr | Unfold Rsqr; Ring] | Ring] | Ring] | Ring] | Apply (ge0_plus_ge0_is_ge0 (Rsqr c) (Rsqr d) (pos_Rsqr c) (pos_Rsqr d)) | Apply (ge0_plus_ge0_is_ge0 (Rsqr a) (Rsqr b) (pos_Rsqr a) (pos_Rsqr b))] | Apply Rmult_le_pos; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr]. +Lemma sqrt_cauchy : + forall a b c d:R, + a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d). +intros a b c d; apply Rsqr_incr_0_var; + [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *; + [ replace ((a * c + b * d) * (a * c + b * d)) with + (a * a * c * c + b * b * d * d + 2 * a * b * c * d); + [ replace ((a * a + b * b) * (c * c + d * d)) with + (a * a * c * c + b * b * d * d + (a * a * d * d + b * b * c * c)); + [ apply Rplus_le_compat_l; + replace (a * a * d * d + b * b * c * c) with + (2 * a * b * c * d + + (a * a * d * d + b * b * c * c - 2 * a * b * c * d)); + [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; + replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d) + with (Rsqr (a * d - b * c)); + [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ] + | ring ] + | ring ] + | ring ] + | apply + (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d)) + | apply + (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ] + | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat; + apply Rle_0_sqr ]. Qed. (************************************************************) (* Resolution of [a*X^2+b*X+c=0] *) (************************************************************) -Definition Delta [a:nonzeroreal;b,c:R] : R := ``(Rsqr b)-4*a*c``. - -Definition Delta_is_pos [a:nonzeroreal;b,c:R] : Prop := ``0<=(Delta a b c)``. - -Definition sol_x1 [a:nonzeroreal;b,c:R] : R := ``(-b+(sqrt (Delta a b c)))/(2*a)``. - -Definition sol_x2 [a:nonzeroreal;b,c:R] : R := ``(-b-(sqrt (Delta a b c)))/(2*a)``. - -Lemma Rsqr_sol_eq_0_1 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)) -> ``a*(Rsqr x)+b*x+c==0``. -Intros; Elim H0; Intro. -Unfold sol_x1 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_plus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt. -Rewrite Rsqr_inv. -Unfold Rsqr; Repeat Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite Rmult_Rplus_distrl. -Repeat Rewrite Rmult_assoc. -Pattern 2 ``2``; Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_Rplus_distrl ``-b`` ``(sqrt (b*b-(2*(2*(a*c)))))`` ``(/2*/a)``). -Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc. -Replace ``( -b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``. -Unfold Rminus; Repeat Rewrite <- Rplus_assoc. -Replace ``b*b+b*b`` with ``2*(b*b)``. -Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym a); Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite <- Ropp_mul2. -Ring. -Apply (cond_nonzero a). -DiscrR. -DiscrR. -DiscrR. -Ring. -Ring. -DiscrR. -Apply (cond_nonzero a). -DiscrR. -Apply (cond_nonzero a). -Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)]. -Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)]. -Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)]. -Assumption. -Unfold sol_x2 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_minus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt. -Rewrite Rsqr_inv. -Unfold Rsqr; Repeat Rewrite Rinv_Rmult; Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym a); Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Unfold Rminus; Rewrite Rmult_Rplus_distrl. -Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite (Rmult_Rplus_distrl ``-b`` ``-(sqrt (b*b+ -(2*(2*(a*c))))) `` ``(/2*/a)``). -Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc. -Rewrite Ropp_mul1; Rewrite Ropp_Ropp. -Replace ``(b*((sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*( -(sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``. -Repeat Rewrite <- Rplus_assoc; Replace ``b*b+b*b`` with ``2*(b*b)``. -Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite <- Ropp_mul2; Ring. -Apply (cond_nonzero a). -DiscrR. -DiscrR. -DiscrR. -Ring. -Ring. -DiscrR. -Apply (cond_nonzero a). -DiscrR. -DiscrR. -Apply (cond_nonzero a). -Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a). -Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a). -Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a). -Assumption. -Qed. - -Lemma Rsqr_sol_eq_0_0 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> ``a*(Rsqr x)+b*x+c==0`` -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)). -Intros; Rewrite (canonical_Rsqr a b c x) in H0; Rewrite Rplus_sym in H0; Generalize (Rplus_Ropp ``(4*a*c-(Rsqr b))/(4*a)`` ``a*(Rsqr (x+b/(2*a)))`` H0); Cut ``(Rsqr b)-4*a*c==(Delta a b c)``. -Intro; Replace ``-((4*a*c-(Rsqr b))/(4*a))`` with ``((Rsqr b)-4*a*c)/(4*a)``. -Rewrite H1; Intro; Generalize (Rmult_mult_r ``/a`` ``a*(Rsqr (x+b/(2*a)))`` ``(Delta a b c)/(4*a)`` H2); Replace ``/a*(a*(Rsqr (x+b/(2*a))))`` with ``(Rsqr (x+b/(2*a)))``. -Replace ``/a*(Delta a b c)/(4*a)`` with ``(Rsqr ((sqrt (Delta a b c))/(2*a)))``. -Intro; Generalize (Rsqr_eq ``(x+b/(2*a))`` ``((sqrt (Delta a b c))/(2*a))`` H3); Intro; Elim H4; Intro. -Left; Unfold sol_x1; Generalize (Rplus_plus_r ``-(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; Ring. -Ring. -Right; Unfold sol_x2; Generalize (Rplus_plus_r ``-(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; Ring. -Ring. -Rewrite Rsqr_div. -Rewrite Rsqr_sqrt. -Unfold Rdiv. -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym ``/a``). -Rewrite Rmult_assoc. -Rewrite <- Rinv_Rmult. -Replace ``(2*(2*a))*a`` with ``(Rsqr (2*a))``. -Reflexivity. -SqRing. -Rewrite <- Rmult_assoc; Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)]. -Apply (cond_nonzero a). -Assumption. -Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)]. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Symmetry; Apply Rmult_1l. -Apply (cond_nonzero a). -Unfold Rdiv; Rewrite <- Ropp_mul1. -Rewrite Ropp_distr2. -Reflexivity. -Reflexivity. +Definition Delta (a:nonzeroreal) (b c:R) : R := Rsqr b - 4 * a * c. + +Definition Delta_is_pos (a:nonzeroreal) (b c:R) : Prop := 0 <= Delta a b c. + +Definition sol_x1 (a:nonzeroreal) (b c:R) : R := + (- b + sqrt (Delta a b c)) / (2 * a). + +Definition sol_x2 (a:nonzeroreal) (b c:R) : R := + (- b - sqrt (Delta a b c)) / (2 * a). + +Lemma Rsqr_sol_eq_0_1 : + forall (a:nonzeroreal) (b c x:R), + Delta_is_pos a b c -> + x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0. +intros; elim H0; intro. +unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; + repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg; + rewrite Rsqr_sqrt. +rewrite Rsqr_inv. +unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc; rewrite (Rmult_comm a). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite + (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a)) + . +rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. +replace + (- b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + + (b * (- b * (/ 2 * / a)) + + (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with + (b * (- b * (/ 2 * / a)) + c). +unfold Rminus in |- *; repeat rewrite <- Rplus_assoc. +replace (b * b + b * b) with (2 * (b * b)). +rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc. +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; repeat rewrite Rmult_assoc. +rewrite (Rmult_comm a); rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite <- Rmult_opp_opp. +ring. +apply (cond_nonzero a). +discrR. +discrR. +discrR. +ring. +ring. +discrR. +apply (cond_nonzero a). +discrR. +apply (cond_nonzero a). +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +assumption. +unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; + repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg; + rewrite Rsqr_sqrt. +rewrite Rsqr_inv. +unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr; + repeat rewrite Rmult_assoc. +rewrite (Rmult_comm a); repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r. +rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; + rewrite + (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c))))) + (/ 2 * / a)). +rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. +rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive. +replace + (b * (sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + + (b * (- b * (/ 2 * / a)) + + (b * (- sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + c))) with + (b * (- b * (/ 2 * / a)) + c). +repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)). +rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc. +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc. +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; ring. +apply (cond_nonzero a). +discrR. +discrR. +discrR. +ring. +ring. +discrR. +apply (cond_nonzero a). +discrR. +discrR. +apply (cond_nonzero a). +apply prod_neq_R0; discrR || apply (cond_nonzero a). +apply prod_neq_R0; discrR || apply (cond_nonzero a). +apply prod_neq_R0; discrR || apply (cond_nonzero a). +assumption. Qed. + +Lemma Rsqr_sol_eq_0_0 : + forall (a:nonzeroreal) (b c x:R), + Delta_is_pos a b c -> + a * Rsqr x + b * x + c = 0 -> x = sol_x1 a b c \/ x = sol_x2 a b c. +intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0; + generalize + (Rplus_opp_r_uniq ((4 * a * c - Rsqr b) / (4 * a)) + (a * Rsqr (x + b / (2 * a))) H0); cut (Rsqr b - 4 * a * c = Delta a b c). +intro; + replace (- ((4 * a * c - Rsqr b) / (4 * a))) with + ((Rsqr b - 4 * a * c) / (4 * a)). +rewrite H1; intro; + generalize + (Rmult_eq_compat_l (/ a) (a * Rsqr (x + b / (2 * a))) + (Delta a b c / (4 * a)) H2); + replace (/ a * (a * Rsqr (x + b / (2 * a)))) with (Rsqr (x + b / (2 * a))). +replace (/ a * (Delta a b c / (4 * a))) with + (Rsqr (sqrt (Delta a b c) / (2 * a))). +intro; + generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3); + intro; elim H4; intro. +left; unfold sol_x1 in |- *; + generalize + (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) + (sqrt (Delta a b c) / (2 * a)) H5); + replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. +intro; rewrite H6; unfold Rdiv in |- *; ring. +ring. +right; unfold sol_x2 in |- *; + generalize + (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) + (- (sqrt (Delta a b c) / (2 * a))) H5); + replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. +intro; rewrite H6; unfold Rdiv in |- *; ring. +ring. +rewrite Rsqr_div. +rewrite Rsqr_sqrt. +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (/ a)). +rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +replace (2 * (2 * a) * a) with (Rsqr (2 * a)). +reflexivity. +ring_Rsqr. +rewrite <- Rmult_assoc; apply prod_neq_R0; + [ discrR | apply (cond_nonzero a) ]. +apply (cond_nonzero a). +assumption. +apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +symmetry in |- *; apply Rmult_1_l. +apply (cond_nonzero a). +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. +rewrite Ropp_minus_distr. +reflexivity. +reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v index 4f944995c..eee3f2daf 100644 --- a/theories/Reals/Ranalysis.v +++ b/theories/Reals/Ranalysis.v @@ -8,10 +8,10 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rtrigo. -Require SeqSeries. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rtrigo. +Require Import SeqSeries. Require Export Ranalysis1. Require Export Ranalysis2. Require Export Ranalysis3. @@ -27,451 +27,776 @@ Require Export Rgeom. Require Export RList. Require Export Sqrt_reg. Require Export Ranalysis4. -Require Export Rpower. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Export Rpower. Open Local Scope R_scope. Axiom AppVar : R. (**********) -Recursive Tactic Definition IntroHypG trm := -Match trm With -|[(plus_fct ?1 ?2)] -> - (Match Context With - |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2 - |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2 - | _ -> Idtac) -|[(minus_fct ?1 ?2)] -> - (Match Context With - |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2 - |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2 - | _ -> Idtac) -|[(mult_fct ?1 ?2)] -> - (Match Context With - |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2 - |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2 - | _ -> Idtac) -|[(div_fct ?1 ?2)] -> Let aux = ?2 In - (Match Context With - |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2 - |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2 - |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption] - |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption] - | _ -> Idtac) -|[(comp ?1 ?2)] -> - (Match Context With - |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2 - |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2 - | _ -> Idtac) -|[(opp_fct ?1)] -> - (Match Context With - |[|-(derivable ?)] -> IntroHypG ?1 - |[|-(continuity ?)] -> IntroHypG ?1 - | _ -> Idtac) -|[(inv_fct ?1)] -> Let aux = ?1 In - (Match Context With - |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1 - |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1 - |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1 | Try Assumption] - |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1| Try Assumption] - | _ -> Idtac) -|[cos] -> Idtac -|[sin] -> Idtac -|[cosh] -> Idtac -|[sinh] -> Idtac -|[exp] -> Idtac -|[Rsqr] -> Idtac -|[sqrt] -> Idtac -|[id] -> Idtac -|[(fct_cte ?)] -> Idtac -|[(pow_fct ?)] -> Idtac -|[Rabsolu] -> Idtac -|[?1] -> Let p = ?1 In - (Match Context 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). +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. (**********) -Recursive Tactic Definition IntroHypL trm pt := -Match trm With -|[(plus_fct ?1 ?2)] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - | _ -> Idtac) -|[(minus_fct ?1 ?2)] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - | _ -> Idtac) -|[(mult_fct ?1 ?2)] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - | _ -> Idtac) -|[(div_fct ?1 ?2)] -> Let aux = ?2 In - (Match Context With - |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt - |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt - |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt - |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt - |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption] - |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption] - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption] - | _ -> Idtac) -|[(comp ?1 ?2)] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt - |[|-(continuity_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt - | _ -> Idtac) -|[(opp_fct ?1)] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt - |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt - | _ -> Idtac) -|[(inv_fct ?1)] -> Let aux = ?1 In - (Match Context With - |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt - |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt - |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt - |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt - |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt - |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt - |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption] - |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt| Try Assumption] - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption] - | _ -> Idtac) -|[cos] -> Idtac -|[sin] -> Idtac -|[cosh] -> Idtac -|[sinh] -> Idtac -|[exp] -> Idtac -|[Rsqr] -> Idtac -|[id] -> Idtac -|[(fct_cte ?)] -> Idtac -|[(pow_fct ?)] -> Idtac -|[sqrt] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> Cut ``0<pt``; [Intro | Try Assumption] - |[|-(continuity_pt ? ?)] -> Cut ``0<=pt``; [Intro | Try Assumption] - |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``0<pt``; [Intro | Try Assumption] - | _ -> Idtac) -|[Rabsolu] -> - (Match Context With - |[|-(derivable_pt ? ?)] -> Cut ``pt<>0``; [Intro | Try Assumption] - | _ -> Idtac) -|[?1] -> Let p = ?1 In - (Match Context 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] - |[|-(eqT ? (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). +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. (**********) -Recursive Tactic Definition IsDiff_pt := -Match Context With - (* fonctions de base *) - [|-(derivable_pt Rsqr ?)] -> Apply derivable_pt_Rsqr -|[|-(derivable_pt id ?1)] -> Apply (derivable_pt_id ?1) -|[|-(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; Apply derivable_pt_pow -|[|-(derivable_pt sqrt ?1)] -> Apply (derivable_pt_sqrt ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct -|[|-(derivable_pt Rabsolu ?1)] -> Apply (derivable_pt_Rabsolu ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct - (* regles de differentiabilite *) - (* PLUS *) -|[|-(derivable_pt (plus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_plus ?1 ?2 ?3); IsDiff_pt - (* MOINS *) -|[|-(derivable_pt (minus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_minus ?1 ?2 ?3); IsDiff_pt - (* OPPOSE *) -|[|-(derivable_pt (opp_fct ?1) ?2)] -> Apply (derivable_pt_opp ?1 ?2); IsDiff_pt - (* MULTIPLICATION PAR UN SCALAIRE *) -|[|-(derivable_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (derivable_pt_scal ?2 ?1 ?3); IsDiff_pt - (* MULTIPLICATION *) -|[|-(derivable_pt (mult_fct ?1 ?2) ?3)] -> Apply (derivable_pt_mult ?1 ?2 ?3); IsDiff_pt - (* DIVISION *) - |[|-(derivable_pt (div_fct ?1 ?2) ?3)] -> Apply (derivable_pt_div ?1 ?2 ?3); [IsDiff_pt | IsDiff_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte] - (* INVERSION *) - |[|-(derivable_pt (inv_fct ?1) ?2)] -> Apply (derivable_pt_inv ?1 ?2); [Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte | IsDiff_pt] - (* COMPOSITION *) -|[|-(derivable_pt (comp ?1 ?2) ?3)] -> Apply (derivable_pt_comp ?2 ?1 ?3); IsDiff_pt -|[_:(derivable_pt ?1 ?2)|-(derivable_pt ?1 ?2)] -> Assumption -|[_:(derivable ?1) |- (derivable_pt ?1 ?2)] -> Cut (derivable ?1); [Intro HypDDPT; Apply HypDDPT | Assumption] -|[|-True->(derivable_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_pt -| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct. +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. (**********) -Recursive Tactic Definition IsDiff_glob := -Match Context With - (* fonctions de base *) - [|-(derivable Rsqr)] -> 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; Apply derivable_pow - (* regles de differentiabilite *) - (* PLUS *) - |[|-(derivable (plus_fct ?1 ?2))] -> Apply (derivable_plus ?1 ?2); IsDiff_glob - (* MOINS *) - |[|-(derivable (minus_fct ?1 ?2))] -> Apply (derivable_minus ?1 ?2); IsDiff_glob - (* OPPOSE *) - |[|-(derivable (opp_fct ?1))] -> Apply (derivable_opp ?1); IsDiff_glob - (* MULTIPLICATION PAR UN SCALAIRE *) - |[|-(derivable (mult_real_fct ?1 ?2))] -> Apply (derivable_scal ?2 ?1); IsDiff_glob - (* MULTIPLICATION *) - |[|-(derivable (mult_fct ?1 ?2))] -> Apply (derivable_mult ?1 ?2); IsDiff_glob - (* DIVISION *) - |[|-(derivable (div_fct ?1 ?2))] -> Apply (derivable_div ?1 ?2); [IsDiff_glob | IsDiff_glob | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct] - (* INVERSION *) - |[|-(derivable (inv_fct ?1))] -> Apply (derivable_inv ?1); [Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct | IsDiff_glob] - (* COMPOSITION *) - |[|-(derivable (comp sqrt ?))] -> Unfold derivable; Intro; Try IsDiff_pt - |[|-(derivable (comp Rabsolu ?))] -> Unfold derivable; Intro; Try IsDiff_pt - |[|-(derivable (comp ?1 ?2))] -> Apply (derivable_comp ?2 ?1); IsDiff_glob - |[_:(derivable ?1)|-(derivable ?1)] -> Assumption - |[|-True->(derivable ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_glob - | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct. +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. (**********) -Recursive Tactic Definition IsCont_pt := -Match Context With - (* fonctions de base *) - [|-(continuity_pt Rsqr ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_Rsqr -|[|-(continuity_pt id ?1)] -> Apply derivable_continuous_pt; Apply (derivable_pt_id ?1) -|[|-(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; Apply derivable_continuous_pt; Apply derivable_pt_pow -|[|-(continuity_pt sqrt ?1)] -> Apply continuity_pt_sqrt; Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct -|[|-(continuity_pt Rabsolu ?1)] -> Apply (continuity_Rabsolu ?1) - (* regles de differentiabilite *) - (* PLUS *) -|[|-(continuity_pt (plus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_plus ?1 ?2 ?3); IsCont_pt - (* MOINS *) -|[|-(continuity_pt (minus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_minus ?1 ?2 ?3); IsCont_pt - (* OPPOSE *) -|[|-(continuity_pt (opp_fct ?1) ?2)] -> Apply (continuity_pt_opp ?1 ?2); IsCont_pt - (* MULTIPLICATION PAR UN SCALAIRE *) -|[|-(continuity_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (continuity_pt_scal ?2 ?1 ?3); IsCont_pt - (* MULTIPLICATION *) -|[|-(continuity_pt (mult_fct ?1 ?2) ?3)] -> Apply (continuity_pt_mult ?1 ?2 ?3); IsCont_pt - (* DIVISION *) - |[|-(continuity_pt (div_fct ?1 ?2) ?3)] -> Apply (continuity_pt_div ?1 ?2 ?3); [IsCont_pt | IsCont_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct] - (* INVERSION *) - |[|-(continuity_pt (inv_fct ?1) ?2)] -> Apply (continuity_pt_inv ?1 ?2); [IsCont_pt | Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct] - (* COMPOSITION *) -|[|-(continuity_pt (comp ?1 ?2) ?3)] -> Apply (continuity_pt_comp ?2 ?1 ?3); IsCont_pt -|[_:(continuity_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Assumption -|[_:(continuity ?1) |- (continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Assumption] -|[_:(derivable_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Apply derivable_continuous_pt; Assumption -|[_:(derivable ?1)|-(continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Apply derivable_continuous; Assumption] -|[|-True->(continuity_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsCont_pt -| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct. +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. (**********) -Recursive Tactic Definition IsCont_glob := -Match Context With - (* fonctions de base *) - [|-(continuity Rsqr)] -> 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; Apply derivable_continuous; Apply derivable_pow - |[|-(continuity sinh)] -> Apply derivable_continuous; Apply derivable_sinh - |[|-(continuity cosh)] -> Apply derivable_continuous; Apply derivable_cosh - |[|-(continuity Rabsolu)] -> Apply continuity_Rabsolu - (* regles de continuite *) - (* PLUS *) -|[|-(continuity (plus_fct ?1 ?2))] -> Apply (continuity_plus ?1 ?2); Try IsCont_glob Orelse Assumption - (* MOINS *) -|[|-(continuity (minus_fct ?1 ?2))] -> Apply (continuity_minus ?1 ?2); Try IsCont_glob Orelse Assumption - (* OPPOSE *) -|[|-(continuity (opp_fct ?1))] -> Apply (continuity_opp ?1); Try IsCont_glob Orelse Assumption - (* INVERSE *) -|[|-(continuity (inv_fct ?1))] -> Apply (continuity_inv ?1); Try IsCont_glob Orelse Assumption - (* MULTIPLICATION PAR UN SCALAIRE *) -|[|-(continuity (mult_real_fct ?1 ?2))] -> Apply (continuity_scal ?2 ?1); Try IsCont_glob Orelse Assumption - (* MULTIPLICATION *) -|[|-(continuity (mult_fct ?1 ?2))] -> Apply (continuity_mult ?1 ?2); Try IsCont_glob Orelse Assumption - (* DIVISION *) - |[|-(continuity (div_fct ?1 ?2))] -> Apply (continuity_div ?1 ?2); [Try IsCont_glob Orelse Assumption | Try IsCont_glob Orelse Assumption | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte pow_fct] - (* COMPOSITION *) - |[|-(continuity (comp sqrt ?))] -> Unfold continuity_pt; Intro; Try IsCont_pt - |[|-(continuity (comp ?1 ?2))] -> Apply (continuity_comp ?2 ?1); Try IsCont_glob Orelse Assumption - |[_:(continuity ?1)|-(continuity ?1)] -> Assumption - |[|-True->(continuity ?)] -> Intro HypTruE; Clear HypTruE; IsCont_glob - |[_:(derivable ?1)|-(continuity ?1)] -> Apply derivable_continuous; Assumption - | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct. +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. (**********) -Recursive Tactic Definition RewTerm trm := -Match trm With -| [(Rplus ?1 ?2)] -> Let p1= (RewTerm ?1) And p2 = (RewTerm ?2) In - (Match p1 With - [(fct_cte ?3)] -> - (Match p2 With - | [(fct_cte ?4)] -> '(fct_cte (Rplus ?3 ?4)) - | _ -> '(plus_fct p1 p2)) - | _ -> '(plus_fct p1 p2)) -| [(Rminus ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In - (Match p1 With - [(fct_cte ?3)] -> - (Match p2 With - | [(fct_cte ?4)] -> '(fct_cte (Rminus ?3 ?4)) - | _ -> '(minus_fct p1 p2)) - | _ -> '(minus_fct p1 p2)) -| [(Rdiv ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In - (Match p1 With - [(fct_cte ?3)] -> - (Match p2 With - | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4)) - | _ -> '(div_fct p1 p2)) - | _ -> - (Match p2 With - | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4))) - | _ -> '(div_fct p1 p2))) -| [(Rmult ?1 (Rinv ?2))] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In - (Match p1 With - [(fct_cte ?3)] -> - (Match p2 With - | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4)) - | _ -> '(div_fct p1 p2)) - | _ -> - (Match p2 With - | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4))) - | _ -> '(div_fct p1 p2))) -| [(Rmult ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In - (Match p1 With - [(fct_cte ?3)] -> - (Match p2 With - | [(fct_cte ?4)] -> '(fct_cte (Rmult ?3 ?4)) - | _ -> '(mult_fct p1 p2)) - | _ -> '(mult_fct p1 p2)) -| [(Ropp ?1)] -> Let p = (RewTerm ?1) In - (Match p With - [(fct_cte ?2)] -> '(fct_cte (Ropp ?2)) - | _ -> '(opp_fct p)) -| [(Rinv ?1)] -> Let p = (RewTerm ?1) In - (Match p With - [(fct_cte ?2)] -> '(fct_cte (Rinv ?2)) - | _ -> '(inv_fct p)) -| [(?1 AppVar)] -> '?1 -| [(?1 ?2)] -> Let p = (RewTerm ?2) In - (Match p With - | [(fct_cte ?3)] -> '(fct_cte (?1 ?3)) - | _ -> '(comp ?1 p)) -| [AppVar] -> 'id -| [(pow AppVar ?1)] -> '(pow_fct ?1) -| [(pow ?1 ?2)] -> Let p = (RewTerm ?1) In - (Match p With - | [(fct_cte ?3)] -> '(fct_cte (pow_fct ?2 ?3)) - | _ -> '(comp (pow_fct ?2) p)) -| [?1]-> '(fct_cte ?1). +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. (**********) -Recursive Tactic Definition ConsProof trm pt := -Match trm With -| [(plus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_plus ?1 ?2 pt p1 p2) -| [(minus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_minus ?1 ?2 pt p1 p2) -| [(mult_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_mult ?1 ?2 pt p1 p2) -| [(div_fct ?1 ?2)] -> - (Match Context With - |[id:~((?2 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_div ?1 ?2 pt p1 p2 id) - | _ -> 'False) -| [(inv_fct ?1)] -> - (Match Context With - |[id:~((?1 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_inv ?1 pt p1 id) - | _ -> 'False) -| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Let p1 = (ConsProof ?1 pt_f1) And p2 = (ConsProof ?2 pt) In '(derivable_pt_comp ?2 ?1 pt p2 p1) -| [(opp_fct ?1)] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_opp ?1 pt p1) -| [sin] -> '(derivable_pt_sin pt) -| [cos] -> '(derivable_pt_cos pt) -| [sinh] -> '(derivable_pt_sinh pt) -| [cosh] -> '(derivable_pt_cosh pt) -| [exp] -> '(derivable_pt_exp pt) -| [id] -> '(derivable_pt_id pt) -| [Rsqr] -> '(derivable_pt_Rsqr pt) -| [sqrt] -> - (Match Context With - |[id:(Rlt R0 pt) |- ?] -> '(derivable_pt_sqrt pt id) - | _ -> 'False) -| [(fct_cte ?1)] -> '(derivable_pt_const ?1 pt) -| [?1] -> Let aux = ?1 In - (Match Context With - [ id : (derivable_pt aux pt) |- ?] -> 'id - |[ id : (derivable aux) |- ?] -> '(id pt) - | _ -> 'False). +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. (**********) -Recursive Tactic Definition SimplifyDerive trm pt := -Match trm With -| [(plus_fct ?1 ?2)] -> Try Rewrite derive_pt_plus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt -| [(minus_fct ?1 ?2)] -> Try Rewrite derive_pt_minus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt -| [(mult_fct ?1 ?2)] -> Try Rewrite derive_pt_mult; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt -| [(div_fct ?1 ?2)] -> Try Rewrite derive_pt_div; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt -| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Try Rewrite derive_pt_comp; SimplifyDerive ?1 pt_f1; SimplifyDerive ?2 pt -| [(opp_fct ?1)] -> Try Rewrite derive_pt_opp; SimplifyDerive ?1 pt -| [(inv_fct ?1)] -> Try Rewrite derive_pt_inv; SimplifyDerive ?1 pt -| [(fct_cte ?1)] -> 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 -| [?1] -> Let aux = ?1 In - (Match Context With - [ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable aux) |- ? ] -> Try Replace (derive_pt aux pt (H pt)) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu] - |[ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable_pt aux pt) |- ? ] -> Try Replace (derive_pt aux pt H) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu] - | _ -> Idtac ) -| _ -> Idtac. +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. (**********) -Tactic Definition Reg := -Match Context With -| [|-(derivable_pt ?1 ?2)] -> -Let trm = Eval Cbv Beta in (?1 AppVar) In -Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (derivable_pt aux ?2); IsDiff_pt) Orelse IsDiff_pt -| [|-(derivable ?1)] -> -Let trm = Eval Cbv Beta in (?1 AppVar) In -Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (derivable aux); IsDiff_glob) Orelse IsDiff_glob -| [|-(continuity ?1)] -> -Let trm = Eval Cbv Beta in (?1 AppVar) In -Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (continuity aux); IsCont_glob) Orelse IsCont_glob -| [|-(continuity_pt ?1 ?2)] -> -Let trm = Eval Cbv Beta in (?1 AppVar) In -Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (continuity_pt aux ?2); IsCont_pt) Orelse IsCont_pt -| [|-(eqT ? (derive_pt ?1 ?2 ?3) ?4)] -> -Let trm = Eval Cbv Beta in (?1 AppVar) In -Let aux = (RewTerm trm) In -IntroHypL aux ?2; Let aux2 = (ConsProof aux ?2) In Try (Replace (derive_pt ?1 ?2 ?3) with (derive_pt aux ?2 aux2); [SimplifyDerive aux ?2; Try Unfold plus_fct minus_fct mult_fct div_fct id fct_cte inv_fct opp_fct; Try Ring | Try Apply pr_nu]) Orelse IsDiff_pt. +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 |- *; try ring + | try apply pr_nu ]) || is_diff_pt)) + end.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v index b8c5c2f4c..f60c609a0 100644 --- a/theories/Reals/Ranalysis1.v +++ b/theories/Reals/Ranalysis1.v @@ -8,177 +8,222 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. +Require Import Rbase. +Require Import Rfunctions. Require Export Rlimit. -Require Export Rderiv. -V7only [Import R_scope.]. Open Local Scope R_scope. -Implicit Variable Type f:R->R. +Require Export Rderiv. Open Local Scope R_scope. +Implicit Type f : R -> R. (****************************************************) (** Basic operations on functions *) (****************************************************) -Definition plus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)+(f2 x)``. -Definition opp_fct [f:R->R] : R->R := [x:R] ``-(f x)``. -Definition mult_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)*(f2 x)``. -Definition mult_real_fct [a:R;f:R->R] : R->R := [x:R] ``a*(f x)``. -Definition minus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)-(f2 x)``. -Definition div_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)/(f2 x)``. -Definition div_real_fct [a:R;f:R->R] : R->R := [x:R] ``a/(f x)``. -Definition comp [f1,f2:R->R] : R->R := [x:R] ``(f1 (f2 x))``. -Definition inv_fct [f:R->R] : R->R := [x:R]``/(f x)``. - -V8Infix "+" plus_fct : Rfun_scope. -V8Notation "- x" := (opp_fct x) : Rfun_scope. -V8Infix "*" mult_fct : Rfun_scope. -V8Infix "-" minus_fct : Rfun_scope. -V8Infix "/" div_fct : Rfun_scope. -Notation Local "f1 'o' f2" := (comp f1 f2) (at level 2, right associativity) - : Rfun_scope - V8only (at level 20, right associativity). -V8Notation "/ x" := (inv_fct x) : Rfun_scope. - -Delimits Scope Rfun_scope with F. - -Definition fct_cte [a:R] : R->R := [x:R]a. -Definition id := [x:R]x. +Definition plus_fct f1 f2 (x:R) : R := f1 x + f2 x. +Definition opp_fct f (x:R) : R := - f x. +Definition mult_fct f1 f2 (x:R) : R := f1 x * f2 x. +Definition mult_real_fct (a:R) f (x:R) : R := a * f x. +Definition minus_fct f1 f2 (x:R) : R := f1 x - f2 x. +Definition div_fct f1 f2 (x:R) : R := f1 x / f2 x. +Definition div_real_fct (a:R) f (x:R) : R := a / f x. +Definition comp f1 f2 (x:R) : R := f1 (f2 x). +Definition inv_fct f (x:R) : R := / f x. + +Infix "+" := plus_fct : Rfun_scope. +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) + (at level 20, right associativity) : Rfun_scope. +Notation "/ x" := (inv_fct x) : Rfun_scope. + +Delimit Scope Rfun_scope with F. + +Definition fct_cte (a x:R) : R := a. +Definition id (x:R) := x. (****************************************************) (** Variations of functions *) (****************************************************) -Definition increasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f x)<=(f y)``. -Definition decreasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f y)<=(f x)``. -Definition strict_increasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f x)<(f y)``. -Definition strict_decreasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f y)<(f x)``. -Definition constant [f:R->R] : Prop := (x,y:R) ``(f x)==(f y)``. +Definition increasing f : Prop := forall x y:R, x <= y -> f x <= f y. +Definition decreasing f : Prop := forall x y:R, x <= y -> f y <= f x. +Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y. +Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x. +Definition constant f : Prop := forall x y:R, f x = f y. (**********) -Definition no_cond : R->Prop := [x:R] True. +Definition no_cond (x:R) : Prop := True. (**********) -Definition constant_D_eq [f:R->R;D:R->Prop;c:R] : Prop := (x:R) (D x) -> (f x)==c. +Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop := + forall x:R, D x -> f x = c. (***************************************************) (** Definition of continuity as a limit *) (***************************************************) (**********) -Definition continuity_pt [f:R->R; x0:R] : Prop := (continue_in f no_cond x0). -Definition continuity [f:R->R] : Prop := (x:R) (continuity_pt f x). +Definition continuity_pt f (x0:R) : Prop := continue_in f no_cond x0. +Definition continuity f : Prop := forall x:R, continuity_pt f x. Arguments Scope continuity_pt [Rfun_scope R_scope]. Arguments Scope continuity [Rfun_scope]. (**********) -Lemma continuity_pt_plus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (plus_fct f1 f2) x0). -Unfold continuity_pt plus_fct; Unfold continue_in; Intros; Apply limit_plus; Assumption. +Lemma continuity_pt_plus : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0. +unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros; + apply limit_plus; assumption. Qed. -Lemma continuity_pt_opp : (f:R->R; x0:R) (continuity_pt f x0) -> (continuity_pt (opp_fct f) x0). -Unfold continuity_pt opp_fct; Unfold continue_in; Intros; Apply limit_Ropp; Assumption. +Lemma continuity_pt_opp : + forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0. +unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros; + apply limit_Ropp; assumption. Qed. -Lemma continuity_pt_minus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (minus_fct f1 f2) x0). -Unfold continuity_pt minus_fct; Unfold continue_in; Intros; Apply limit_minus; Assumption. -Qed. - -Lemma continuity_pt_mult : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (mult_fct f1 f2) x0). -Unfold continuity_pt mult_fct; Unfold continue_in; Intros; Apply limit_mul; Assumption. -Qed. - -Lemma continuity_pt_const : (f:R->R; x0:R) (constant f) -> (continuity_pt f x0). -Unfold constant continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split; [Apply Rlt_R0_R1 | Intros; Generalize (H x x0); Intro; Rewrite H2; Simpl; Rewrite R_dist_eq; Assumption]. -Qed. - -Lemma continuity_pt_scal : (f:R->R;a:R; x0:R) (continuity_pt f x0) -> (continuity_pt (mult_real_fct a f) x0). -Unfold continuity_pt mult_real_fct; Unfold continue_in; Intros; Apply (limit_mul ([x:R] a) f (D_x no_cond x0) a (f x0) x0). -Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split. -Apply Rlt_R0_R1. -Intros; Rewrite R_dist_eq; Assumption. -Assumption. -Qed. - -Lemma continuity_pt_inv : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (continuity_pt (inv_fct f) x0). -Intros. -Replace (inv_fct f) with [x:R]``/(f x)``. -Unfold continuity_pt; Unfold continue_in; Intros; Apply limit_inv; Assumption. -Unfold inv_fct; Reflexivity. +Lemma continuity_pt_minus : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0. +unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros; + apply limit_minus; assumption. +Qed. + +Lemma continuity_pt_mult : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0. +unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros; + apply limit_mul; assumption. +Qed. + +Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0. +unfold constant, continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; exists 1; split; + [ apply Rlt_0_1 + | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *; + rewrite R_dist_eq; assumption ]. +Qed. + +Lemma continuity_pt_scal : + forall f (a x0:R), + continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0. +unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *; + intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0). +unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split. +apply Rlt_0_1. +intros; rewrite R_dist_eq; assumption. +assumption. +Qed. + +Lemma continuity_pt_inv : + forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0. +intros. +replace (/ f)%F with (fun x:R => / f x). +unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + apply limit_inv; assumption. +unfold inv_fct in |- *; reflexivity. Qed. -Lemma div_eq_inv : (f1,f2:R->R) (div_fct f1 f2)==(mult_fct f1 (inv_fct f2)). -Intros; Reflexivity. +Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F. +intros; reflexivity. Qed. -Lemma continuity_pt_div : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> ~``(f2 x0)==0`` -> (continuity_pt (div_fct f1 f2) x0). -Intros; Rewrite -> (div_eq_inv f1 f2); Apply continuity_pt_mult; [Assumption | Apply continuity_pt_inv; Assumption]. -Qed. - -Lemma continuity_pt_comp : (f1,f2:R->R;x:R) (continuity_pt f1 x) -> (continuity_pt f2 (f1 x)) -> (continuity_pt (comp f2 f1) x). -Unfold continuity_pt; Unfold continue_in; Intros; Unfold comp. -Cut (limit1_in [x0:R](f2 (f1 x0)) (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) -(f2 (f1 x)) x) -> (limit1_in [x0:R](f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x). -Intro; Apply H1. -EApply limit_comp. -Apply H. -Apply H0. -Unfold limit1_in; 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_EM (f1 x) (f1 x1)); Intro. -Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Elim H4; Intros; Apply H8. -Split. -Unfold Dgf D_x no_cond. -Split. -Split. -Trivial. -Elim H5; Unfold D_x no_cond; Intros. -Elim H9; Intros; Assumption. -Split. -Trivial. -Assumption. -Elim H5; Intros; Assumption. +Lemma continuity_pt_div : + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> + continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0. +intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult; + [ assumption | apply continuity_pt_inv; assumption ]. +Qed. + +Lemma continuity_pt_comp : + forall f1 f2 (x:R), + continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x. +unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + unfold comp in |- *. +cut + (limit1_in (fun x0:R => f2 (f1 x0)) + (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) ( + f2 (f1 x)) x -> + limit1_in (fun x0:R => f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x). +intro; apply H1. +eapply limit_comp. +apply H. +apply H0. +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +assert (H3 := H1 eps H2). +elim H3; intros. +exists x0. +split. +elim H4; intros; assumption. +intros; case (Req_dec (f1 x) (f1 x1)); intro. +rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +elim H4; intros; apply H8. +split. +unfold Dgf, D_x, no_cond in |- *. +split. +split. +trivial. +elim H5; unfold D_x, no_cond in |- *; intros. +elim H9; intros; assumption. +split. +trivial. +assumption. +elim H5; intros; assumption. Qed. (**********) -Lemma continuity_plus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (plus_fct f1 f2)). -Unfold continuity; Intros; Apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). +Lemma continuity_plus : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). +unfold continuity in |- *; intros; + apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). Qed. -Lemma continuity_opp : (f:R->R) (continuity f)->(continuity (opp_fct f)). -Unfold continuity; Intros; Apply (continuity_pt_opp f x (H x)). +Lemma continuity_opp : forall f, continuity f -> continuity (- f). +unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)). Qed. -Lemma continuity_minus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (minus_fct f1 f2)). -Unfold continuity; Intros; Apply (continuity_pt_minus f1 f2 x (H x) (H0 x)). +Lemma continuity_minus : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2). +unfold continuity in |- *; intros; + apply (continuity_pt_minus f1 f2 x (H x) (H0 x)). Qed. -Lemma continuity_mult : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (mult_fct f1 f2)). -Unfold continuity; Intros; Apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). +Lemma continuity_mult : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2). +unfold continuity in |- *; intros; + apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). Qed. -Lemma continuity_const : (f:R->R) (constant f) -> (continuity f). -Unfold continuity; Intros; Apply (continuity_pt_const f x H). +Lemma continuity_const : forall f, constant f -> continuity f. +unfold continuity in |- *; intros; apply (continuity_pt_const f x H). Qed. -Lemma continuity_scal : (f:R->R;a:R) (continuity f) -> (continuity (mult_real_fct a f)). -Unfold continuity; Intros; Apply (continuity_pt_scal f a x (H x)). +Lemma continuity_scal : + forall f (a:R), continuity f -> continuity (mult_real_fct a f). +unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)). Qed. -Lemma continuity_inv : (f:R->R) (continuity f)->((x:R) ~``(f x)==0``)->(continuity (inv_fct f)). -Unfold continuity; Intros; Apply (continuity_pt_inv f x (H x) (H0 x)). +Lemma continuity_inv : + forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f). +unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)). Qed. -Lemma continuity_div : (f1,f2:R->R) (continuity f1)->(continuity f2)->((x:R) ~``(f2 x)==0``)->(continuity (div_fct f1 f2)). -Unfold continuity; Intros; Apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)). +Lemma continuity_div : + forall f1 f2, + continuity f1 -> + continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2). +unfold continuity in |- *; intros; + apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)). Qed. -Lemma continuity_comp : (f1,f2:R->R) (continuity f1) -> (continuity f2) -> (continuity (comp f2 f1)). -Unfold continuity; Intros. -Apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). +Lemma continuity_comp : + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1). +unfold continuity in |- *; intros. +apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). Qed. @@ -186,15 +231,20 @@ Qed. (** Derivative's definition using Landau's kernel *) (*****************************************************) -Definition derivable_pt_lim [f:R->R;x,l:R] : Prop := ((eps:R) ``0<eps``->(EXT delta : posreal | ((h:R) ~``h==0``->``(Rabsolu h)<delta`` -> ``(Rabsolu ((((f (x+h))-(f x))/h)-l))<eps``))). +Definition derivable_pt_lim f (x l:R) : Prop := + forall eps:R, + 0 < eps -> + exists delta : posreal + | (forall h:R, + h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps). -Definition derivable_pt_abs [f:R->R;x:R] : R -> Prop := [l:R](derivable_pt_lim f x l). +Definition derivable_pt_abs f (x l:R) : Prop := derivable_pt_lim f x l. -Definition derivable_pt [f:R->R;x:R] := (SigT R (derivable_pt_abs f x)). -Definition derivable [f:R->R] := (x:R)(derivable_pt f x). +Definition derivable_pt f (x:R) := sigT (derivable_pt_abs f x). +Definition derivable f := forall x:R, derivable_pt f x. -Definition derive_pt [f:R->R;x:R;pr:(derivable_pt f x)] := (projT1 ? ? pr). -Definition derive [f:R->R;pr:(derivable f)] := [x:R](derive_pt f x (pr x)). +Definition derive_pt f (x:R) (pr:derivable_pt f x) := projT1 pr. +Definition derive f (pr:derivable f) (x:R) := derive_pt f x (pr x). Arguments Scope derivable_pt_lim [Rfun_scope R_scope]. Arguments Scope derivable_pt_abs [Rfun_scope R_scope R_scope]. @@ -203,125 +253,191 @@ Arguments Scope derivable [Rfun_scope]. Arguments Scope derive_pt [Rfun_scope R_scope _]. Arguments Scope derive [Rfun_scope _]. -Definition antiderivative [f,g:R->R;a,b:R] : Prop := ((x:R)``a<=x<=b``->(EXT pr : (derivable_pt g x) | (f x)==(derive_pt g x pr)))/\``a<=b``. +Definition antiderivative f (g:R -> R) (a b:R) : Prop := + (forall x:R, + a <= x <= b -> exists pr : derivable_pt g x | f x = derive_pt g x pr) /\ + a <= b. (************************************) (** Class of differential functions *) (************************************) -Record Differential : Type := mkDifferential { -d1 :> R->R; -cond_diff : (derivable d1) }. +Record Differential : Type := mkDifferential + {d1 :> R -> R; cond_diff : derivable d1}. -Record Differential_D2 : Type := mkDifferential_D2 { -d2 :> R->R; -cond_D1 : (derivable d2); -cond_D2 : (derivable (derive d2 cond_D1)) }. +Record Differential_D2 : Type := mkDifferential_D2 + {d2 :> R -> R; + cond_D1 : derivable d2; + cond_D2 : derivable (derive d2 cond_D1)}. (**********) -Lemma unicite_step1 : (f:R->R;x,l1,l2:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 R0) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l2 R0) -> l1 == l2. -Intros; Apply (single_limit [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 l2 R0); Try Assumption. -Unfold adhDa; Intros; Exists ``alp/2``. -Split. -Unfold Rdiv; Apply prod_neq_R0. -Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1). -Apply Rinv_neq_R0; DiscrR. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rabsolu_mult. -Replace ``(Rabsolu (/2))`` with ``/2``. -Replace (Rabsolu alp) with alp. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Rewrite double; Pattern 1 alp; Replace alp with ``alp+0``; [Idtac | Ring]; Apply Rlt_compatibility; Assumption. -Symmetry; Apply Rabsolu_right; Left; Assumption. -Symmetry; Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Sup0. -Qed. - -Lemma unicite_step2 : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0). -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; Unfold R_dist; Intros. -Elim H3; Intros. -Apply H2; [Assumption |Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5; Assumption]. -Qed. - -Lemma unicite_step3 : (f:R->R;x,l:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0) -> (derivable_pt_lim f x l). -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; Intros; Unfold R_dist in H3; Apply (H3 h). -Split; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assumption]. -Qed. - -Lemma unicite_limite : (f:R->R;x,l1,l2:R) (derivable_pt_lim f x l1) -> (derivable_pt_lim f x l2) -> l1==l2. -Intros. -Assert H1 := (unicite_step2 ? ? ? H). -Assert H2 := (unicite_step2 ? ? ? H0). -Assert H3 := (unicite_step1 ? ? ? ? H1 H2). -Assumption. -Qed. - -Lemma derive_pt_eq : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l <-> (derivable_pt_lim f x l). -Intros; Split. -Intro; Assert H1 := (projT2 ? ? pr); Unfold derive_pt in H; Rewrite H in H1; Assumption. -Intro; Assert H1 := (projT2 ? ? pr); Unfold derivable_pt_abs in H1. -Assert H2 := (unicite_limite ? ? ? ? H H1). -Unfold derive_pt; Unfold derivable_pt_abs. -Symmetry; Assumption. +Lemma uniqueness_step1 : + forall f (x l1 l2:R), + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 -> + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 -> + l1 = l2. +intros; + apply + (single_limit (fun h:R => (f (x + h) - f x) / h) ( + fun h:R => h <> 0) l1 l2 0); try assumption. +unfold adhDa in |- *; intros; exists (alp / 2). +split. +unfold Rdiv in |- *; apply prod_neq_R0. +red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). +apply Rinv_neq_0_compat; discrR. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult. +replace (Rabs (/ 2)) with (/ 2). +replace (Rabs alp) with alp. +apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double; + pattern alp at 1 in |- *; replace alp with (alp + 0); + [ idtac | ring ]; apply Rplus_lt_compat_l; assumption. +symmetry in |- *; apply Rabs_right; left; assumption. +symmetry in |- *; apply Rabs_right; left; change (0 < / 2) in |- *; + apply Rinv_0_lt_compat; prove_sup0. +Qed. + +Lemma uniqueness_step2 : + forall f (x l:R), + derivable_pt_lim f x l -> + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0. +unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; intros. +assert (H1 := H eps H0). +elim H1; intros. +exists (pos x0). +split. +apply (cond_pos x0). +simpl in |- *; unfold R_dist in |- *; intros. +elim H3; intros. +apply H2; + [ assumption + | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5; + assumption ]. +Qed. + +Lemma uniqueness_step3 : + forall f (x l:R), + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 -> + derivable_pt_lim f x l. +unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; intros. +elim (H eps H0). +intros; elim H1; intros. +exists (mkposreal x0 H2). +simpl in |- *; intros; unfold R_dist in H3; apply (H3 h). +split; + [ assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. +Qed. + +Lemma uniqueness_limite : + forall f (x l1 l2:R), + derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2. +intros. +assert (H1 := uniqueness_step2 _ _ _ H). +assert (H2 := uniqueness_step2 _ _ _ H0). +assert (H3 := uniqueness_step1 _ _ _ _ H1 H2). +assumption. +Qed. + +Lemma derive_pt_eq : + forall f (x l:R) (pr:derivable_pt f x), + derive_pt f x pr = l <-> derivable_pt_lim f x l. +intros; split. +intro; assert (H1 := projT2 pr); unfold derive_pt in H; rewrite H in H1; + assumption. +intro; assert (H1 := projT2 pr); unfold derivable_pt_abs in H1. +assert (H2 := uniqueness_limite _ _ _ _ H H1). +unfold derive_pt in |- *; unfold derivable_pt_abs in |- *. +symmetry in |- *; assumption. Qed. (**********) -Lemma derive_pt_eq_0 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derivable_pt_lim f x l) -> (derive_pt f x pr)==l. -Intros; Elim (derive_pt_eq f x l pr); Intros. -Apply (H1 H). +Lemma derive_pt_eq_0 : + forall f (x l:R) (pr:derivable_pt f x), + derivable_pt_lim f x l -> derive_pt f x pr = l. +intros; elim (derive_pt_eq f x l pr); intros. +apply (H1 H). Qed. (**********) -Lemma derive_pt_eq_1 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l -> (derivable_pt_lim f x l). -Intros; Elim (derive_pt_eq f x l pr); Intros. -Apply (H0 H). +Lemma derive_pt_eq_1 : + forall f (x l:R) (pr:derivable_pt f x), + derive_pt f x pr = l -> derivable_pt_lim f x l. +intros; elim (derive_pt_eq f x l pr); intros. +apply (H0 H). Qed. (********************************************************************) (** Equivalence of this definition with the one using limit concept *) (********************************************************************) -Lemma derive_pt_D_in : (f,df:R->R;x:R;pr:(derivable_pt f x)) (D_in f df no_cond x) <-> (derive_pt f x pr)==(df x). -Intros; Split. -Unfold D_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros. -Apply derive_pt_eq_0. -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))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [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; 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). -Intros; Elim H3; Intros; Unfold D_x in H4; Elim H4; Intros; Cut ``x0-x<>0``. -Intro; Generalize (H2 ``x0-x`` H8 H5); Replace ``x+(x0-x)`` with x0. -Intro; Assumption. -Ring. -Auto with real. -Qed. - -Lemma derivable_pt_lim_D_in : (f,df:R->R;x:R) (D_in f df no_cond x) <-> (derivable_pt_lim f x (df x)). -Intros; Split. -Unfold D_in; 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))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [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; 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). -Intros. -Elim H1; Intros; Unfold D_x in H3; Elim H3; Intros; Cut ``x0-x<>0``. -Intro; Generalize (H2 ``x0-x`` H7 H4); Replace ``x+(x0-x)`` with x0. -Intro; Assumption. -Ring. -Auto with real. +Lemma derive_pt_D_in : + forall f (df:R -> R) (x:R) (pr:derivable_pt f x), + D_in f df no_cond x <-> derive_pt f x pr = df x. +intros; split. +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +apply derive_pt_eq_0. +unfold derivable_pt_lim in |- *. +intros; elim (H eps H0); intros alpha H1; elim H1; intros; + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + intro; cut (x + h - x = h); + [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); + [ intro; generalize (H6 H8); rewrite H7; intro; assumption + | split; + [ unfold D_x in |- *; split; + [ unfold no_cond in |- *; trivial + | apply Rminus_not_eq_right; rewrite H7; assumption ] + | rewrite H7; assumption ] ] + | ring ]. +intro. +assert (H0 := derive_pt_eq_1 f x (df x) pr H). +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. +apply (cond_pos alpha). +intros; elim H3; intros; unfold D_x in H4; elim H4; intros; cut (x0 - x <> 0). +intro; generalize (H2 (x0 - x) H8 H5); replace (x + (x0 - x)) with x0. +intro; assumption. +ring. +auto with real. +Qed. + +Lemma derivable_pt_lim_D_in : + forall f (df:R -> R) (x:R), + D_in f df no_cond x <-> derivable_pt_lim f x (df x). +intros; split. +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +unfold derivable_pt_lim in |- *. +intros; elim (H eps H0); intros alpha H1; elim H1; intros; + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + intro; cut (x + h - x = h); + [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); + [ intro; generalize (H6 H8); rewrite H7; intro; assumption + | split; + [ unfold D_x in |- *; split; + [ unfold no_cond in |- *; trivial + | apply Rminus_not_eq_right; rewrite H7; assumption ] + | rewrite H7; assumption ] ] + | ring ]. +intro. +unfold derivable_pt_lim in H. +unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +elim (H eps H0); intros alpha H2; exists (pos alpha); split. +apply (cond_pos alpha). +intros. +elim H1; intros; unfold D_x in H3; elim H3; intros; cut (x0 - x <> 0). +intro; generalize (H2 (x0 - x) H7 H4); replace (x + (x0 - x)) with x0. +intro; assumption. +ring. +auto with real. Qed. @@ -329,457 +445,555 @@ Qed. (** derivability -> continuity *) (***********************************) (**********) -Lemma derivable_derive : (f:R->R;x:R;pr:(derivable_pt f x)) (EXT l : R | (derive_pt f x pr)==l). -Intros; Exists (projT1 ? ? pr). -Unfold derive_pt; Reflexivity. +Lemma derivable_derive : + forall f (x:R) (pr:derivable_pt f x), exists l : R | derive_pt f x pr = l. +intros; exists (projT1 pr). +unfold derive_pt in |- *; reflexivity. Qed. -Theorem derivable_continuous_pt : (f:R->R;x:R) (derivable_pt f x) -> (continuity_pt f x). -Intros. -Generalize (derivable_derive f x X); Intro. -Elim H; Intros l H1. -Cut l==((fct_cte l) x). -Intro. -Rewrite H0 in H1. -Generalize (derive_pt_D_in f (fct_cte l) x); Intro. -Elim (H2 X); Intros. -Generalize (H4 H1); Intro. -Unfold continuity_pt. -Apply (cont_deriv f (fct_cte l) no_cond x H5). -Unfold fct_cte; Reflexivity. +Theorem derivable_continuous_pt : + forall f (x:R), derivable_pt f x -> continuity_pt f x. +intros. +generalize (derivable_derive f x X); intro. +elim H; intros l H1. +cut (l = fct_cte l x). +intro. +rewrite H0 in H1. +generalize (derive_pt_D_in f (fct_cte l) x); intro. +elim (H2 X); intros. +generalize (H4 H1); intro. +unfold continuity_pt in |- *. +apply (cont_deriv f (fct_cte l) no_cond x H5). +unfold fct_cte in |- *; reflexivity. Qed. -Theorem derivable_continuous : (f:R->R) (derivable f) -> (continuity f). -Unfold derivable continuity; Intros. -Apply (derivable_continuous_pt f x (X x)). +Theorem derivable_continuous : forall f, derivable f -> continuity f. +unfold derivable, continuity in |- *; intros. +apply (derivable_continuous_pt f x (X x)). Qed. (****************************************************************) (** Main rules *) (****************************************************************) -Lemma derivable_pt_lim_plus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (plus_fct f1 f2) x ``l1+l2``). -Intros. -Apply unicite_step3. -Assert H1 := (unicite_step2 ? ? ? H). -Assert H2 := (unicite_step2 ? ? ? H0). -Unfold plus_fct. -Cut (h:R)``((f1 (x+h))+(f2 (x+h))-((f1 x)+(f2 x)))/h``==``((f1 (x+h))-(f1 x))/h+((f2 (x+h))-(f2 x))/h``. -Intro. -Generalize(limit_plus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2). -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; Ring. -Qed. - -Lemma derivable_pt_lim_opp : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (opp_fct f) x (Ropp l)). -Intros. -Apply unicite_step3. -Assert H1 := (unicite_step2 ? ? ? H). -Unfold opp_fct. -Cut (h:R) ``( -(f (x+h))- -(f x))/h``==(Ropp ``((f (x+h))-(f x))/h``). -Intro. -Generalize (limit_Ropp [h:R]``((f (x+h))-(f x))/h``[h:R]``h <> 0`` l ``0`` H1). -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; Ring. -Qed. - -Lemma derivable_pt_lim_minus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (minus_fct f1 f2) x ``l1-l2``). -Intros. -Apply unicite_step3. -Assert H1 := (unicite_step2 ? ? ? H). -Assert H2 := (unicite_step2 ? ? ? H0). -Unfold minus_fct. -Cut (h:R)``((f1 (x+h))-(f1 x))/h-((f2 (x+h))-(f2 x))/h``==``((f1 (x+h))-(f2 (x+h))-((f1 x)-(f2 x)))/h``. -Intro. -Generalize (limit_minus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2). -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; Ring. -Qed. - -Lemma derivable_pt_lim_mult : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (mult_fct f1 f2) x ``l1*(f2 x)+(f1 x)*l2``). -Intros. -Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x). -Elim H1; Intros. -Assert H4 := (H3 H). -Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 x). -Elim H5; Intros. -Assert H8 := (H7 H0). -Clear H1 H2 H3 H5 H6 H7. -Assert H1 := (derivable_pt_lim_D_in (mult_fct f1 f2) [y:R]``l1*(f2 x)+(f1 x)*l2`` x). -Elim H1; Intros. -Clear H1 H3. -Apply H2. -Unfold mult_fct. -Apply (Dmult no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption. -Qed. - -Lemma derivable_pt_lim_const : (a,x:R) (derivable_pt_lim (fct_cte a) x ``0``). -Intros; Unfold fct_cte derivable_pt_lim. -Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Intros; Unfold Rminus; Rewrite Rplus_Ropp_r; Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Qed. - -Lemma derivable_pt_lim_scal : (f:R->R;a,x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (mult_real_fct a f) x ``a*l``). -Intros. -Assert H0 := (derivable_pt_lim_const a x). -Replace (mult_real_fct a f) with (mult_fct (fct_cte a) 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; Reflexivity. -Qed. - -Lemma derivable_pt_lim_id : (x:R) (derivable_pt_lim id x ``1``). -Intro; Unfold derivable_pt_lim. -Intros eps Heps; Exists (mkposreal eps Heps); Intros h H1 H2; Unfold id; Replace ``(x+h-x)/h-1`` with ``0``. -Rewrite Rabsolu_R0; Apply Rle_lt_trans with ``(Rabsolu h)``. -Apply Rabsolu_pos. -Assumption. -Unfold Rminus; Rewrite Rplus_assoc; Rewrite (Rplus_sym x); Rewrite Rplus_assoc. -Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym. -Symmetry; Apply Rplus_Ropp_r. -Assumption. -Qed. - -Lemma derivable_pt_lim_Rsqr : (x:R) (derivable_pt_lim Rsqr x ``2*x``). -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; Rewrite Rmult_Rplus_distrl. -Repeat Rewrite Rmult_assoc. -Repeat Rewrite <- Rinv_r_sym; [Idtac | Assumption]. -Ring. -Qed. - -Lemma derivable_pt_lim_comp : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 (f1 x) l2) -> (derivable_pt_lim (comp f2 f1) x ``l2*l1``). -Intros; Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x). -Elim H1; Intros. -Assert H4 := (H3 H). -Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 (f1 x)). -Elim H5; Intros. -Assert H8 := (H7 H0). -Clear H1 H2 H3 H5 H6 H7. -Assert H1 := (derivable_pt_lim_D_in (comp f2 f1) [y:R]``l2*l1`` x). -Elim H1; Intros. -Clear H1 H3; Apply H2. -Unfold comp; Cut (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` (Dgf no_cond no_cond f1) x) -> (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` no_cond x). -Intro; Apply H1. -Rewrite Rmult_sym; Apply (Dcomp no_cond no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption. -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; Split. -Split; Trivial. -Elim H6; Intros; Unfold D_x in H10; Elim H10; Intros; Assumption. -Elim H6; Intros; Assumption. -Qed. - -Lemma derivable_pt_plus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (plus_fct f1 f2) x). -Unfold derivable_pt; Intros. -Elim X; Intros. -Elim X0; Intros. -Apply Specif.existT with ``x0+x1``. -Apply derivable_pt_lim_plus; Assumption. -Qed. - -Lemma derivable_pt_opp : (f:R->R;x:R) (derivable_pt f x) -> (derivable_pt (opp_fct f) x). -Unfold derivable_pt; Intros. -Elim X; Intros. -Apply Specif.existT with ``-x0``. -Apply derivable_pt_lim_opp; Assumption. -Qed. - -Lemma derivable_pt_minus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (minus_fct f1 f2) x). -Unfold derivable_pt; Intros. -Elim X; Intros. -Elim X0; Intros. -Apply Specif.existT with ``x0-x1``. -Apply derivable_pt_lim_minus; Assumption. -Qed. - -Lemma derivable_pt_mult : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (mult_fct f1 f2) x). -Unfold derivable_pt; Intros. -Elim X; Intros. -Elim X0; Intros. -Apply Specif.existT with ``x0*(f2 x)+(f1 x)*x1``. -Apply derivable_pt_lim_mult; Assumption. -Qed. - -Lemma derivable_pt_const : (a,x:R) (derivable_pt (fct_cte a) x). -Intros; Unfold derivable_pt. -Apply Specif.existT with ``0``. -Apply derivable_pt_lim_const. -Qed. - -Lemma derivable_pt_scal : (f:R->R;a,x:R) (derivable_pt f x) -> (derivable_pt (mult_real_fct a f) x). -Unfold derivable_pt; Intros. -Elim X; Intros. -Apply Specif.existT with ``a*x0``. -Apply derivable_pt_lim_scal; Assumption. -Qed. - -Lemma derivable_pt_id : (x:R) (derivable_pt id x). -Unfold derivable_pt; Intro. -Exists ``1``. -Apply derivable_pt_lim_id. -Qed. - -Lemma derivable_pt_Rsqr : (x:R) (derivable_pt Rsqr x). -Unfold derivable_pt; Intro; Apply Specif.existT with ``2*x``. -Apply derivable_pt_lim_Rsqr. -Qed. - -Lemma derivable_pt_comp : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 (f1 x)) -> (derivable_pt (comp f2 f1) x). -Unfold derivable_pt; Intros. -Elim X; Intros. -Elim X0 ;Intros. -Apply Specif.existT with ``x1*x0``. -Apply derivable_pt_lim_comp; Assumption. -Qed. - -Lemma derivable_plus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (plus_fct f1 f2)). -Unfold derivable; Intros. -Apply (derivable_pt_plus ? ? x (X ?) (X0 ?)). -Qed. - -Lemma derivable_opp : (f:R->R) (derivable f) -> (derivable (opp_fct f)). -Unfold derivable; Intros. -Apply (derivable_pt_opp ? x (X ?)). -Qed. - -Lemma derivable_minus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (minus_fct f1 f2)). -Unfold derivable; Intros. -Apply (derivable_pt_minus ? ? x (X ?) (X0 ?)). -Qed. - -Lemma derivable_mult : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (mult_fct f1 f2)). -Unfold derivable; Intros. -Apply (derivable_pt_mult ? ? x (X ?) (X0 ?)). -Qed. - -Lemma derivable_const : (a:R) (derivable (fct_cte a)). -Unfold derivable; Intros. -Apply derivable_pt_const. -Qed. - -Lemma derivable_scal : (f:R->R;a:R) (derivable f) -> (derivable (mult_real_fct a f)). -Unfold derivable; Intros. -Apply (derivable_pt_scal ? a x (X ?)). -Qed. - -Lemma derivable_id : (derivable id). -Unfold derivable; Intro; Apply derivable_pt_id. -Qed. - -Lemma derivable_Rsqr : (derivable Rsqr). -Unfold derivable; Intro; Apply derivable_pt_Rsqr. -Qed. - -Lemma derivable_comp : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (comp f2 f1)). -Unfold derivable; Intros. -Apply (derivable_pt_comp ? ? x (X ?) (X0 ?)). -Qed. - -Lemma derive_pt_plus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) + (derive_pt f2 x pr2)``. -Intros. -Assert H := (derivable_derive f1 x pr1). -Assert H0 := (derivable_derive f2 x pr2). -Assert H1 := (derivable_derive (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Elim H1; Clear H1; Intros l H1. -Rewrite H; Rewrite H0; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr1). -Unfold derive_pt in H; Rewrite H in H3. -Assert H4 := (projT2 ? ? pr2). -Unfold derive_pt in H0; Rewrite H0 in H4. -Apply derivable_pt_lim_plus; Assumption. -Qed. - -Lemma derive_pt_opp : (f:R->R;x:R;pr1:(derivable_pt f x)) ``(derive_pt (opp_fct f) x (derivable_pt_opp ? ? pr1)) == -(derive_pt f x pr1)``. -Intros. -Assert H := (derivable_derive f x pr1). -Assert H0 := (derivable_derive (opp_fct f) x (derivable_pt_opp ? ? pr1)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Rewrite H; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr1). -Unfold derive_pt in H; Rewrite H in H3. -Apply derivable_pt_lim_opp; Assumption. -Qed. - -Lemma derive_pt_minus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) - (derive_pt f2 x pr2)``. -Intros. -Assert H := (derivable_derive f1 x pr1). -Assert H0 := (derivable_derive f2 x pr2). -Assert H1 := (derivable_derive (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Elim H1; Clear H1; Intros l H1. -Rewrite H; Rewrite H0; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr1). -Unfold derive_pt in H; Rewrite H in H3. -Assert H4 := (projT2 ? ? pr2). -Unfold derive_pt in H0; Rewrite H0 in H4. -Apply derivable_pt_lim_minus; Assumption. -Qed. - -Lemma derive_pt_mult : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)) == (derive_pt f1 x pr1)*(f2 x) + (f1 x)*(derive_pt f2 x pr2)``. -Intros. -Assert H := (derivable_derive f1 x pr1). -Assert H0 := (derivable_derive f2 x pr2). -Assert H1 := (derivable_derive (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Elim H1; Clear H1; Intros l H1. -Rewrite H; Rewrite H0; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr1). -Unfold derive_pt in H; Rewrite H in H3. -Assert H4 := (projT2 ? ? pr2). -Unfold derive_pt in H0; Rewrite H0 in H4. -Apply derivable_pt_lim_mult; Assumption. -Qed. - -Lemma derive_pt_const : (a,x:R) (derive_pt (fct_cte a) x (derivable_pt_const a x)) == R0. -Intros. -Apply derive_pt_eq_0. -Apply derivable_pt_lim_const. -Qed. - -Lemma derive_pt_scal : (f:R->R;a,x:R;pr:(derivable_pt f x)) ``(derive_pt (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)) == a * (derive_pt f x pr)``. -Intros. -Assert H := (derivable_derive f x pr). -Assert H0 := (derivable_derive (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Rewrite H; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr). -Unfold derive_pt in H; Rewrite H in H3. -Apply derivable_pt_lim_scal; Assumption. -Qed. - -Lemma derive_pt_id : (x:R) (derive_pt id x (derivable_pt_id ?))==R1. -Intros. -Apply derive_pt_eq_0. -Apply derivable_pt_lim_id. -Qed. - -Lemma derive_pt_Rsqr : (x:R) (derive_pt Rsqr x (derivable_pt_Rsqr ?)) == ``2*x``. -Intros. -Apply derive_pt_eq_0. -Apply derivable_pt_lim_Rsqr. -Qed. - -Lemma derive_pt_comp : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 (f1 x))) ``(derive_pt (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)) == (derive_pt f2 (f1 x) pr2) * (derive_pt f1 x pr1)``. -Intros. -Assert H := (derivable_derive f1 x pr1). -Assert H0 := (derivable_derive f2 (f1 x) pr2). -Assert H1 := (derivable_derive (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Elim H1; Clear H1; Intros l H1. -Rewrite H; Rewrite H0; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr1). -Unfold derive_pt in H; Rewrite H in H3. -Assert H4 := (projT2 ? ? pr2). -Unfold derive_pt in H0; Rewrite H0 in H4. -Apply derivable_pt_lim_comp; Assumption. +Lemma derivable_pt_lim_plus : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2). +intros. +apply uniqueness_step3. +assert (H1 := uniqueness_step2 _ _ _ H). +assert (H2 := uniqueness_step2 _ _ _ H0). +unfold plus_fct in |- *. +cut + (forall h:R, + (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h = + (f1 (x + h) - f1 x) / h + (f2 (x + h) - f2 x) / h). +intro. +generalize + (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h') + (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H4 eps H5); intros. +exists x0. +elim H6; intros. +split. +assumption. +intros; rewrite H3; apply H8; assumption. +intro; unfold Rdiv in |- *; ring. +Qed. + +Lemma derivable_pt_lim_opp : + forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l). +intros. +apply uniqueness_step3. +assert (H1 := uniqueness_step2 _ _ _ H). +unfold opp_fct in |- *. +cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)). +intro. +generalize + (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1). +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H2 eps H3); intros. +exists x0. +elim H4; intros. +split. +assumption. +intros; rewrite H0; apply H6; assumption. +intro; unfold Rdiv in |- *; ring. +Qed. + +Lemma derivable_pt_lim_minus : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2). +intros. +apply uniqueness_step3. +assert (H1 := uniqueness_step2 _ _ _ H). +assert (H2 := uniqueness_step2 _ _ _ H0). +unfold minus_fct in |- *. +cut + (forall h:R, + (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h = + (f1 (x + h) - f2 (x + h) - (f1 x - f2 x)) / h). +intro. +generalize + (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h') + (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H4 eps H5); intros. +exists x0. +elim H6; intros. +split. +assumption. +intros; rewrite <- H3; apply H8; assumption. +intro; unfold Rdiv in |- *; ring. +Qed. + +Lemma derivable_pt_lim_mult : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> + derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2). +intros. +assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). +elim H1; intros. +assert (H4 := H3 H). +assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) x). +elim H5; intros. +assert (H8 := H7 H0). +clear H1 H2 H3 H5 H6 H7. +assert + (H1 := + derivable_pt_lim_D_in (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x). +elim H1; intros. +clear H1 H3. +apply H2. +unfold mult_fct in |- *. +apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption. +Qed. + +Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0. +intros; unfold fct_cte, derivable_pt_lim in |- *. +intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *; + rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l; + rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +Qed. + +Lemma derivable_pt_lim_scal : + forall f (a x l:R), + derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l). +intros. +assert (H0 := derivable_pt_lim_const a x). +replace (mult_real_fct a f) with (fct_cte a * f)%F. +replace (a * l) with (0 * f x + a * l); [ idtac | ring ]. +apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption. +unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity. +Qed. + +Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1. +intro; unfold derivable_pt_lim in |- *. +intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; + unfold id in |- *; replace ((x + h - x) / h - 1) with 0. +rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h). +apply Rabs_pos. +assumption. +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x); + rewrite Rplus_assoc. +rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite <- Rinv_r_sym. +symmetry in |- *; apply Rplus_opp_r. +assumption. +Qed. + +Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x). +intro; unfold derivable_pt_lim in |- *. +unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps); + intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h. +assumption. +replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h); + [ idtac | ring ]. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +repeat rewrite <- Rinv_r_sym; [ idtac | assumption ]. +ring. +Qed. + +Lemma derivable_pt_lim_comp : + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1). +intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). +elim H1; intros. +assert (H4 := H3 H). +assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) (f1 x)). +elim H5; intros. +assert (H8 := H7 H0). +clear H1 H2 H3 H5 H6 H7. +assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x). +elim H1; intros. +clear H1 H3; apply H2. +unfold comp in |- *; + cut + (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) + (Dgf no_cond no_cond f1) x -> + D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x). +intro; apply H1. +rewrite Rmult_comm; + apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); + assumption. +unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros. +elim (H1 eps H3); intros. +exists x0; intros; split. +elim H5; intros; assumption. +intros; elim H5; intros; apply H9; split. +unfold D_x in |- *; split. +split; trivial. +elim H6; intros; unfold D_x in H10; elim H10; intros; assumption. +elim H6; intros; assumption. +Qed. + +Lemma derivable_pt_plus : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x0 + x1). +apply derivable_pt_lim_plus; assumption. +Qed. + +Lemma derivable_pt_opp : + forall f (x:R), derivable_pt f x -> derivable_pt (- f) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +apply existT with (- x0). +apply derivable_pt_lim_opp; assumption. +Qed. + +Lemma derivable_pt_minus : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x0 - x1). +apply derivable_pt_lim_minus; assumption. +Qed. + +Lemma derivable_pt_mult : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x0 * f2 x + f1 x * x1). +apply derivable_pt_lim_mult; assumption. +Qed. + +Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x. +intros; unfold derivable_pt in |- *. +apply existT with 0. +apply derivable_pt_lim_const. +Qed. + +Lemma derivable_pt_scal : + forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +apply existT with (a * x0). +apply derivable_pt_lim_scal; assumption. +Qed. + +Lemma derivable_pt_id : forall x:R, derivable_pt id x. +unfold derivable_pt in |- *; intro. +exists 1. +apply derivable_pt_lim_id. +Qed. + +Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x. +unfold derivable_pt in |- *; intro; apply existT with (2 * x). +apply derivable_pt_lim_Rsqr. +Qed. + +Lemma derivable_pt_comp : + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x. +unfold derivable_pt in |- *; intros. +elim X; intros. +elim X0; intros. +apply existT with (x1 * x0). +apply derivable_pt_lim_comp; assumption. +Qed. + +Lemma derivable_plus : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2). +unfold derivable in |- *; intros. +apply (derivable_pt_plus _ _ x (X _) (X0 _)). +Qed. + +Lemma derivable_opp : forall f, derivable f -> derivable (- f). +unfold derivable in |- *; intros. +apply (derivable_pt_opp _ x (X _)). +Qed. + +Lemma derivable_minus : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2). +unfold derivable in |- *; intros. +apply (derivable_pt_minus _ _ x (X _) (X0 _)). +Qed. + +Lemma derivable_mult : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2). +unfold derivable in |- *; intros. +apply (derivable_pt_mult _ _ x (X _) (X0 _)). +Qed. + +Lemma derivable_const : forall a:R, derivable (fct_cte a). +unfold derivable in |- *; intros. +apply derivable_pt_const. +Qed. + +Lemma derivable_scal : + forall f (a:R), derivable f -> derivable (mult_real_fct a f). +unfold derivable in |- *; intros. +apply (derivable_pt_scal _ a x (X _)). +Qed. + +Lemma derivable_id : derivable id. +unfold derivable in |- *; intro; apply derivable_pt_id. +Qed. + +Lemma derivable_Rsqr : derivable Rsqr. +unfold derivable in |- *; intro; apply derivable_pt_Rsqr. +Qed. + +Lemma derivable_comp : + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1). +unfold derivable in |- *; intros. +apply (derivable_pt_comp _ _ x (X _) (X0 _)). +Qed. + +Lemma derive_pt_plus : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) = + derive_pt f1 x pr1 + derive_pt f2 x pr2. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 + f2)%F x (derivable_pt_plus _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_plus; assumption. +Qed. + +Lemma derive_pt_opp : + forall f (x:R) (pr1:derivable_pt f x), + derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1. +intros. +assert (H := derivable_derive f x pr1). +assert (H0 := derivable_derive (- f)%F x (derivable_pt_opp _ _ pr1)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +rewrite H; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +apply derivable_pt_lim_opp; assumption. +Qed. + +Lemma derive_pt_minus : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) = + derive_pt f1 x pr1 - derive_pt f2 x pr2. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 - f2)%F x (derivable_pt_minus _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_minus; assumption. +Qed. + +Lemma derive_pt_mult : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) = + derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 * f2)%F x (derivable_pt_mult _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_mult; assumption. +Qed. + +Lemma derive_pt_const : + forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0. +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_const. +Qed. + +Lemma derive_pt_scal : + forall f (a x:R) (pr:derivable_pt f x), + derive_pt (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr) = + a * derive_pt f x pr. +intros. +assert (H := derivable_derive f x pr). +assert + (H0 := derivable_derive (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +rewrite H; apply derive_pt_eq_0. +assert (H3 := projT2 pr). +unfold derive_pt in H; rewrite H in H3. +apply derivable_pt_lim_scal; assumption. +Qed. + +Lemma derive_pt_id : forall x:R, derive_pt id x (derivable_pt_id _) = 1. +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_id. +Qed. + +Lemma derive_pt_Rsqr : + forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x. +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_Rsqr. +Qed. + +Lemma derive_pt_comp : + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)), + derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) = + derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1. +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 (f1 x) pr2). +assert + (H1 := derivable_derive (f2 o f1)%F x (derivable_pt_comp _ _ _ pr1 pr2)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_comp; assumption. Qed. (* Pow *) -Definition pow_fct [n:nat] : R->R := [y:R](pow y n). - -Lemma derivable_pt_lim_pow_pos : (x:R;n:nat) (lt O n) -> (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``). -Intros. -Induction n. -Elim (lt_n_n ? H). -Cut n=O\/(lt O n). -Intro; Elim H0; Intro. -Rewrite H1; Simpl. -Replace [y:R]``y*1`` with (mult_fct id (fct_cte R1)). -Replace ``1*1`` with ``1*(fct_cte R1 x)+(id x)*0``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -Unfold fct_cte id; Ring. -Reflexivity. -Replace [y:R](pow y (S n)) with [y:R]``y*(pow y n)``. -Replace (pred (S n)) with n; [Idtac | Reflexivity]. -Replace [y:R]``y*(pow y n)`` with (mult_fct id [y:R](pow y n)). -Pose f := [y:R](pow y n). -Replace ``(INR (S n))*(pow x n)`` with (Rplus (Rmult R1 (f x)) (Rmult (id x) (Rmult (INR n) (pow x (pred n))))). -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_id. -Unfold f; Apply Hrecn; Assumption. -Unfold f. -Pattern 1 5 n; Replace n with (S (pred n)). -Unfold id; Rewrite S_INR; Simpl. -Ring. -Symmetry; Apply S_pred with O; Assumption. -Unfold mult_fct id; Reflexivity. -Reflexivity. -Inversion H. -Left; Reflexivity. -Right. -Apply lt_le_trans with (1). -Apply lt_O_Sn. -Assumption. -Qed. - -Lemma derivable_pt_lim_pow : (x:R; n:nat) (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``). -Intros. -Induction n. -Simpl. -Rewrite Rmult_Ol. -Replace [_:R]``1`` with (fct_cte R1); [Apply derivable_pt_lim_const | Reflexivity]. -Apply derivable_pt_lim_pow_pos. -Apply lt_O_Sn. -Qed. - -Lemma derivable_pt_pow : (n:nat;x:R) (derivable_pt [y:R](pow y n) x). -Intros; Unfold derivable_pt. -Apply Specif.existT with ``(INR n)*(pow x (pred n))``. -Apply derivable_pt_lim_pow. -Qed. - -Lemma derivable_pow : (n:nat) (derivable [y:R](pow y n)). -Intro; Unfold derivable; Intro; Apply derivable_pt_pow. -Qed. - -Lemma derive_pt_pow : (n:nat;x:R) (derive_pt [y:R](pow y n) x (derivable_pt_pow n x))==``(INR n)*(pow x (pred n))``. -Intros; Apply derive_pt_eq_0. -Apply derivable_pt_lim_pow. -Qed. - -Lemma pr_nu : (f:R->R;x:R;pr1,pr2:(derivable_pt f x)) (derive_pt f x pr1)==(derive_pt f x pr2). -Intros. -Unfold derivable_pt in pr1. -Unfold derivable_pt in pr2. -Elim pr1; Intros. -Elim pr2; Intros. -Unfold derivable_pt_abs in p. -Unfold derivable_pt_abs in p0. -Simpl. -Apply (unicite_limite f x x0 x1 p p0). +Definition pow_fct (n:nat) (y:R) : R := y ^ n. + +Lemma derivable_pt_lim_pow_pos : + forall (x:R) (n:nat), + (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). +intros. +induction n as [| n Hrecn]. +elim (lt_irrefl _ H). +cut (n = 0%nat \/ (0 < n)%nat). +intro; elim H0; intro. +rewrite H1; simpl in |- *. +replace (fun y:R => y * 1) with (id * fct_cte 1)%F. +replace (1 * 1) with (1 * fct_cte 1 x + id x * 0). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte, id in |- *; ring. +reflexivity. +replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n). +replace (pred (S n)) with n; [ idtac | reflexivity ]. +replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F. +pose (f := fun y:R => y ^ n). +replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_id. +unfold f in |- *; apply Hrecn; assumption. +unfold f in |- *. +pattern n at 1 5 in |- *; replace n with (S (pred n)). +unfold id in |- *; rewrite S_INR; simpl in |- *. +ring. +symmetry in |- *; apply S_pred with 0%nat; assumption. +unfold mult_fct, id in |- *; reflexivity. +reflexivity. +inversion H. +left; reflexivity. +right. +apply lt_le_trans with 1%nat. +apply lt_O_Sn. +assumption. +Qed. + +Lemma derivable_pt_lim_pow : + forall (x:R) (n:nat), + derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). +intros. +induction n as [| n Hrecn]. +simpl in |- *. +rewrite Rmult_0_l. +replace (fun _:R => 1) with (fct_cte 1); + [ apply derivable_pt_lim_const | reflexivity ]. +apply derivable_pt_lim_pow_pos. +apply lt_O_Sn. +Qed. + +Lemma derivable_pt_pow : + forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x. +intros; unfold derivable_pt in |- *. +apply existT with (INR n * x ^ pred n). +apply derivable_pt_lim_pow. +Qed. + +Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n). +intro; unfold derivable in |- *; intro; apply derivable_pt_pow. +Qed. + +Lemma derive_pt_pow : + forall (n:nat) (x:R), + derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n. +intros; apply derive_pt_eq_0. +apply derivable_pt_lim_pow. +Qed. + +Lemma pr_nu : + forall f (x:R) (pr1 pr2:derivable_pt f x), + derive_pt f x pr1 = derive_pt f x pr2. +intros. +unfold derivable_pt in pr1. +unfold derivable_pt in pr2. +elim pr1; intros. +elim pr2; intros. +unfold derivable_pt_abs in p. +unfold derivable_pt_abs in p0. +simpl in |- *. +apply (uniqueness_limite f x x0 x1 p p0). Qed. @@ -787,260 +1001,479 @@ Qed. (** Local extremum's condition *) (************************************************************) -Theorem deriv_maximum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)<=(f c)``)->``(derive_pt f c pr)==0``. -Intros; Case (total_order R0 (derive_pt f c pr)); Intro. -Assert H3 := (derivable_derive f c pr). -Elim H3; Intros l H4; Rewrite H4 in H2. -Assert H5 := (derive_pt_eq_1 f c l pr H4). -Cut ``0<l/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H5 ``l/2`` H6); Intros delta H7. -Cut ``0<(b-c)/2``. -Intro; Cut ``(Rmin delta/2 ((b-c)/2))<>0``. -Intro; Cut ``(Rabsolu (Rmin delta/2 ((b-c)/2)))<delta``. -Intro. -Assert H11 := (H7 ``(Rmin delta/2 ((b-c)/2))`` H9 H10). -Cut ``0<(Rmin (delta/2) ((b-c)/2))``. -Intro; Cut ``a<c+(Rmin (delta/2) ((b-c)/2))``. -Intro; Cut ``c+(Rmin (delta/2) ((b-c)/2))<b``. -Intro; Assert H15 := (H1 ``c+(Rmin (delta/2) ((b-c)/2))`` H13 H14). -Cut ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))<=0``. -Intro; Cut ``-l<0``. -Intro; Unfold Rminus in H11. -Cut ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l<0``. -Intro; Cut ``(Rabsolu (((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)) < l/2``. -Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l``); Intro. -Replace `` -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)`` with ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))``. -Intro; Generalize (Rlt_compatibility ``-l`` ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``l/2`` H19); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Replace ``-l+l/2`` with ``-(l/2)``. -Intro; Generalize (Rlt_Ropp ``-(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``-(l/2)`` H20); Repeat Rewrite Ropp_Ropp; Intro; Generalize (Rlt_trans ``0`` ``l/2`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` H6 H21); Intro; Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` ``0`` H22 H16)). -Pattern 2 l; Rewrite double_var. -Ring. -Ring. -Intro. -Assert H20 := (Rle_sym2 ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` r). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H20 H18)). -Assumption. -Rewrite <- Ropp_O; Replace ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` with ``-(l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2))))``. -Apply Rgt_Ropp; Change ``0<l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2)))``; Apply gt0_plus_ge0_is_gt0; [Assumption | Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption]. -Ring. -Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption. -Replace ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))`` with ``- (((f c)-(f (c+(Rmin (delta/2) ((b-c)/2)))))/(Rmin (delta/2) ((b-c)/2)))``. -Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos; [Generalize (Rle_compatibility_r ``-(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` ``(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` (f c) H15); Rewrite Rplus_Ropp_r; Intro; Assumption | Left; Apply Rlt_Rinv; Assumption]. -Unfold Rdiv. -Rewrite <- Ropp_mul1. -Repeat Rewrite <- (Rmult_sym ``/(Rmin (delta*/2) ((b-c)*/2))``). -Apply r_Rmult_mult with ``(Rmin (delta*/2) ((b-c)*/2))``. -Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_r_sym. -Repeat Rewrite Rmult_1l. -Ring. -Red; Intro. -Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12). -Red; Intro. -Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12). -Assert H14 := (Rmin_r ``(delta/2)`` ``((b-c)/2)``). -Assert H15 := (Rle_compatibility ``c`` ``(Rmin (delta/2) ((b-c)/2))`` ``(b-c)/2`` H14). -Apply Rle_lt_trans with ``c+(b-c)/2``. -Assumption. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Replace ``2*(c+(b-c)/2)`` with ``c+b``. -Replace ``2*b`` with ``b+b``. -Apply Rlt_compatibility_r; Assumption. -Ring. -Unfold Rdiv; Rewrite Rmult_Rplus_distr. -Repeat Rewrite (Rmult_sym ``2``). -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Ring. -DiscrR. -Apply Rlt_trans with c. -Assumption. -Pattern 1 c; Rewrite <- (Rplus_Or c); Apply Rlt_compatibility; Assumption. -Cut ``0<delta/2``. -Intro; Apply (Rmin_stable_in_posreal (mkposreal ``delta/2`` H12) (mkposreal ``(b-c)/2`` H8)). -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0]. -Unfold Rabsolu; Case (case_Rabsolu (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; Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rmin (delta/2) ((b-c)/2))`` ``0`` H11 r)). -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0]. -Intro; Apply Rle_lt_trans with ``delta/2``. -Apply Rmin_l. -Unfold Rdiv; Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l. -Replace ``2*delta`` with ``delta+delta``. -Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility. -Rewrite Rplus_Or; Apply (cond_pos delta). -Symmetry; Apply double. -DiscrR. -Cut ``0<delta/2``. -Intro; Generalize (Rmin_stable_in_posreal (mkposreal ``delta/2`` H9) (mkposreal ``(b-c)/2`` H8)); Simpl; Intro; Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``0`` H10). -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0]. -Unfold Rdiv; Apply Rmult_lt_pos. -Generalize (Rlt_compatibility_r ``-c`` c b H0); Rewrite Rplus_Ropp_r; Intro; Assumption. -Apply Rlt_Rinv; Sup0. -Elim H2; Intro. -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)``. -Intro; Elim (H6 ``-(l/2)`` H7); Intros delta H9. -Cut ``0<(c-a)/2``. -Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<0``. -Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<>0``. -Intro; Cut ``(Rabsolu (Rmax (-(delta/2)) ((a-c)/2)))<delta``. -Intro; Generalize (H9 ``(Rmax (-(delta/2)) ((a-c)/2))`` H11 H12); Intro; Cut ``a<c+(Rmax (-(delta/2)) ((a-c)/2))``. -Cut ``c+(Rmax (-(delta/2)) ((a-c)/2))<b``. -Intros; Generalize (H1 ``c+(Rmax (-(delta/2)) ((a-c)/2))`` H15 H14); Intro; Cut ``0<=((f (c+(Rmax (-(delta/2)) ((a-c)/2))))-(f c))/(Rmax (-(delta/2)) ((a-c)/2))``. -Intro; Cut ``0< -l``. -Intro; Unfold Rminus in H13; Cut ``0<((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``. -Intro; Cut ``(Rabsolu (((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l)) < -(l/2)``. -Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``). -Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))+ -l`` ``0`` H19 r)). -Intros; Generalize (Rlt_compatibility_r ``l`` ``(((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2)))+ -l`` ``-(l/2)`` H20); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Replace ``-(l/2)+l`` with ``l/2``. -Cut ``l/2<0``. -Intros; Generalize (Rlt_trans ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))`` ``l/2`` ``0`` H22 H21); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a-c)/2))))-(f c))/(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H17 H23)). -Rewrite <- (Ropp_Ropp ``l/2``); Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption. -Pattern 3 l; Rewrite double_var. -Ring. -Assumption. -Apply ge0_plus_gt0_is_gt0; Assumption. -Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption. -Unfold Rdiv; Replace ``((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))*/(Rmax ( -(delta*/2)) ((a-c)*/2))`` with ``(-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c)))*/(-(Rmax ( -(delta*/2)) ((a-c)*/2)))``. -Apply Rmult_le_pos. -Generalize (Rle_compatibility ``-(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` ``(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` (f c) H16); Rewrite Rplus_Ropp_l; Replace ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))`` with ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2)))))+(f c)``. -Intro; Assumption. -Ring. -Left; Apply Rlt_Rinv; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption. -Unfold Rdiv. -Rewrite <- Ropp_Rinv. -Rewrite Ropp_mul2. -Reflexivity. -Unfold Rdiv in H11; Assumption. -Generalize (Rlt_compatibility c ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H10); Rewrite Rplus_Or; Intro; Apply Rlt_trans with ``c``; Assumption. -Generalize (RmaxLess2 ``(-(delta/2))`` ``((a-c)/2)``); Intro; Generalize (Rle_compatibility c ``(a-c)/2`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H14); Intro; Apply Rlt_le_trans with ``c+(a-c)/2``. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Replace ``2*(c+(a-c)/2)`` with ``a+c``. -Rewrite double. -Apply Rlt_compatibility; Assumption. -Ring. -Rewrite <- Rplus_assoc. -Rewrite <- double_var. -Ring. -Assumption. -Unfold Rabsolu; Case (case_Rabsolu (Rmax ``-(delta/2)`` ``(a-c)/2``)). -Intro; Generalize (RmaxLess1 ``-(delta/2)`` ``(a-c)/2``); Intro; Generalize (Rle_Ropp ``-(delta/2)`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H12); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-(Rmax ( -(delta/2)) ((a-c)/2))`` ``delta/2`` H13); Intro; Apply Rle_lt_trans with ``delta/2``. -Assumption. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite double. -Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility; Rewrite Rplus_Or; Apply (cond_pos delta). -DiscrR. -Cut ``-(delta/2) < 0``. -Cut ``(a-c)/2<0``. -Intros; Generalize (Rmax_stable_in_negreal (mknegreal ``-(delta/2)`` H13) (mknegreal ``(a-c)/2`` H12)); Simpl; Intro; Generalize (Rle_sym2 ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` r); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H15 H14)). -Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``. -Assumption. -Unfold Rdiv. -Rewrite <- Ropp_mul1. -Rewrite (Ropp_distr2 a c). -Reflexivity. -Rewrite <- Ropp_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]]. -Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``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_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]]. -Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``. -Assumption. -Unfold Rdiv. -Rewrite <- Ropp_mul1. -Rewrite (Ropp_distr2 a c). -Reflexivity. -Unfold Rdiv; Apply Rmult_lt_pos; [Generalize (Rlt_compatibility_r ``-a`` a c H); Rewrite Rplus_Ropp_r; Intro; Assumption | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]]. -Replace ``-(l/2)`` with ``(-l)/2``. -Unfold Rdiv; Apply Rmult_lt_pos. -Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption. -Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]. -Unfold Rdiv; Apply Ropp_mul1. -Qed. - -Theorem deriv_minimum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f c)<=(f x)``)->``(derive_pt f c pr)==0``. -Intros. -Rewrite <- (Ropp_Ropp (derive_pt f c pr)). -Apply eq_RoppO. -Rewrite <- (derive_pt_opp f c pr). -Cut (x:R)(``a<x``->``x<b``->``((opp_fct f) x)<=((opp_fct f) c)``). -Intro. -Apply (deriv_maximum (opp_fct f) a b c (derivable_pt_opp ? ? pr) H H0 H2). -Intros; Unfold opp_fct; Apply Rge_Ropp; Apply Rle_sym1. -Apply (H1 x H2 H3). +Theorem deriv_maximum : + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> + (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0. +intros; case (Rtotal_order 0 (derive_pt f c pr)); intro. +assert (H3 := derivable_derive f c pr). +elim H3; intros l H4; rewrite H4 in H2. +assert (H5 := derive_pt_eq_1 f c l pr H4). +cut (0 < l / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H5 (l / 2) H6); intros delta H7. +cut (0 < (b - c) / 2). +intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0). +intro; cut (Rabs (Rmin (delta / 2) ((b - c) / 2)) < delta). +intro. +assert (H11 := H7 (Rmin (delta / 2) ((b - c) / 2)) H9 H10). +cut (0 < Rmin (delta / 2) ((b - c) / 2)). +intro; cut (a < c + Rmin (delta / 2) ((b - c) / 2)). +intro; cut (c + Rmin (delta / 2) ((b - c) / 2) < b). +intro; assert (H15 := H1 (c + Rmin (delta / 2) ((b - c) / 2)) H13 H14). +cut + ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / + Rmin (delta / 2) ((b - c) / 2) <= 0). +intro; cut (- l < 0). +intro; unfold Rminus in H11. +cut + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l < 0). +intro; + cut + (Rabs + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2). +unfold Rabs in |- *; + case + (Rcase_abs + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l)); intro. +replace + (- + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l)) with + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))). +intro; + generalize + (Rplus_lt_compat_l (- l) + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19); + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)). +intro; + generalize + (Ropp_lt_gt_contravar + (- + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20); + repeat rewrite Ropp_involutive; intro; + generalize + (Rlt_trans 0 (l / 2) + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2)) H6 H21); intro; + elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)). +pattern l at 2 in |- *; rewrite double_var. +ring. +ring. +intro. +assert + (H20 := + Rge_le + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). +assumption. +rewrite <- Ropp_0; + replace + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) with + (- + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / + Rmin (delta / 2) ((b + - c) / 2)))). +apply Ropp_gt_lt_contravar; + change + (0 < + l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / + Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat; + [ assumption + | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. +ring. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +replace + ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / + Rmin (delta / 2) ((b - c) / 2)) with + (- + ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) / + Rmin (delta / 2) ((b - c) / 2))). +rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; + unfold Rdiv in |- *; apply Rmult_le_pos; + [ generalize + (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2))) + (f (c + Rmin (delta * / 2) ((b - c) * / 2))) ( + f c) H15); rewrite Rplus_opp_r; intro; assumption + | left; apply Rinv_0_lt_compat; assumption ]. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))). +apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)). +repeat rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +repeat rewrite Rmult_1_l. +ring. +red in |- *; intro. +unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). +red in |- *; intro. +unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). +assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)). +assert + (H15 := + Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14). +apply Rle_lt_trans with (c + (b - c) / 2). +assumption. +apply Rmult_lt_reg_l with 2. +prove_sup0. +replace (2 * (c + (b - c) / 2)) with (c + b). +replace (2 * b) with (b + b). +apply Rplus_lt_compat_r; assumption. +ring. +unfold Rdiv in |- *; rewrite Rmult_plus_distr_l. +repeat rewrite (Rmult_comm 2). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +ring. +discrR. +apply Rlt_trans with c. +assumption. +pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l; + assumption. +cut (0 < delta / 2). +intro; + apply + (Rmin_stable_in_posreal (mkposreal (delta / 2) H12) + (mkposreal ((b - c) / 2) H8)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))). +intro. +cut (0 < delta / 2). +intro. +generalize + (Rmin_stable_in_posreal (mkposreal (delta / 2) H10) + (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro; + elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +intro; apply Rle_lt_trans with (delta / 2). +apply Rmin_l. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +replace (2 * delta) with (delta + delta). +pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); + apply Rplus_lt_compat_l. +rewrite Rplus_0_r; apply (cond_pos delta). +symmetry in |- *; apply double. +discrR. +cut (0 < delta / 2). +intro; + generalize + (Rmin_stable_in_posreal (mkposreal (delta / 2) H9) + (mkposreal ((b - c) / 2) H8)); simpl in |- *; + intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro; + assumption. +apply Rinv_0_lt_compat; prove_sup0. +elim H2; intro. +symmetry in |- *; assumption. +generalize (derivable_derive f c pr); intro; elim H4; intros l H5. +rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro; + cut (0 < - (l / 2)). +intro; elim (H6 (- (l / 2)) H7); intros delta H9. +cut (0 < (c - a) / 2). +intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) < 0). +intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) <> 0). +intro; cut (Rabs (Rmax (- (delta / 2)) ((a - c) / 2)) < delta). +intro; generalize (H9 (Rmax (- (delta / 2)) ((a - c) / 2)) H11 H12); intro; + cut (a < c + Rmax (- (delta / 2)) ((a - c) / 2)). +cut (c + Rmax (- (delta / 2)) ((a - c) / 2) < b). +intros; generalize (H1 (c + Rmax (- (delta / 2)) ((a - c) / 2)) H15 H14); + intro; + cut + (0 <= + (f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / + Rmax (- (delta / 2)) ((a - c) / 2)). +intro; cut (0 < - l). +intro; unfold Rminus in H13; + cut + (0 < + (f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l). +intro; + cut + (Rabs + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < + - (l / 2)). +unfold Rabs in |- *; + case + (Rcase_abs + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l)). +intro; + elim + (Rlt_irrefl 0 + (Rlt_trans 0 + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 r)). +intros; + generalize + (Rplus_lt_compat_r l + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) ( + - (l / 2)) H20); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; replace (- (l / 2) + l) with (l / 2). +cut (l / 2 < 0). +intros; + generalize + (Rlt_trans + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 + ((f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / + Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)). +rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0; + apply Ropp_lt_gt_contravar; assumption. +pattern l at 3 in |- *; rewrite double_var. +ring. +assumption. +apply Rplus_le_lt_0_compat; assumption. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +unfold Rdiv in |- *; + replace + ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * + / Rmax (- (delta * / 2)) ((a - c) * / 2)) with + (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * + / - Rmax (- (delta * / 2)) ((a - c) * / 2)). +apply Rmult_le_pos. +generalize + (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) + (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) ( + f c) H16); rewrite Rplus_opp_l; + replace (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c)) with + (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) + f c). +intro; assumption. +ring. +left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; + assumption. +unfold Rdiv in |- *. +rewrite <- Ropp_inv_permute. +rewrite Rmult_opp_opp. +reflexivity. +unfold Rdiv in H11; assumption. +generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10); + rewrite Rplus_0_r; intro; apply Rlt_trans with c; + assumption. +generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro; + generalize + (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14); + intro; apply Rlt_le_trans with (c + (a - c) / 2). +apply Rmult_lt_reg_l with 2. +prove_sup0. +replace (2 * (c + (a - c) / 2)) with (a + c). +rewrite double. +apply Rplus_lt_compat_l; assumption. +ring. +rewrite <- Rplus_assoc. +rewrite <- double_var. +ring. +assumption. +unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))). +intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro; + generalize + (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2)) + H12); rewrite Ropp_involutive; intro; + generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13); + intro; apply Rle_lt_trans with (delta / 2). +assumption. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double. +pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); + apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). +discrR. +cut (- (delta / 2) < 0). +cut ((a - c) / 2 < 0). +intros; + generalize + (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) + (mknegreal ((a - c) / 2) H12)); simpl in |- *; + intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)). +rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); + apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). +assumption. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite (Ropp_minus_distr a c). +reflexivity. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. +red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). +cut ((a - c) / 2 < 0). +intro; cut (- (delta / 2) < 0). +intro; + apply + (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11) + (mknegreal ((a - c) / 2) H10)). +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. +rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); + apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). +assumption. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite (Ropp_minus_distr a c). +reflexivity. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro; + assumption + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. +replace (- (l / 2)) with (- l / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ]. +unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse. +Qed. + +Theorem deriv_minimum : + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> + (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0. +intros. +rewrite <- (Ropp_involutive (derive_pt f c pr)). +apply Ropp_eq_0_compat. +rewrite <- (derive_pt_opp f c pr). +cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c). +intro. +apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2). +intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge. +apply (H1 x H2 H3). Qed. -Theorem deriv_constant2 : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)==(f c)``)->``(derive_pt f c pr)==0``. -Intros. -EApply deriv_maximum with a b; Try Assumption. -Intros; Right; Apply (H1 x H2 H3). +Theorem deriv_constant2 : + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0. +intros. +eapply deriv_maximum with a b; try assumption. +intros; right; apply (H1 x H2 H3). Qed. (**********) -Lemma nonneg_derivative_0 : (f:R->R;pr:(derivable f)) (increasing f) -> ((x:R) ``0<=(derive_pt f x (pr x))``). -Intros; Unfold increasing in H. -Assert H0 := (derivable_derive f x (pr x)). -Elim H0; Intros l H1. -Rewrite H1; Case (total_order R0 l); Intro. -Left; Assumption. -Elim H2; Intro. -Right; Assumption. -Assert H4 := (derive_pt_eq_1 f x l (pr x) H1). -Cut ``0< -(l/2)``. -Intro; Elim (H4 ``-(l/2)`` H5); Intros delta H6. -Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``. -Intro; Decompose [and] H7; Intros; Generalize (H6 ``delta/2`` H8 H11); Cut ``0<=((f (x+delta/2))-(f x))/(delta/2)``. -Intro; Cut ``0<=((f (x+delta/2))-(f x))/(delta/2)-l``. -Intro; Unfold Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``). -Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` H12 r)). -Intros; Generalize (Rlt_compatibility_r l ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``-(l/2)`` H13); Unfold Rminus; Replace ``-(l/2)+l`` with ``l/2``. -Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Generalize (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``l/2`` H9 H14); Intro; Cut ``l/2<0``. -Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``l/2`` ``0`` H15 H16)). -Rewrite <- Ropp_O in H5; Generalize (Rlt_Ropp ``-0`` ``-(l/2)`` H5); Repeat Rewrite Ropp_Ropp; Intro; Assumption. -Pattern 3 l ; Rewrite double_var. -Ring. -Unfold Rminus; Apply ge0_plus_ge0_is_ge0. -Unfold Rdiv; Apply Rmult_le_pos. -Cut ``x<=(x+(delta*/2))``. -Intro; Generalize (H x ``x+(delta*/2)`` H12); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption. -Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption. -Left; Apply Rlt_Rinv; Assumption. -Left; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption. -Unfold Rdiv; Apply Rmult_le_pos. -Cut ``x<=(x+(delta*/2))``. -Intro; Generalize (H x ``x+(delta*/2)`` H9); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H12); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption. -Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption. -Left; Apply Rlt_Rinv; Assumption. -Split. -Unfold Rdiv; Apply prod_neq_R0. -Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H7; Elim (Rlt_antirefl ``0`` H7). -Apply Rinv_neq_R0; DiscrR. -Split. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0]. -Replace ``(Rabsolu delta/2)`` with ``delta/2``. -Unfold Rdiv; Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite (Rmult_sym ``2``). -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]. -Rewrite Rmult_1r. -Rewrite double. -Pattern 1 (pos delta); Rewrite <- Rplus_Or. -Apply Rlt_compatibility; Apply (cond_pos delta). -Symmetry; Apply Rabsolu_right. -Left; Change ``0<delta/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0]. -Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_lt_pos. -Apply Rlt_anti_compatibility with l. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption. -Apply Rlt_Rinv; Sup0. -Qed. +Lemma nonneg_derivative_0 : + forall f (pr:derivable f), + increasing f -> forall x:R, 0 <= derive_pt f x (pr x). +intros; unfold increasing in H. +assert (H0 := derivable_derive f x (pr x)). +elim H0; intros l H1. +rewrite H1; case (Rtotal_order 0 l); intro. +left; assumption. +elim H2; intro. +right; assumption. +assert (H4 := derive_pt_eq_1 f x l (pr x) H1). +cut (0 < - (l / 2)). +intro; elim (H4 (- (l / 2)) H5); intros delta H6. +cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). +intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11); + cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)). +intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l). +intro; unfold Rabs in |- *; + case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). +intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)). +intros; + generalize + (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l) + (- (l / 2)) H13); unfold Rminus in |- *; + replace (- (l / 2) + l) with (l / 2). +rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; + generalize + (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) (l / 2) H9 H14); + intro; cut (l / 2 < 0). +intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)). +rewrite <- Ropp_0 in H5; + generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5); + repeat rewrite Ropp_involutive; intro; assumption. +pattern l at 3 in |- *; rewrite double_var. +ring. +unfold Rminus in |- *; apply Rplus_le_le_0_compat. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H x (x + delta * / 2) H12); intro; + generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. +unfold Rdiv in |- *; apply Rmult_le_pos. +cut (x <= x + delta * / 2). +intro; generalize (H x (x + delta * / 2) H9); intro; + generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. +pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. +left; apply Rinv_0_lt_compat; assumption. +split. +unfold Rdiv in |- *; apply prod_neq_R0. +generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7; + elim (Rlt_irrefl 0 H7). +apply Rinv_neq_0_compat; discrR. +split. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +replace (Rabs (delta / 2)) with (delta / 2). +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite (Rmult_comm 2). +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l; apply (cond_pos delta). +symmetry in |- *; apply Rabs_right. +left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; + apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with l. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. +apply Rinv_0_lt_compat; prove_sup0. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v index 70f7adb1f..a02c5da6c 100644 --- a/theories/Reals/Ranalysis2.v +++ b/theories/Reals/Ranalysis2.v @@ -8,295 +8,443 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Ranalysis1. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. Open Local Scope R_scope. (**********) -Lemma formule : (x,h,l1,l2:R;f1,f2:R->R) ``h<>0`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ``((f1 (x+h))/(f2 (x+h))-(f1 x)/(f2 x))/h-(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))`` == ``/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1) + l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))) - (f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2) + (l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))``. -Intros; Unfold Rdiv Rminus Rsqr. -Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rinv_Rmult; Try Assumption. -Replace ``l1*(f2 x)*(/(f2 x)*/(f2 x))`` with ``l1*/(f2 x)*((f2 x)*/(f2 x))``; [Idtac | Ring]. -Replace ``l1*(/(f2 x)*/(f2 (x+h)))*(f2 x)`` with ``l1*/(f2 (x+h))*((f2 x)*/(f2 x))``; [Idtac | Ring]. -Replace ``l1*(/(f2 x)*/(f2 (x+h)))* -(f2 (x+h))`` with ``-(l1*/(f2 x)*((f2 (x+h))*/(f2 (x+h))))``; [Idtac | Ring]. -Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*((f2 (x+h))*/h)`` with ``(f1 x)*/(f2 x)*/h*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring]. -Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*( -(f2 x)*/h)`` with ``-((f1 x)*/(f2 (x+h))*/h*((f2 x)*/(f2 x)))``; [Idtac | Ring]. -Replace ``(l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))*(f2 (x+h)))`` with ``l2*(f1 x)*/(f2 x)*/(f2 x)*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring]. -Replace ``l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))* -(f2 x)`` with ``-(l2*(f1 x)*/(f2 x)*/(f2 (x+h))*((f2 x)*/(f2 x)))``; [Idtac | Ring]. -Repeat Rewrite <- Rinv_r_sym; Try Assumption Orelse Ring. -Apply prod_neq_R0; Assumption. +Lemma formule : + forall (x h l1 l2:R) (f1 f2:R -> R), + h <> 0 -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (f1 (x + h) / f2 (x + h) - f1 x / f2 x) / h - + (l1 * f2 x - l2 * f1 x) / Rsqr (f2 x) = + / f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1) + + l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h)) - + f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) + + l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x). +intros; unfold Rdiv, Rminus, Rsqr in |- *. +repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rinv_mult_distr; try assumption. +replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x)); + [ idtac | ring ]. +replace (l1 * (/ f2 x * / f2 (x + h)) * f2 x) with + (l1 * / f2 (x + h) * (f2 x * / f2 x)); [ idtac | ring ]. +replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with + (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ]. +replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with + (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); + [ idtac | ring ]. +replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with + (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); + [ idtac | ring ]. +replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with + (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h))); + [ idtac | ring ]. +replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with + (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); + [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try assumption || ring. +apply prod_neq_R0; assumption. Qed. -Lemma Rmin_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0 < (Rmin x y)``. -Intros; Unfold Rmin. -Case (total_order_Rle x y); Intro; Assumption. +Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y. +intros; unfold Rmin in |- *. +case (Rle_dec x y); intro; assumption. Qed. -Lemma maj_term1 : (x,h,eps,l1,alp_f2:R;eps_f2,alp_f1d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f1d``->``(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < (Rabsolu ((eps*(f2 x))/8))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f1d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) < eps/4``. -Intros. -Assert H7 := (H3 h H6). -Assert H8 := (H2 h H4 H5). -Apply Rle_lt_trans with ``2/(Rabsolu (f2 x))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1))``. -Rewrite Rabsolu_mult. -Apply Rle_monotony_r. -Apply Rabsolu_pos. -Rewrite Rabsolu_Rinv; [Left; Exact H7 | Assumption]. -Apply Rlt_le_trans with ``2/(Rabsolu (f2 x))*(Rabsolu ((eps*(f2 x))/8))``. -Apply Rlt_monotony. -Unfold Rdiv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption]. -Exact H8. -Right; Unfold Rdiv. -Repeat Rewrite Rabsolu_mult. -Rewrite Rabsolu_Rinv; DiscrR. -Replace ``(Rabsolu 8)`` with ``8``. -Replace ``8`` with ``2*4``; [Idtac | Ring]. -Rewrite Rinv_Rmult; [Idtac | DiscrR | DiscrR]. -Replace ``2*/(Rabsolu (f2 x))*((Rabsolu eps)*(Rabsolu (f2 x))*(/2*/4))`` with ``(Rabsolu eps)*/4*(2*/2)*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))``; [Idtac | Ring]. -Replace (Rabsolu eps) with eps. -Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption). -Ring. -Symmetry; Apply Rabsolu_right; Left; Assumption. -Symmetry; Apply Rabsolu_right; Left; Sup. +Lemma maj_term1 : + forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall h:R, + h <> 0 -> + Rabs h < alp_f1d -> + Rabs ((f1 (x + h) - f1 x) / h - l1) < Rabs (eps * f2 x / 8)) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f1d -> + Rabs h < Rmin eps_f2 alp_f2 -> + Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4. +intros. +assert (H7 := H3 h H6). +assert (H8 := H2 h H4 H5). +apply Rle_lt_trans with + (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)). +rewrite Rabs_mult. +apply Rmult_le_compat_r. +apply Rabs_pos. +rewrite Rabs_Rinv; [ left; exact H7 | assumption ]. +apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)). +apply Rmult_lt_compat_l. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. +exact H8. +right; unfold Rdiv in |- *. +repeat rewrite Rabs_mult. +rewrite Rabs_Rinv; discrR. +replace (Rabs 8) with 8. +replace 8 with 8; [ idtac | ring ]. +rewrite Rinv_mult_distr; [ idtac | discrR | discrR ]. +replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with + (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x))); + [ idtac | ring ]. +replace (Rabs eps) with eps. +repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). +ring. +symmetry in |- *; apply Rabs_right; left; assumption. +symmetry in |- *; apply Rabs_right; left; prove_sup. Qed. -Lemma maj_term2 : (x,h,eps,l1,alp_f2,alp_f2t2:R;eps_f2:posreal;f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2t2``->``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``)-> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2t2`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``l1<>0`` -> ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) < eps/4``. -Intros. -Assert H8 := (H3 h H6). -Assert H9 := (H2 h H5). -Apply Rle_lt_trans with ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Rewrite Rabsolu_mult; Apply Rle_monotony. -Apply Rabsolu_pos. -Rewrite <- (Rabsolu_Ropp ``(f2 x)-(f2 (x+h))``); Rewrite Ropp_distr2. -Left; Apply H9. -Apply Rlt_le_trans with ``(Rabsolu (2*l1/((f2 x)*(f2 x))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Apply Rlt_monotony_r. -Apply Rabsolu_pos_lt. -Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR. -Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H). -Apply Rinv_neq_R0; Apply prod_neq_R0; Try Assumption Orelse DiscrR. -Unfold Rdiv. -Repeat Rewrite Rinv_Rmult; Try Assumption. -Repeat Rewrite Rabsolu_mult. -Replace ``(Rabsolu 2)`` with ``2``. -Rewrite (Rmult_sym ``2``). -Replace ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring]. -Repeat Apply Rlt_monotony. -Apply Rabsolu_pos_lt; Assumption. -Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption. -Repeat Rewrite Rabsolu_Rinv; Try Assumption. -Rewrite <- (Rmult_sym ``2``). -Unfold Rdiv in H8; Exact H8. -Symmetry; Apply Rabsolu_right; Left; Sup0. -Right. -Unfold Rsqr Rdiv. -Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Repeat Rewrite Rabsolu_mult. -Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR. -Replace (Rabsolu eps) with eps. -Replace ``(Rabsolu (8))`` with ``8``. -Replace ``(Rabsolu 2)`` with ``2``. -Replace ``8`` with ``4*2``; [Idtac | Ring]. -Rewrite Rinv_Rmult; DiscrR. -Replace ``2*((Rabsolu l1)*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*(eps*((Rabsolu (f2 x))*(Rabsolu (f2 x)))*(/4*/2*/(Rabsolu l1)))`` with ``eps*/4*((Rabsolu l1)*/(Rabsolu l1))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring]. -Repeat Rewrite <- Rinv_r_sym; Try (Apply Rabsolu_no_R0; Assumption) Orelse DiscrR. -Ring. -Symmetry; Apply Rabsolu_right; Left; Sup0. -Symmetry; Apply Rabsolu_right; Left; Sup. -Symmetry; Apply Rabsolu_right; Left; Assumption. +Lemma maj_term2 : + forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) + (f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f2t2 -> + Rabs h < Rmin eps_f2 alp_f2 -> + l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4. +intros. +assert (H8 := H3 h H6). +assert (H9 := H2 h H5). +apply Rle_lt_trans with + (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). +rewrite Rabs_mult; apply Rmult_le_compat_l. +apply Rabs_pos. +rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr. +left; apply H9. +apply Rlt_le_trans with + (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). +apply Rmult_lt_compat_r. +apply Rabs_pos_lt. +unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + try assumption || discrR. +red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). +apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR. +unfold Rdiv in |- *. +repeat rewrite Rinv_mult_distr; try assumption. +repeat rewrite Rabs_mult. +replace (Rabs 2) with 2. +rewrite (Rmult_comm 2). +replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with + (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + [ idtac | ring ]. +repeat apply Rmult_lt_compat_l. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. +repeat rewrite Rabs_Rinv; try assumption. +rewrite <- (Rmult_comm 2). +unfold Rdiv in H8; exact H8. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +right. +unfold Rsqr, Rdiv in |- *. +do 1 rewrite Rinv_mult_distr; try assumption || discrR. +do 1 rewrite Rinv_mult_distr; try assumption || discrR. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv; try assumption || discrR. +replace (Rabs eps) with eps. +replace (Rabs 8) with 8. +replace (Rabs 2) with 2. +replace 8 with (4 * 2); [ idtac | ring ]. +rewrite Rinv_mult_distr; discrR. +replace + (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) * + (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with + (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR. +ring. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +symmetry in |- *; apply Rabs_right; left; prove_sup. +symmetry in |- *; apply Rabs_right; left; assumption. Qed. -Lemma maj_term3 : (x,h,eps,l2,alp_f2:R;eps_f2,alp_f2d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f2d``->``(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < (Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) < eps/4``. -Intros. -Assert H8 := (H2 h H4 H5). -Assert H9 := (H3 h H6). -Apply Rle_lt_trans with ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``. -Rewrite Rabsolu_mult. -Apply Rle_monotony. -Apply Rabsolu_pos. -Left; Apply H8. -Apply Rlt_le_trans with ``(Rabsolu (2*(f1 x)/((f2 x)*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``. -Apply Rlt_monotony_r. -Apply Rabsolu_pos_lt. -Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption. -Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H). -Apply Rinv_neq_R0; Apply prod_neq_R0; DiscrR Orelse Assumption. -Unfold Rdiv. -Repeat Rewrite Rinv_Rmult; Try Assumption. -Repeat Rewrite Rabsolu_mult. -Replace ``(Rabsolu 2)`` with ``2``. -Rewrite (Rmult_sym ``2``). -Replace ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring]. -Repeat Apply Rlt_monotony. -Apply Rabsolu_pos_lt; Assumption. -Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption. -Repeat Rewrite Rabsolu_Rinv; Assumption Orelse Idtac. -Rewrite <- (Rmult_sym ``2``). -Unfold Rdiv in H9; Exact H9. -Symmetry; Apply Rabsolu_right; Left; Sup0. -Right. -Unfold Rsqr Rdiv. -Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Repeat Rewrite Rabsolu_mult. -Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR. -Replace (Rabsolu eps) with eps. -Replace ``(Rabsolu (8))`` with ``8``. -Replace ``(Rabsolu 2)`` with ``2``. -Replace ``8`` with ``4*2``; [Idtac | Ring]. -Rewrite Rinv_Rmult; DiscrR. -Replace ``2*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))))`` with ``eps*/4*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*(2*/2)``; [Idtac | Ring]. -Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption). -Ring. -Symmetry; Apply Rabsolu_right; Left; Sup0. -Symmetry; Apply Rabsolu_right; Left; Sup. -Symmetry; Apply Rabsolu_right; Left; Assumption. +Lemma maj_term3 : + forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall h:R, + h <> 0 -> + Rabs h < alp_f2d -> + Rabs ((f2 (x + h) - f2 x) / h - l2) < + Rabs (Rsqr (f2 x) * eps / (8 * f1 x))) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f2d -> + Rabs h < Rmin eps_f2 alp_f2 -> + f1 x <> 0 -> + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) < + eps / 4. +intros. +assert (H8 := H2 h H4 H5). +assert (H9 := H3 h H6). +apply Rle_lt_trans with + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). +rewrite Rabs_mult. +apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply H8. +apply Rlt_le_trans with + (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). +apply Rmult_lt_compat_r. +apply Rabs_pos_lt. +unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + try assumption. +red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). +apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption. +unfold Rdiv in |- *. +repeat rewrite Rinv_mult_distr; try assumption. +repeat rewrite Rabs_mult. +replace (Rabs 2) with 2. +rewrite (Rmult_comm 2). +replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with + (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + [ idtac | ring ]. +repeat apply Rmult_lt_compat_l. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. +repeat rewrite Rabs_Rinv; assumption || idtac. +rewrite <- (Rmult_comm 2). +unfold Rdiv in H9; exact H9. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +right. +unfold Rsqr, Rdiv in |- *. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv; try assumption || discrR. +replace (Rabs eps) with eps. +replace (Rabs 8) with 8. +replace (Rabs 2) with 2. +replace 8 with (4 * 2); [ idtac | ring ]. +rewrite Rinv_mult_distr; discrR. +replace + (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) * + (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with + (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). +ring. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +symmetry in |- *; apply Rabs_right; left; prove_sup. +symmetry in |- *; apply Rabs_right; left; assumption. Qed. -Lemma maj_term4 : (x,h,eps,l2,alp_f2,alp_f2c:R;eps_f2:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2c`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``l2<>0`` -> ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x)))) < eps/4``. -Intros. -Assert H9 := (H2 h H5). -Assert H10 := (H3 h H6). -Apply Rle_lt_trans with ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``. -Rewrite Rabsolu_mult. -Apply Rle_monotony. -Apply Rabsolu_pos. -Left; Apply H9. -Apply Rlt_le_trans with ``(Rabsolu (2*l2*(f1 x)/((Rsqr (f2 x))*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``. -Apply Rlt_monotony_r. -Apply Rabsolu_pos_lt. -Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Assumption Orelse Idtac. -Red; Intro H11; Rewrite H11 in H; Elim (Rlt_antirefl ? H). -Apply Rinv_neq_R0; Apply prod_neq_R0. -Apply prod_neq_R0. -DiscrR. -Assumption. -Assumption. -Unfold Rdiv. -Repeat Rewrite Rinv_Rmult; Try Assumption Orelse (Unfold Rsqr; Apply prod_neq_R0; Assumption). -Repeat Rewrite Rabsolu_mult. -Replace ``(Rabsolu 2)`` with ``2``. -Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 x)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*((Rabsolu (/(f2 x)))*2)))``; [Idtac | Ring]. -Replace ``(Rabsolu l2)*(Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*(((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))))``; [Idtac | Ring]. -Repeat Apply Rlt_monotony. -Apply Rabsolu_pos_lt; Assumption. -Apply Rabsolu_pos_lt; Assumption. -Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Unfold Rsqr; Apply prod_neq_R0; Assumption. -Repeat Rewrite Rabsolu_Rinv; [Idtac | Assumption | Assumption]. -Rewrite <- (Rmult_sym ``2``). -Unfold Rdiv in H10; Exact H10. -Symmetry; Apply Rabsolu_right; Left; Sup0. -Right; Unfold Rsqr Rdiv. -Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Repeat Rewrite Rabsolu_mult. -Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR. -Replace (Rabsolu eps) with eps. -Replace ``(Rabsolu (8))`` with ``8``. -Replace ``(Rabsolu 2)`` with ``2``. -Replace ``8`` with ``4*2``; [Idtac | Ring]. -Rewrite Rinv_Rmult; DiscrR. -Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))*/(Rabsolu l2)))`` with ``eps*/4*((Rabsolu l2)*/(Rabsolu l2))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring]. -Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption). -Ring. -Symmetry; Apply Rabsolu_right; Left; Sup0. -Symmetry; Apply Rabsolu_right; Left; Sup. -Symmetry; Apply Rabsolu_right; Left; Assumption. -Apply prod_neq_R0; Assumption Orelse DiscrR. -Apply prod_neq_R0; Assumption. +Lemma maj_term4 : + forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) -> + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> + h <> 0 -> + Rabs h < alp_f2c -> + Rabs h < Rmin eps_f2 alp_f2 -> + f1 x <> 0 -> + l2 <> 0 -> + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) < + eps / 4. +intros. +assert (H9 := H2 h H5). +assert (H10 := H3 h H6). +apply Rle_lt_trans with + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +rewrite Rabs_mult. +apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply H9. +apply Rlt_le_trans with + (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) * + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +apply Rmult_lt_compat_r. +apply Rabs_pos_lt. +unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + assumption || idtac. +red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H). +apply Rinv_neq_0_compat; apply prod_neq_R0. +apply prod_neq_R0. +discrR. +assumption. +assumption. +unfold Rdiv in |- *. +repeat rewrite Rinv_mult_distr; + try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption). +repeat rewrite Rabs_mult. +replace (Rabs 2) with 2. +replace + (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with + (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2)))); + [ idtac | ring ]. +replace + (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with + (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h))))); + [ idtac | ring ]. +repeat apply Rmult_lt_compat_l. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *; + apply prod_neq_R0; assumption. +repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ]. +rewrite <- (Rmult_comm 2). +unfold Rdiv in H10; exact H10. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +right; unfold Rsqr, Rdiv in |- *. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +rewrite Rinv_mult_distr; try assumption || discrR. +repeat rewrite Rabs_mult. +repeat rewrite Rabs_Rinv; try assumption || discrR. +replace (Rabs eps) with eps. +replace (Rabs 8) with 8. +replace (Rabs 2) with 2. +replace 8 with (4 * 2); [ idtac | ring ]. +rewrite Rinv_mult_distr; discrR. +replace + (2 * Rabs l2 * + (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) * + (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps * + (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with + (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). +ring. +symmetry in |- *; apply Rabs_right; left; prove_sup0. +symmetry in |- *; apply Rabs_right; left; prove_sup. +symmetry in |- *; apply Rabs_right; left; assumption. +apply prod_neq_R0; assumption || discrR. +apply prod_neq_R0; assumption. Qed. -Lemma D_x_no_cond : (x,a:R) ``a<>0`` -> (D_x no_cond x ``x+a``). -Intros. -Unfold D_x no_cond. -Split. -Trivial. -Apply Rminus_not_eq. -Unfold Rminus. -Rewrite Ropp_distr1. -Rewrite <- Rplus_assoc. -Rewrite Rplus_Ropp_r. -Rewrite Rplus_Ol. -Apply Ropp_neq; Assumption. +Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a). +intros. +unfold D_x, no_cond in |- *. +split. +trivial. +apply Rminus_not_eq. +unfold Rminus in |- *. +rewrite Ropp_plus_distr. +rewrite <- Rplus_assoc. +rewrite Rplus_opp_r. +rewrite Rplus_0_l. +apply Ropp_neq_0_compat; assumption. Qed. -Lemma Rabsolu_4 : (a,b,c,d:R) ``(Rabsolu (a+b+c+d)) <= (Rabsolu a) + (Rabsolu b) + (Rabsolu c) + (Rabsolu d)``. -Intros. -Apply Rle_trans with ``(Rabsolu (a+b)) + (Rabsolu (c+d))``. -Replace ``a+b+c+d`` with ``(a+b)+(c+d)``; [Apply Rabsolu_triang | Ring]. -Apply Rle_trans with ``(Rabsolu a) + (Rabsolu b) + (Rabsolu (c+d))``. -Apply Rle_compatibility_r. -Apply Rabsolu_triang. -Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility. -Apply Rabsolu_triang. +Lemma Rabs_4 : + forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d. +intros. +apply Rle_trans with (Rabs (a + b) + Rabs (c + d)). +replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ]. +apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)). +apply Rplus_le_compat_r. +apply Rabs_triang. +repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. +apply Rabs_triang. Qed. -Lemma Rlt_4 : (a,b,c,d,e,f,g,h:R) ``a < b`` -> ``c < d`` -> ``e < f `` -> ``g < h`` -> ``a+c+e+g < b+d+f+h``. -Intros; Apply Rlt_trans with ``b+c+e+g``. -Repeat Apply Rlt_compatibility_r; Assumption. -Repeat Rewrite Rplus_assoc; Apply Rlt_compatibility. -Apply Rlt_trans with ``d+e+g``. -Rewrite Rplus_assoc; Apply Rlt_compatibility_r; Assumption. -Rewrite Rplus_assoc; Apply Rlt_compatibility; Apply Rlt_trans with ``f+g``. -Apply Rlt_compatibility_r; Assumption. -Apply Rlt_compatibility; Assumption. +Lemma Rlt_4 : + forall a b c d e f g h:R, + a < b -> c < d -> e < f -> g < h -> a + c + e + g < b + d + f + h. +intros; apply Rlt_trans with (b + c + e + g). +repeat apply Rplus_lt_compat_r; assumption. +repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l. +apply Rlt_trans with (d + e + g). +rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption. +rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g). +apply Rplus_lt_compat_r; assumption. +apply Rplus_lt_compat_l; assumption. Qed. -Lemma Rmin_2 : (a,b,c:R) ``a < b`` -> ``a < c`` -> ``a < (Rmin b c)``. -Intros; Unfold Rmin; Case (total_order_Rle b c); Intro; Assumption. +Lemma Rmin_2 : forall a b c:R, a < b -> a < c -> a < Rmin b c. +intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption. Qed. -Lemma quadruple : (x:R) ``4*x == x + x + x + x``. -Intro; Ring. +Lemma quadruple : forall x:R, 4 * x = x + x + x + x. +intro; ring. Qed. -Lemma quadruple_var : (x:R) `` x == x/4 + x/4 + x/4 + x/4``. -Intro; Rewrite <- quadruple. -Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m; DiscrR. -Reflexivity. +Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4. +intro; rewrite <- quadruple. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR. +reflexivity. Qed. (**********) -Lemma continuous_neq_0 : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (EXT eps : posreal | (h:R) ``(Rabsolu h) < eps`` -> ~``(f (x0+h))==0``). -Intros; Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Elim (H ``(Rabsolu ((f x0)/2))``). -Intros; Elim H1; Intros. -Exists (mkposreal x H2). -Intros; Assert H5 := (H3 ``x0+h``). -Cut ``(dist R_met (x0+h) x0) < x`` -> ``(dist R_met (f (x0+h)) (f x0)) < (Rabsolu ((f x0)/2))``. -Unfold dist; Simpl; Unfold R_dist; Replace ``x0+h-x0`` with h. -Intros; Assert H7 := (H6 H4). -Red; Intro. -Rewrite H8 in H7; Unfold Rminus in H7; Rewrite Rplus_Ol in H7; Rewrite Rabsolu_Ropp in H7; Unfold Rdiv in H7; Rewrite Rabsolu_mult in H7; Pattern 1 ``(Rabsolu (f x0)) `` in H7; Rewrite <- Rmult_1r in H7. -Cut ``0<(Rabsolu (f x0))``. -Intro; Assert H10 := (Rlt_monotony_contra ? ? ? H9 H7). -Cut ``(Rabsolu (/2))==/2``. -Assert Hyp:``0<2``. -Sup0. -Intro; Rewrite H11 in H10; Assert H12 := (Rlt_monotony ``2`` ? ? Hyp H10); Rewrite Rmult_1r in H12; Rewrite <- Rinv_r_sym in H12; [Idtac | DiscrR]. -Cut (Rlt (IZR `1`) (IZR `2`)). -Unfold IZR; Unfold INR convert; Simpl; Intro; Elim (Rlt_antirefl ``1`` (Rlt_trans ? ? ? H13 H12)). -Apply IZR_lt; Omega. -Unfold Rabsolu; Case (case_Rabsolu ``/2``); Intro. -Assert Hyp:``0<2``. -Sup0. -Assert H11 := (Rlt_monotony ``2`` ? ? Hyp r); Rewrite Rmult_Or in H11; Rewrite <- Rinv_r_sym in H11; [Idtac | DiscrR]. -Elim (Rlt_antirefl ``0`` (Rlt_trans ? ? ? Rlt_R0_R1 H11)). -Reflexivity. -Apply (Rabsolu_pos_lt ? H0). -Ring. -Assert H6 := (Req_EM ``x0`` ``x0+h``); Elim H6; Intro. -Intro; Rewrite <- H7; Unfold dist R_met; Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt. -Unfold Rdiv; Apply prod_neq_R0; [Assumption | Apply Rinv_neq_R0; DiscrR]. -Intro; Apply H5. -Split. -Unfold D_x no_cond. -Split; Trivial Orelse Assumption. -Assumption. -Change ``0 < (Rabsolu ((f x0)/2))``. -Apply Rabsolu_pos_lt; Unfold Rdiv; Apply prod_neq_R0. -Assumption. -Apply Rinv_neq_R0; DiscrR. -Qed. +Lemma continuous_neq_0 : + forall (f:R -> R) (x0:R), + continuity_pt f x0 -> + f x0 <> 0 -> + exists eps : posreal | (forall h:R, Rabs h < eps -> f (x0 + h) <> 0). +intros; unfold continuity_pt in H; unfold continue_in in H; + unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (f x0 / 2))). +intros; elim H1; intros. +exists (mkposreal x H2). +intros; assert (H5 := H3 (x0 + h)). +cut + (dist R_met (x0 + h) x0 < x -> + dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)). +unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + replace (x0 + h - x0) with h. +intros; assert (H7 := H6 H4). +red in |- *; intro. +rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7; + rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7; + pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7. +cut (0 < Rabs (f x0)). +intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7). +cut (Rabs (/ 2) = / 2). +assert (Hyp : 0 < 2). +prove_sup0. +intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10); + rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; + [ idtac | discrR ]. +cut (IZR 1 < IZR 2). +unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro; + elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)). +apply IZR_lt; omega. +unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro. +assert (Hyp : 0 < 2). +prove_sup0. +assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11; + rewrite <- Rinv_r_sym in H11; [ idtac | discrR ]. +elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)). +reflexivity. +apply (Rabs_pos_lt _ H0). +ring. +assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro. +intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *; + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rabs_pos_lt. +unfold Rdiv in |- *; apply prod_neq_R0; + [ assumption | apply Rinv_neq_0_compat; discrR ]. +intro; apply H5. +split. +unfold D_x, no_cond in |- *. +split; trivial || assumption. +assumption. +change (0 < Rabs (f x0 / 2)) in |- *. +apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0. +assumption. +apply Rinv_neq_0_compat; discrR. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v index e8af542ac..1e0991e15 100644 --- a/theories/Reals/Ranalysis3.v +++ b/theories/Reals/Ranalysis3.v @@ -8,610 +8,786 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Ranalysis1. -Require Ranalysis2. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import Ranalysis2. Open Local Scope R_scope. (* Division *) -Theorem derivable_pt_lim_div : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> ~``(f2 x)==0``-> (derivable_pt_lim (div_fct f1 f2) x ``(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))``). -Intros. -Cut (derivable_pt f2 x); [Intro | Unfold derivable_pt; Apply Specif.existT with l2; Exact H0]. -Assert H2 := ((continuous_neq_0 ? ? (derivable_continuous_pt ? ? X)) H1). -Elim H2; Clear H2; Intros eps_f2 H2. -Unfold div_fct. -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 ``(Rabsolu (f2 x))/2``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (f2 x))*/2``; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0]]. -Clear H3; Intros alp_f2 H3. -Cut (x0:R) ``(Rabsolu (x0-x)) < alp_f2`` ->``(Rabsolu ((f2 x0)-(f2 x))) < (Rabsolu (f2 x))/2``. -Intro H4. -Cut (a:R) ``(Rabsolu (a-x)) < alp_f2``->``(Rabsolu (f2 x))/2 < (Rabsolu (f2 a))``. -Intro H5. -Cut (a:R) ``(Rabsolu (a)) < (Rmin eps_f2 alp_f2)`` -> ``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``. -Intro Maj. -Unfold derivable_pt_lim; Intros. -Elim (H ``(Rabsolu ((eps*(f2 x))/8))``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (eps*(f2 x)*/8))``; Apply Rabsolu_pos_lt; Repeat Apply prod_neq_R0; [Red; Intro H7; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6) | Assumption | Apply Rinv_neq_R0; DiscrR]]. -Intros alp_f1d H7. -Case (Req_EM (f1 x) R0); Intro. -Case (Req_EM l1 R0); Intro. +Theorem derivable_pt_lim_div : + forall (f1 f2:R -> R) (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> + f2 x <> 0 -> + derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)). +intros. +cut (derivable_pt f2 x); + [ intro | unfold derivable_pt in |- *; apply existT with l2; exact H0 ]. +assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1). +elim H2; clear H2; intros eps_f2 H2. +unfold div_fct in |- *. +assert (H3 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3; + unfold limit_in in H3; unfold dist in H3. +simpl in H3; unfold R_dist in H3. +elim (H3 (Rabs (f2 x) / 2)); + [ idtac + | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *; + apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +clear H3; intros alp_f2 H3. +cut + (forall x0:R, + Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2). +intro H4. +cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)). +intro H5. +cut + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)). +intro Maj. +unfold derivable_pt_lim in |- *; intros. +elim (H (Rabs (eps * f2 x / 8))); + [ idtac + | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *; + apply Rabs_pos_lt; repeat apply prod_neq_R0; + [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) + | assumption + | apply Rinv_neq_0_compat; discrR ] ]. +intros alp_f1d H7. +case (Req_dec (f1 x) 0); intro. +case (Req_dec l1 0); intro. (***********************************) (* Cas n° 1 *) (* (f1 x)=0 l1 =0 *) (***********************************) -Cut ``0 < (Rmin eps_f2 (Rmin alp_f2 alp_f1d))``; [Intro | Repeat Apply Rmin_pos; [Apply (cond_pos eps_f2) | Elim H3; Intros; Assumption | Apply (cond_pos alp_f1d)]]. -Exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). -Simpl; Intros. -Assert H13 := (Rlt_le_trans ? ? ? H12 (Rmin_r ? ?)). -Assert H14 := (Rlt_le_trans ? ? ? H12 (Rmin_l ? ?)). -Assert H15 := (Rlt_le_trans ? ? ? H13 (Rmin_r ? ?)). -Assert H16 := (Rlt_le_trans ? ? ? H13 (Rmin_l ? ?)). -Assert H17 := (H7 ? H11 H15). -Rewrite formule; [Idtac | Assumption | Assumption | Apply H2; Apply H14]. -Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``. -Unfold Rminus. -Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``). -Apply Rabsolu_4. -Repeat Rewrite Rabsolu_mult. -Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``. -Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``. -Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``. -Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``. -Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``. -Intros. -Apply Rlt_4; Assumption. -Rewrite H8. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite H8. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite H9. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite <- Rabsolu_mult. -Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption Orelse Apply H2. -Apply H14. -Apply Rmin_2; Assumption. -Right; Symmetry; Apply quadruple_var. +cut (0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d)); + [ intro + | repeat apply Rmin_pos; + [ apply (cond_pos eps_f2) + | elim H3; intros; assumption + | apply (cond_pos alp_f1d) ] ]. +exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). +simpl in |- *; intros. +assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)). +assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)). +assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)). +assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)). +assert (H17 := H7 _ H11 H15). +rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ]. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite H9. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); + try assumption || apply H2. +apply H14. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. (***********************************) (* Cas n° 2 *) (* (f1 x)=0 l1<>0 *) (***********************************) -Assert H10 := (derivable_continuous_pt ? ? X). -Unfold continuity_pt in H10. -Unfold continue_in in H10. -Unfold limit1_in in H10. -Unfold limit_in in H10. -Unfold dist in H10. -Simpl in H10. -Unfold R_dist in H10. -Elim (H10 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``). -Clear H10; Intros alp_f2t2 H10. -Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a)) - (f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Intro H11. -Cut ``0 < (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2))``. -Intro. -Exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12). -Simpl. -Intros. -Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)). -Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)). -Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)). -Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)). -Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)). -Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)). -Clear H14 H15 H16. -Rewrite formule; Try Assumption. -Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``. -Unfold Rminus. -Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``). -Apply Rabsolu_4. -Repeat Rewrite Rabsolu_mult. -Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``. -Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``. -Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``. -Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``. -Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``. -Intros. -Apply Rlt_4; Assumption. -Rewrite H8. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite H8. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite <- Rabsolu_mult. -Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_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; Apply quadruple_var. -Apply H2; Assumption. -Repeat Apply Rmin_pos. -Apply (cond_pos eps_f2). -Apply (cond_pos alp_f1d). -Elim H3; Intros; Assumption. -Elim H10; Intros; Assumption. -Intros. -Elim H10; Intros. -Case (Req_EM a R0); Intro. -Rewrite H14; Rewrite Rplus_Or. -Unfold Rminus; Rewrite Rplus_Ropp_r. -Rewrite Rabsolu_R0. -Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc. -Repeat Apply prod_neq_R0; Try Assumption. -Red; Intro; Rewrite H15 in H6; Elim (Rlt_antirefl ? H6). -Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse Assumption. -Apply H13. -Split. -Apply D_x_no_cond; Assumption. -Replace ``x+a-x`` with a; [Assumption | Ring]. -Change ``0<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0. -Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6). -Assumption. -Assumption. -Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; [DiscrR | DiscrR | DiscrR | Assumption]. +assert (H10 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H10. +unfold continue_in in H10. +unfold limit1_in in H10. +unfold limit_in in H10. +unfold dist in H10. +simpl in H10. +unfold R_dist in H10. +elim (H10 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). +clear H10; intros alp_f2t2 H10. +cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). +intro H11. +cut (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)). +intro. +exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12). +simpl in |- *. +intros. +assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). +assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). +assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). +assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). +clear H14 H15 H16. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite H8. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +apply (cond_pos alp_f1d). +elim H3; intros; assumption. +elim H10; intros; assumption. +intros. +elim H10; intros. +case (Req_dec a 0); intro. +rewrite H14; rewrite Rplus_0_r. +unfold Rminus in |- *; rewrite Rplus_opp_r. +rewrite Rabs_R0. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc. +repeat apply prod_neq_R0; try assumption. +red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption. +apply H13. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. +apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; + repeat apply prod_neq_R0. +red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). +assumption. +assumption. +apply Rinv_neq_0_compat; repeat apply prod_neq_R0; + [ discrR | discrR | discrR | assumption ]. (***********************************) (* Cas n° 3 *) (* (f1 x)<>0 l1=0 l2=0 *) (***********************************) -Case (Req_EM l1 R0); Intro. -Case (Req_EM l2 R0); Intro. -Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0; [Assumption | Assumption | Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6) | Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse 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. -Intros. -Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)). -Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)). -Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)). -Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)). -Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)). -Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)). -Clear H15 H16. -Rewrite formule; Try Assumption. -Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``. -Unfold Rminus. -Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``). -Apply Rabsolu_4. -Repeat Rewrite Rabsolu_mult. -Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``. -Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``. -Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``. -Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``. -Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``. -Intros. -Apply Rlt_4; Assumption. -Rewrite H10. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite <- Rabsolu_mult. -Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite H9. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite <- Rabsolu_mult. -Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Assumption Orelse Idtac. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Right; Symmetry; Apply quadruple_var. -Apply H2; Assumption. -Repeat Apply Rmin_pos. -Apply (cond_pos eps_f2). -Elim H3; Intros; Assumption. -Apply (cond_pos alp_f1d). -Apply (cond_pos alp_f2d). +case (Req_dec l1 0); intro. +case (Req_dec l2 0); intro. +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); + [ idtac + | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; + repeat apply prod_neq_R0; + [ assumption + | assumption + | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6) + | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ]. +intros alp_f2d H12. +cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)). +intro. +exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11). +simpl in |- *. +intros. +assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). +assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). +assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). +assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). +clear H15 H16. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H10. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite H9. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). (***********************************) (* Cas n° 4 *) (* (f1 x)<>0 l1=0 l2<>0 *) (***********************************) -Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rsqr Rdiv; Repeat Rewrite Rinv_Rmult; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR]. -Intros alp_f2d H11. -Assert H12 := (derivable_continuous_pt ? ? X). -Unfold continuity_pt in H12. -Unfold continue_in in H12. -Unfold limit1_in in H12. -Unfold limit_in in H12. -Unfold dist in H12. -Simpl in H12. -Unfold R_dist in H12. -Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``). -Intros alp_f2c H13. -Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))``. -Intro. -Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) H14). -Simpl; Intros. -Assert H17 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)). -Assert H18 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)). -Assert H19 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)). -Assert H20 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)). -Assert H21 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)). -Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)). -Assert H23 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)). -Assert H24 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)). -Clear H16 H17 H18 H19. -Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``. -Intro. -Rewrite formule; Try Assumption. -Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``. -Unfold Rminus. -Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``). -Apply Rabsolu_4. -Repeat Rewrite Rabsolu_mult. -Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``. -Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``. -Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``. -Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``. -Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``. -Intros. -Apply Rlt_4; Assumption. -Rewrite <- Rabsolu_mult. -Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_mult. -Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite H9. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite <- Rabsolu_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; Apply quadruple_var. -Apply H2; Assumption. -Intros. -Case (Req_EM a R0); Intro. -Rewrite H17; Rewrite Rplus_Or. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0. -Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr. -Repeat Rewrite Rinv_Rmult; Try Assumption. -Repeat Apply prod_neq_R0; Try Assumption. -Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6). -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; Assumption. -Apply Rinv_neq_R0; Assumption. -DiscrR. -DiscrR. -DiscrR. -DiscrR. -DiscrR. -Apply prod_neq_R0; [DiscrR | Assumption]. -Elim H13; Intros. -Apply H19. -Split. -Apply D_x_no_cond; Assumption. -Replace ``x+a-x`` with a; [Assumption | Ring]. -Repeat Apply Rmin_pos. -Apply (cond_pos eps_f2). -Elim H3; Intros; Assumption. -Apply (cond_pos alp_f1d). -Apply (cond_pos alp_f2d). -Elim H13; Intros; Assumption. -Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``. -Apply Rabsolu_pos_lt. -Unfold Rsqr Rdiv. -Repeat Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR. -Repeat Apply prod_neq_R0; Try Assumption. -Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6). -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; Assumption. -Apply Rinv_neq_R0; Assumption. -Apply prod_neq_R0; [DiscrR | Assumption]. -Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6). -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; DiscrR. -Apply Rinv_neq_R0; Assumption. +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); + [ idtac + | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *; + repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0; + try assumption || discrR ]. +intros alp_f2d H11. +assert (H12 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H12. +unfold continue_in in H12. +unfold limit1_in in H12. +unfold limit_in in H12. +unfold dist in H12. +simpl in H12. +unfold R_dist in H12. +elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). +intros alp_f2c H13. +cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))). +intro. +exists + (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) + H14). +simpl in |- *; intros. +assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). +assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). +assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). +assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). +assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). +assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). +clear H16 H17 H18 H19. +cut + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +intro. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite <- Rabs_mult. +apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite H9. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +intros. +case (Req_dec a 0); intro. +rewrite H17; rewrite Rplus_0_r. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *. +repeat rewrite Rinv_mult_distr; try assumption. +repeat apply prod_neq_R0; try assumption. +red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; assumption. +apply Rinv_neq_0_compat; assumption. +discrR. +discrR. +discrR. +discrR. +discrR. +apply prod_neq_R0; [ discrR | assumption ]. +elim H13; intros. +apply H19. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +elim H13; intros; assumption. +change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *. +apply Rabs_pos_lt. +unfold Rsqr, Rdiv in |- *. +repeat rewrite Rinv_mult_distr; try assumption || discrR. +repeat apply prod_neq_R0; try assumption. +red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; assumption. +apply Rinv_neq_0_compat; assumption. +apply prod_neq_R0; [ discrR | assumption ]. +red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; discrR. +apply Rinv_neq_0_compat; assumption. (***********************************) (* Cas n° 5 *) (* (f1 x)<>0 l1<>0 l2=0 *) (***********************************) -Case (Req_EM l2 R0); Intro. -Assert H11 := (derivable_continuous_pt ? ? X). -Unfold continuity_pt in H11. -Unfold continue_in in H11. -Unfold limit1_in in H11. -Unfold limit_in in H11. -Unfold dist in H11. -Simpl in H11. -Unfold R_dist in H11. -Elim (H11 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``). -Clear H11; Intros alp_f2t2 H11. -Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``). -Intros alp_f2d H12. -Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2)))``. -Intro. -Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). -Simpl. -Intros. -Cut (a:R) ``(Rabsolu a)<alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x)))<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Intro. -Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)). -Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)). -Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)). -Assert H20 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)). -Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)). -Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)). -Assert H23 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)). -Assert H24 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)). -Clear H15 H17 H18 H21. -Rewrite formule; Try Assumption. -Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``. -Unfold Rminus. -Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``). -Apply Rabsolu_4. -Repeat Rewrite Rabsolu_mult. -Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``. -Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``. -Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``. -Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``. -Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``. -Intros. -Apply Rlt_4; Assumption. -Rewrite H10. -Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol. -Rewrite Rabsolu_R0; Rewrite Rmult_Ol. -Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup]. -Rewrite <- Rabsolu_mult. -Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_mult. -Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_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; Apply quadruple_var. -Apply H2; Assumption. -Intros. -Case (Req_EM a R0); Intro. -Rewrite H17; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0. -Apply Rabsolu_pos_lt. -Unfold Rdiv; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption. -Unfold Rsqr. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6)). -Elim H11; Intros. -Apply H19. -Split. -Apply D_x_no_cond; Assumption. -Replace ``x+a-x`` with a; [Assumption | Ring]. -Repeat Apply Rmin_pos. -Apply (cond_pos eps_f2). -Elim H3; Intros; Assumption. -Apply (cond_pos alp_f1d). -Apply (cond_pos alp_f2d). -Elim H11; Intros; Assumption. -Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)). -Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)). +case (Req_dec l2 0); intro. +assert (H11 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H11. +unfold continue_in in H11. +unfold limit1_in in H11. +unfold limit_in in H11. +unfold dist in H11. +simpl in H11. +unfold R_dist in H11. +elim (H11 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). +clear H11; intros alp_f2t2 H11. +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). +intros alp_f2d H12. +cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))). +intro. +exists + (mkposreal + (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). +simpl in |- *. +intros. +cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). +intro. +assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). +assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). +assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). +assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). +assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). +assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). +assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). +assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). +clear H15 H17 H18 H21. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite H10. +unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. +rewrite Rabs_R0; rewrite Rmult_0_l. +apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +intros. +case (Req_dec a 0); intro. +rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0. +apply Rabs_pos_lt. +unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +unfold Rsqr in |- *. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)). +elim H11; intros. +apply H19. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +elim H11; intros; assumption. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). +change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). (***********************************) (* Cas n° 6 *) (* (f1 x)<>0 l1<>0 l2<>0 *) (***********************************) -Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``). -Intros alp_f2d H11. -Assert H12 := (derivable_continuous_pt ? ? X). -Unfold continuity_pt in H12. -Unfold continue_in in H12. -Unfold limit1_in in H12. -Unfold limit_in in H12. -Unfold dist in H12. -Simpl in H12. -Unfold R_dist in H12. -Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``). -Intros alp_f2c H13. -Elim (H12 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``). -Intros alp_f2t2 H14. -Cut ``0 < (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2))``. -Intro. -Exists (mkposreal (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)) H15). -Simpl. -Intros. -Assert H18 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)). -Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)). -Assert H20 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)). -Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)). -Assert H22 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)). -Assert H23 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)). -Assert H24 := (Rlt_le_trans ? ? ? H20 (Rmin_l ? ?)). -Assert H25 := (Rlt_le_trans ? ? ? H20 (Rmin_r ? ?)). -Assert H26 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)). -Assert H27 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)). -Clear H17 H18 H19 H20 H21. -Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``. -Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``. -Intros. -Rewrite formule; Try Assumption. -Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``. -Unfold Rminus. -Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``). -Apply Rabsolu_4. -Repeat Rewrite Rabsolu_mult. -Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``. -Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``. -Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``. -Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``. -Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``. -Intros. -Apply Rlt_4; Assumption. -Rewrite <- Rabsolu_mult. -Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_mult. -Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_mult. -Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption. -Apply H2; Assumption. -Apply Rmin_2; Assumption. -Rewrite <- Rabsolu_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; Apply quadruple_var. -Apply H2; Assumption. -Intros. -Case (Req_EM a R0); Intro. -Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)). -Apply prod_neq_R0; [DiscrR | Assumption]. -Apply prod_neq_R0; [DiscrR | Assumption]. -Assumption. -Elim H13; Intros. -Apply H20. -Split. -Apply D_x_no_cond; Assumption. -Replace ``x+a-x`` with a; [Assumption | Ring]. -Intros. -Case (Req_EM a R0); Intro. -Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)). -DiscrR. -Assumption. -Elim H14; Intros. -Apply H20. -Split. -Unfold D_x no_cond; Split. -Trivial. -Apply Rminus_not_eq_right. -Replace ``x+a-x`` with a; [Assumption | Ring]. -Replace ``x+a-x`` with a; [Assumption | Ring]. -Repeat Apply Rmin_pos. -Apply (cond_pos eps_f2). -Elim H3; Intros; Assumption. -Apply (cond_pos alp_f1d). -Apply (cond_pos alp_f2d). -Elim H13; Intros; Assumption. -Elim H14; Intros; Assumption. -Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``; Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H14; Rewrite H14 in H6; Elim (Rlt_antirefl ? H6)). -Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``; Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6)). -Apply prod_neq_R0; [DiscrR | Assumption]. -Apply prod_neq_R0; [DiscrR | Assumption]. -Assumption. -Apply Rabsolu_pos_lt. -Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; [Idtac | DiscrR | Assumption]. -Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6)). -Intros. -Unfold Rdiv. -Apply Rlt_monotony_contra with ``(Rabsolu (f2 (x+a)))``. -Apply Rabsolu_pos_lt; Apply H2. -Apply Rlt_le_trans with (Rmin eps_f2 alp_f2). -Assumption. -Apply Rmin_l. -Rewrite <- Rinv_r_sym. -Apply Rlt_monotony_contra with (Rabsolu (f2 x)). -Apply Rabsolu_pos_lt; Assumption. -Rewrite Rmult_1r. -Rewrite (Rmult_sym (Rabsolu (f2 x))). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Apply Rlt_monotony_contra with ``/2``. -Apply Rlt_Rinv; Sup0. -Repeat Rewrite (Rmult_sym ``/2``). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r. -Unfold Rdiv in H5; Apply H5. -Replace ``x+a-x`` with a. -Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_r ? ?)); Assumption. -Ring. -DiscrR. -Apply Rabsolu_no_R0; Assumption. -Apply Rabsolu_no_R0; Apply H2. -Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_l ? ?)); Assumption. -Intros. -Assert H6 := (H4 a H5). -Rewrite <- (Rabsolu_Ropp ``(f2 a)-(f2 x)``) in H6. -Rewrite Ropp_distr2 in H6. -Assert H7 := (Rle_lt_trans ? ? ? (Rabsolu_triang_inv ? ?) H6). -Apply Rlt_anti_compatibility with ``-(Rabsolu (f2 a)) + (Rabsolu (f2 x))/2``. -Rewrite Rplus_assoc. -Rewrite <- double_var. -Do 2 Rewrite (Rplus_sym ``-(Rabsolu (f2 a))``). -Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or. -Unfold Rminus in H7; Assumption. -Intros. -Case (Req_EM x x0); Intro. -Rewrite <- H5; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0]. -Elim H3; Intros. -Apply H7. -Split. -Unfold D_x no_cond; Split. -Trivial. -Assumption. -Assumption. +elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). +intros alp_f2d H11. +assert (H12 := derivable_continuous_pt _ _ X). +unfold continuity_pt in H12. +unfold continue_in in H12. +unfold limit1_in in H12. +unfold limit_in in H12. +unfold dist in H12. +simpl in H12. +unfold R_dist in H12. +elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). +intros alp_f2c H13. +elim (H12 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). +intros alp_f2t2 H14. +cut + (0 < + Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) + (Rmin alp_f2c alp_f2t2)). +intro. +exists + (mkposreal + (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) + (Rmin alp_f2c alp_f2t2)) H15). +simpl in |- *. +intros. +assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). +assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). +assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). +assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). +assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). +assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). +assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)). +assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)). +assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). +assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). +clear H17 H18 H19 H20 H21. +cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). +cut + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). +intros. +rewrite formule; try assumption. +apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). +unfold Rminus in |- *. +rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . +apply Rabs_4. +repeat rewrite Rabs_mult. +apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). +cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). +cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). +cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). +cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). +intros. +apply Rlt_4; assumption. +rewrite <- Rabs_mult. +apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +rewrite <- Rabs_mult. +apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. +apply H2; assumption. +apply Rmin_2; assumption. +right; symmetry in |- *; apply quadruple_var. +apply H2; assumption. +intros. +case (Req_dec a 0); intro. +rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). +apply prod_neq_R0; [ discrR | assumption ]. +apply prod_neq_R0; [ discrR | assumption ]. +assumption. +elim H13; intros. +apply H20. +split. +apply D_x_no_cond; assumption. +replace (x + a - x) with a; [ assumption | ring ]. +intros. +case (Req_dec a 0); intro. +rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). +discrR. +assumption. +elim H14; intros. +apply H20. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply Rminus_not_eq_right. +replace (x + a - x) with a; [ assumption | ring ]. +replace (x + a - x) with a; [ assumption | ring ]. +repeat apply Rmin_pos. +apply (cond_pos eps_f2). +elim H3; intros; assumption. +apply (cond_pos alp_f1d). +apply (cond_pos alp_f2d). +elim H13; intros; assumption. +elim H14; intros; assumption. +change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)). +change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *; + apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)). +apply prod_neq_R0; [ discrR | assumption ]. +apply prod_neq_R0; [ discrR | assumption ]. +assumption. +apply Rabs_pos_lt. +unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; + [ idtac | discrR | assumption ]. +repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)). +intros. +unfold Rdiv in |- *. +apply Rmult_lt_reg_l with (Rabs (f2 (x + a))). +apply Rabs_pos_lt; apply H2. +apply Rlt_le_trans with (Rmin eps_f2 alp_f2). +assumption. +apply Rmin_l. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (Rabs (f2 x)). +apply Rabs_pos_lt; assumption. +rewrite Rmult_1_r. +rewrite (Rmult_comm (Rabs (f2 x))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +apply Rmult_lt_reg_l with (/ 2). +apply Rinv_0_lt_compat; prove_sup0. +repeat rewrite (Rmult_comm (/ 2)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +unfold Rdiv in H5; apply H5. +replace (x + a - x) with a. +assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption. +ring. +discrR. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; apply H2. +assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption. +intros. +assert (H6 := H4 a H5). +rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6. +rewrite Ropp_minus_distr in H6. +assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6). +apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2). +rewrite Rplus_assoc. +rewrite <- double_var. +do 2 rewrite (Rplus_comm (- Rabs (f2 a))). +rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +unfold Rminus in H7; assumption. +intros. +case (Req_dec x x0); intro. +rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H3; intros. +apply H7. +split. +unfold D_x, no_cond in |- *; split. +trivial. +assumption. +assumption. Qed. -Lemma derivable_pt_div : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> ``(f2 x)<>0`` -> (derivable_pt (div_fct f1 f2) x). -Unfold derivable_pt. -Intros. -Elim X; Intros. -Elim X0; Intros. -Apply Specif.existT with ``(x0*(f2 x)-x1*(f1 x))/(Rsqr (f2 x))``. -Apply derivable_pt_lim_div; Assumption. +Lemma derivable_pt_div : + forall (f1 f2:R -> R) (x:R), + derivable_pt f1 x -> + derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x. +unfold derivable_pt in |- *. +intros. +elim X; intros. +elim X0; intros. +apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)). +apply derivable_pt_lim_div; assumption. Qed. -Lemma derivable_div : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> ((x:R)``(f2 x)<>0``) -> (derivable (div_fct f1 f2)). -Unfold derivable; Intros. -Apply (derivable_pt_div ? ? ? (X x) (X0 x) (H x)). +Lemma derivable_div : + forall f1 f2:R -> R, + derivable f1 -> + derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2). +unfold derivable in |- *; intros. +apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)). Qed. -Lemma derive_pt_div : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x);na:``(f2 x)<>0``) ``(derive_pt (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)) == ((derive_pt f1 x pr1)*(f2 x)-(derive_pt f2 x pr2)*(f1 x))/(Rsqr (f2 x))``. -Intros. -Assert H := (derivable_derive f1 x pr1). -Assert H0 := (derivable_derive f2 x pr2). -Assert H1 := (derivable_derive (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)). -Elim H; Clear H; Intros l1 H. -Elim H0; Clear H0; Intros l2 H0. -Elim H1; Clear H1; Intros l H1. -Rewrite H; Rewrite H0; Apply derive_pt_eq_0. -Assert H3 := (projT2 ? ? pr1). -Unfold derive_pt in H; Rewrite H in H3. -Assert H4 := (projT2 ? ? pr2). -Unfold derive_pt in H0; Rewrite H0 in H4. -Apply derivable_pt_lim_div; Assumption. -Qed. +Lemma derive_pt_div : + forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) + (pr2:derivable_pt f2 x) (na:f2 x <> 0), + derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) = + (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x). +intros. +assert (H := derivable_derive f1 x pr1). +assert (H0 := derivable_derive f2 x pr2). +assert + (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)). +elim H; clear H; intros l1 H. +elim H0; clear H0; intros l2 H0. +elim H1; clear H1; intros l H1. +rewrite H; rewrite H0; apply derive_pt_eq_0. +assert (H3 := projT2 pr1). +unfold derive_pt in H; rewrite H in H3. +assert (H4 := projT2 pr2). +unfold derive_pt in H0; rewrite H0 in H4. +apply derivable_pt_lim_div; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v index 6db2609a9..16d478fe4 100644 --- a/theories/Reals/Ranalysis4.v +++ b/theories/Reals/Ranalysis4.v @@ -8,306 +8,377 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require Ranalysis1. -Require Ranalysis3. -Require Exp_prop. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import Ranalysis3. +Require Import Exp_prop. Open Local Scope R_scope. (**********) -Lemma derivable_pt_inv : (f:R->R;x:R) ``(f x)<>0`` -> (derivable_pt f x) -> (derivable_pt (inv_fct f) x). -Intros; Cut (derivable_pt (div_fct (fct_cte R1) f) x) -> (derivable_pt (inv_fct f) x). -Intro; Apply X0. -Apply derivable_pt_div. -Apply derivable_pt_const. -Assumption. -Assumption. -Unfold div_fct inv_fct fct_cte; Intro; Elim X0; Intros; Unfold derivable_pt; Apply Specif.existT with 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; Rewrite <- (Rmult_1l ``/(f x)``); Rewrite <- (Rmult_1l ``/(f (x+h))``). -Apply H1; Assumption. +Lemma derivable_pt_inv : + forall (f:R -> R) (x:R), + f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x. +intros; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x). +intro; apply X0. +apply derivable_pt_div. +apply derivable_pt_const. +assumption. +assumption. +unfold div_fct, inv_fct, fct_cte in |- *; intro; elim X0; intros; + unfold derivable_pt in |- *; apply existT with x0; + unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *; + unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; + intros; elim (p eps H0); intros; exists x1; intros; + unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x)); + rewrite <- (Rmult_1_l (/ f (x + h))). +apply H1; assumption. Qed. (**********) -Lemma pr_nu_var : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) f==g -> (derive_pt f x pr1) == (derive_pt g x pr2). -Unfold derivable_pt derive_pt; Intros. -Elim pr1; Intros. -Elim pr2; Intros. -Simpl. -Rewrite H in p. -Apply unicite_limite with g x; Assumption. +Lemma pr_nu_var : + forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), + f = g -> derive_pt f x pr1 = derive_pt g x pr2. +unfold derivable_pt, derive_pt in |- *; intros. +elim pr1; intros. +elim pr2; intros. +simpl in |- *. +rewrite H in p. +apply uniqueness_limite with g x; assumption. Qed. (**********) -Lemma pr_nu_var2 : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) ((h:R)(f h)==(g h)) -> (derive_pt f x pr1) == (derive_pt g x pr2). -Unfold derivable_pt derive_pt; Intros. -Elim pr1; Intros. -Elim pr2; Intros. -Simpl. -Assert H0 := (unicite_step2 ? ? ? p). -Assert H1 := (unicite_step2 ? ? ? p0). -Cut (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h <> 0`` x1 ``0``). -Intro; Assert H3 := (unicite_step1 ? ? ? ? H0 H2). -Assumption. -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. -Elim H3; Intros. -Exists x2. -Split. -Assumption. -Intros; Do 2 Rewrite H; Apply H5; Assumption. +Lemma pr_nu_var2 : + forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), + (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. +unfold derivable_pt, derive_pt in |- *; intros. +elim pr1; intros. +elim pr2; intros. +simpl in |- *. +assert (H0 := uniqueness_step2 _ _ _ p). +assert (H1 := uniqueness_step2 _ _ _ p0). +cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0). +intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). +assumption. +unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1; + unfold limit_in in H1; unfold dist in H1; simpl in H1; + unfold R_dist in H1. +intros; elim (H1 eps H2); intros. +elim H3; intros. +exists x2. +split. +assumption. +intros; do 2 rewrite H; apply H5; assumption. Qed. (**********) -Lemma derivable_inv : (f:R->R) ((x:R)``(f x)<>0``)->(derivable f)->(derivable (inv_fct f)). -Intros. -Unfold derivable; Intro. -Apply derivable_pt_inv. -Apply (H x). -Apply (X x). +Lemma derivable_inv : + forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f). +intros. +unfold derivable in |- *; intro. +apply derivable_pt_inv. +apply (H x). +apply (X x). Qed. -Lemma derive_pt_inv : (f:R->R;x:R;pr:(derivable_pt f x);na:``(f x)<>0``) (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) == ``-(derive_pt f x pr)/(Rsqr (f x))``. -Intros; Replace (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) with (derive_pt (div_fct (fct_cte R1) f) x (derivable_pt_div (fct_cte R1) f x (derivable_pt_const R1 x) pr na)). -Rewrite derive_pt_div; Rewrite derive_pt_const; Unfold fct_cte; Rewrite Rmult_Ol; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_Ol; Reflexivity. -Apply pr_nu_var2. -Intro; Unfold div_fct fct_cte inv_fct. -Unfold Rdiv; Ring. +Lemma derive_pt_inv : + forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0), + derive_pt (/ f) x (derivable_pt_inv f x na pr) = + - derive_pt f x pr / Rsqr (f x). +intros; + replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with + (derive_pt (fct_cte 1 / f) x + (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)). +rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *; + rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Rplus_0_l; reflexivity. +apply pr_nu_var2. +intro; unfold div_fct, fct_cte, inv_fct in |- *. +unfold Rdiv in |- *; ring. Qed. (* Rabsolu *) -Lemma Rabsolu_derive_1 : (x:R) ``0<x`` -> (derivable_pt_lim Rabsolu x ``1``). -Intros. -Unfold derivable_pt_lim; Intros. -Exists (mkposreal x H); Intros. -Rewrite (Rabsolu_right x). -Rewrite (Rabsolu_right ``x+h``). -Rewrite Rplus_sym. -Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r. -Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym. -Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0. -Apply H1. -Apply Rle_sym1. -Case (case_Rabsolu h); Intro. -Rewrite (Rabsolu_left h r) in H2. -Left; Rewrite Rplus_sym; Apply Rlt_anti_compatibility with ``-h``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H2. -Apply ge0_plus_ge0_is_ge0. -Left; Apply H. -Apply Rle_sym2; Apply r. -Left; Apply H. +Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1. +intros. +unfold derivable_pt_lim in |- *; intros. +exists (mkposreal x H); intros. +rewrite (Rabs_right x). +rewrite (Rabs_right (x + h)). +rewrite Rplus_comm. +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r. +rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. +rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. +apply H1. +apply Rle_ge. +case (Rcase_abs h); intro. +rewrite (Rabs_left h r) in H2. +left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r; + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + apply H2. +apply Rplus_le_le_0_compat. +left; apply H. +apply Rge_le; apply r. +left; apply H. Qed. -Lemma Rabsolu_derive_2 : (x:R) ``x<0`` -> (derivable_pt_lim Rabsolu x ``-1``). -Intros. -Unfold derivable_pt_lim; Intros. -Cut ``0< -x``. -Intro; Exists (mkposreal ``-x`` H1); Intros. -Rewrite (Rabsolu_left x). -Rewrite (Rabsolu_left ``x+h``). -Rewrite Rplus_sym. -Rewrite Ropp_distr1. -Unfold Rminus; Rewrite Ropp_Ropp; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l. -Rewrite Rplus_Or; Unfold Rdiv. -Rewrite Ropp_mul1. -Rewrite <- Rinv_r_sym. -Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_l; Rewrite Rabsolu_R0; Apply H0. -Apply H2. -Case (case_Rabsolu h); Intro. -Apply Ropp_Rlt. -Rewrite Ropp_O; Rewrite Ropp_distr1; Apply gt0_plus_gt0_is_gt0. -Apply H1. -Apply Rgt_RO_Ropp; Apply r. -Rewrite (Rabsolu_right h r) in H3. -Apply Rlt_anti_compatibility with ``-x``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H3. -Apply H. -Apply Rgt_RO_Ropp; Apply H. +Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1). +intros. +unfold derivable_pt_lim in |- *; intros. +cut (0 < - x). +intro; exists (mkposreal (- x) H1); intros. +rewrite (Rabs_left x). +rewrite (Rabs_left (x + h)). +rewrite Rplus_comm. +rewrite Ropp_plus_distr. +unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc; + rewrite Rplus_opp_l. +rewrite Rplus_0_r; unfold Rdiv in |- *. +rewrite Ropp_mult_distr_l_reverse. +rewrite <- Rinv_r_sym. +rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0. +apply H2. +case (Rcase_abs h); intro. +apply Ropp_lt_cancel. +rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat. +apply H1. +apply Ropp_0_gt_lt_contravar; apply r. +rewrite (Rabs_right h r) in H3. +apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3. +apply H. +apply Ropp_0_gt_lt_contravar; apply H. Qed. (* Rabsolu is derivable for all x <> 0 *) -Lemma derivable_pt_Rabsolu : (x:R) ``x<>0`` -> (derivable_pt Rabsolu x). -Intros. -Case (total_order_T x R0); Intro. -Elim s; Intro. -Unfold derivable_pt; Apply Specif.existT with ``-1``. -Apply (Rabsolu_derive_2 x a). -Elim H; Exact b. -Unfold derivable_pt; Apply Specif.existT with ``1``. -Apply (Rabsolu_derive_1 x r). +Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x. +intros. +case (total_order_T x 0); intro. +elim s; intro. +unfold derivable_pt in |- *; apply existT with (-1). +apply (Rabs_derive_2 x a). +elim H; exact b. +unfold derivable_pt in |- *; apply existT with 1. +apply (Rabs_derive_1 x r). Qed. (* Rabsolu is continuous for all x *) -Lemma continuity_Rabsolu : (continuity Rabsolu). -Unfold continuity; Intro. -Case (Req_EM x R0); Intro. -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 Rabsolu_R0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Elim H1; Intros; Rewrite H in H3; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3. -Apply derivable_continuous_pt; Apply (derivable_pt_Rabsolu x H). +Lemma Rcontinuity_abs : continuity Rabs. +unfold continuity in |- *; intro. +case (Req_dec x 0); intro. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists eps; + split. +apply H0. +intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; + intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3; + rewrite Rplus_0_r in H3; apply H3. +apply derivable_continuous_pt; apply (Rderivable_pt_abs x H). Qed. (* Finite sums : Sum a_k x^k *) -Lemma continuity_finite_sum : (An:nat->R;N:nat) (continuity [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)). -Intros; Unfold continuity; Intro. -Induction N. -Simpl. -Apply continuity_pt_const. -Unfold constant; Intros; Reflexivity. -Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``). -Apply continuity_pt_plus. -Apply HrecN. -Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))). -Apply continuity_pt_scal. -Apply derivable_continuous_pt. -Apply derivable_pt_pow. -Reflexivity. -Reflexivity. +Lemma continuity_finite_sum : + forall (An:nat -> R) (N:nat), + continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). +intros; unfold continuity in |- *; intro. +induction N as [| N HrecN]. +simpl in |- *. +apply continuity_pt_const. +unfold constant in |- *; intros; reflexivity. +replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with + ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + + (fun y:R => (An (S N) * y ^ S N)%R))%F. +apply continuity_pt_plus. +apply HrecN. +replace (fun y:R => An (S N) * y ^ S N) with + (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). +apply continuity_pt_scal. +apply derivable_continuous_pt. +apply derivable_pt_pow. +reflexivity. +reflexivity. Qed. -Lemma derivable_pt_lim_fs : (An:nat->R;x:R;N:nat) (lt O N) -> (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N))). -Intros; Induction N. -Elim (lt_n_n ? H). -Cut N=O\/(lt O N). -Intro; Elim H0; Intro. -Rewrite H1. -Simpl. -Replace [y:R]``(An O)*1+(An (S O))*(y*1)`` with (plus_fct (fct_cte ``(An O)*1``) (mult_real_fct ``(An (S O))`` (mult_fct id (fct_cte R1)))). -Replace ``1*(An (S O))*1`` with ``0+(An (S O))*(1*(fct_cte R1 x)+(id x)*0)``. -Apply derivable_pt_lim_plus. -Apply derivable_pt_lim_const. -Apply derivable_pt_lim_scal. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -Unfold fct_cte id; Ring. -Reflexivity. -Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``). -Replace (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))) with (Rplus (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) ``(An (S N))*((INR (S (pred (S N))))*(pow x (pred (S N))))``). -Apply derivable_pt_lim_plus. -Apply HrecN. -Assumption. -Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))). -Apply derivable_pt_lim_scal. -Replace (pred (S N)) with N; [Idtac | Reflexivity]. -Pattern 3 N; Replace N with (pred (S N)). -Apply derivable_pt_lim_pow. -Reflexivity. -Reflexivity. -Cut (pred (S N)) = (S (pred N)). -Intro; Rewrite H2. -Rewrite tech5. -Apply Rplus_plus_r. -Rewrite <- H2. -Replace (pred (S N)) with N; [Idtac | Reflexivity]. -Ring. -Simpl. -Apply S_pred with O; Assumption. -Unfold plus_fct. -Simpl; Reflexivity. -Inversion H. -Left; Reflexivity. -Right; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption]. +Lemma derivable_pt_lim_fs : + forall (An:nat -> R) (x:R) (N:nat), + (0 < N)%nat -> + derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)). +intros; induction N as [| N HrecN]. +elim (lt_irrefl _ H). +cut (N = 0%nat \/ (0 < N)%nat). +intro; elim H0; intro. +rewrite H1. +simpl in |- *. +replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with + (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F. +replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)). +apply derivable_pt_lim_plus. +apply derivable_pt_lim_const. +apply derivable_pt_lim_scal. +apply derivable_pt_lim_mult. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte, id in |- *; ring. +reflexivity. +replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with + ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + + (fun y:R => (An (S N) * y ^ S N)%R))%F. +replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))) + with + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + + An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))). +apply derivable_pt_lim_plus. +apply HrecN. +assumption. +replace (fun y:R => An (S N) * y ^ S N) with + (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). +apply derivable_pt_lim_scal. +replace (pred (S N)) with N; [ idtac | reflexivity ]. +pattern N at 3 in |- *; replace N with (pred (S N)). +apply derivable_pt_lim_pow. +reflexivity. +reflexivity. +cut (pred (S N) = S (pred N)). +intro; rewrite H2. +rewrite tech5. +apply Rplus_eq_compat_l. +rewrite <- H2. +replace (pred (S N)) with N; [ idtac | reflexivity ]. +ring. +simpl in |- *. +apply S_pred with 0%nat; assumption. +unfold plus_fct in |- *. +simpl in |- *; reflexivity. +inversion H. +left; reflexivity. +right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. Qed. -Lemma derivable_pt_lim_finite_sum : (An:(nat->R); x:R; N:nat) (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (Cases N of O => R0 | _ => (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) end)). -Intros. -Induction N. -Simpl. -Rewrite Rmult_1r. -Replace [_:R]``(An O)`` with (fct_cte (An O)); [Apply derivable_pt_lim_const | Reflexivity]. -Apply derivable_pt_lim_fs; Apply lt_O_Sn. +Lemma derivable_pt_lim_finite_sum : + forall (An:nat -> R) (x:R) (N:nat), + derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x + match N with + | O => 0 + | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + end. +intros. +induction N as [| N HrecN]. +simpl in |- *. +rewrite Rmult_1_r. +replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat)); + [ apply derivable_pt_lim_const | reflexivity ]. +apply derivable_pt_lim_fs; apply lt_O_Sn. Qed. -Lemma derivable_pt_finite_sum : (An:nat->R;N:nat;x:R) (derivable_pt [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x). -Intros. -Unfold derivable_pt. -Assert H := (derivable_pt_lim_finite_sum An x N). -Induction N. -Apply Specif.existT with R0; Apply H. -Apply Specif.existT with (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))); Apply H. +Lemma derivable_pt_finite_sum : + forall (An:nat -> R) (N:nat) (x:R), + derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x. +intros. +unfold derivable_pt in |- *. +assert (H := derivable_pt_lim_finite_sum An x N). +induction N as [| N HrecN]. +apply existT with 0; apply H. +apply existT with + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); + apply H. Qed. -Lemma derivable_finite_sum : (An:nat->R;N:nat) (derivable [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)). -Intros; Unfold derivable; Intro; Apply derivable_pt_finite_sum. +Lemma derivable_finite_sum : + forall (An:nat -> R) (N:nat), + derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). +intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum. Qed. (* Regularity of hyperbolic functions *) -Lemma derivable_pt_lim_cosh : (x:R) (derivable_pt_lim cosh x ``(sinh x)``). -Intro. -Unfold cosh sinh; Unfold Rdiv. -Replace [x0:R]``((exp x0)+(exp ( -x0)))*/2`` with (mult_fct (plus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity]. -Replace ``((exp x)-(exp ( -x)))*/2`` with ``((exp x)+((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((plus_fct exp (comp exp (opp_fct id))) x)*0``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_plus. -Apply derivable_pt_lim_exp. -Apply derivable_pt_lim_comp. -Apply derivable_pt_lim_opp. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_exp. -Apply derivable_pt_lim_const. -Unfold plus_fct mult_real_fct comp opp_fct id fct_cte; Ring. +Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x). +intro. +unfold cosh, sinh in |- *; unfold Rdiv in |- *. +replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with + ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. +replace ((exp x - exp (- x)) * / 2) with + ((exp x + exp (- x) * -1) * fct_cte (/ 2) x + + (exp + comp exp (- id))%F x * 0). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_plus. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_comp. +apply derivable_pt_lim_opp. +apply derivable_pt_lim_id. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_const. +unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. Qed. -Lemma derivable_pt_lim_sinh : (x:R) (derivable_pt_lim sinh x ``(cosh x)``). -Intro. -Unfold cosh sinh; Unfold Rdiv. -Replace [x0:R]``((exp x0)-(exp ( -x0)))*/2`` with (mult_fct (minus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity]. -Replace ``((exp x)+(exp ( -x)))*/2`` with ``((exp x)-((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((minus_fct exp (comp exp (opp_fct id))) x)*0``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_minus. -Apply derivable_pt_lim_exp. -Apply derivable_pt_lim_comp. -Apply derivable_pt_lim_opp. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_exp. -Apply derivable_pt_lim_const. -Unfold plus_fct mult_real_fct comp opp_fct id fct_cte; Ring. +Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x). +intro. +unfold cosh, sinh in |- *; unfold Rdiv in |- *. +replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with + ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. +replace ((exp x + exp (- x)) * / 2) with + ((exp x - exp (- x) * -1) * fct_cte (/ 2) x + + (exp - comp exp (- id))%F x * 0). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_comp. +apply derivable_pt_lim_opp. +apply derivable_pt_lim_id. +apply derivable_pt_lim_exp. +apply derivable_pt_lim_const. +unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. Qed. -Lemma derivable_pt_exp : (x:R) (derivable_pt exp x). -Intro. -Unfold derivable_pt. -Apply Specif.existT with (exp x). -Apply derivable_pt_lim_exp. +Lemma derivable_pt_exp : forall x:R, derivable_pt exp x. +intro. +unfold derivable_pt in |- *. +apply existT with (exp x). +apply derivable_pt_lim_exp. Qed. -Lemma derivable_pt_cosh : (x:R) (derivable_pt cosh x). -Intro. -Unfold derivable_pt. -Apply Specif.existT with (sinh x). -Apply derivable_pt_lim_cosh. +Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x. +intro. +unfold derivable_pt in |- *. +apply existT with (sinh x). +apply derivable_pt_lim_cosh. Qed. -Lemma derivable_pt_sinh : (x:R) (derivable_pt sinh x). -Intro. -Unfold derivable_pt. -Apply Specif.existT with (cosh x). -Apply derivable_pt_lim_sinh. +Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x. +intro. +unfold derivable_pt in |- *. +apply existT with (cosh x). +apply derivable_pt_lim_sinh. Qed. -Lemma derivable_exp : (derivable exp). -Unfold derivable; Apply derivable_pt_exp. +Lemma derivable_exp : derivable exp. +unfold derivable in |- *; apply derivable_pt_exp. Qed. -Lemma derivable_cosh : (derivable cosh). -Unfold derivable; Apply derivable_pt_cosh. +Lemma derivable_cosh : derivable cosh. +unfold derivable in |- *; apply derivable_pt_cosh. Qed. -Lemma derivable_sinh : (derivable sinh). -Unfold derivable; Apply derivable_pt_sinh. +Lemma derivable_sinh : derivable sinh. +unfold derivable in |- *; apply derivable_pt_sinh. Qed. -Lemma derive_pt_exp : (x:R) (derive_pt exp x (derivable_pt_exp x))==(exp x). -Intro; Apply derive_pt_eq_0. -Apply derivable_pt_lim_exp. +Lemma derive_pt_exp : + forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x. +intro; apply derive_pt_eq_0. +apply derivable_pt_lim_exp. Qed. -Lemma derive_pt_cosh : (x:R) (derive_pt cosh x (derivable_pt_cosh x))==(sinh x). -Intro; Apply derive_pt_eq_0. -Apply derivable_pt_lim_cosh. +Lemma derive_pt_cosh : + forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x. +intro; apply derive_pt_eq_0. +apply derivable_pt_lim_cosh. Qed. -Lemma derive_pt_sinh : (x:R) (derive_pt sinh x (derivable_pt_sinh x))==(cosh x). -Intro; Apply derive_pt_eq_0. -Apply derivable_pt_lim_sinh. -Qed. +Lemma derive_pt_sinh : + forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x. +intro; apply derive_pt_eq_0. +apply derivable_pt_lim_sinh. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v index 4516a206f..a047c78c0 100644 --- a/theories/Reals/Raxioms.v +++ b/theories/Reals/Raxioms.v @@ -13,23 +13,8 @@ (*********************************************************) Require Export ZArith_base. -Require Export Rsyntax. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Export Rsyntax. Open Local Scope R_scope. -V7only [ -(*********************************************************) -(* Compatibility *) -(*********************************************************) -Notation sumboolT := Specif.sumbool. -Notation leftT := Specif.left. -Notation rightT := Specif.right. -Notation sumorT := Specif.sumor. -Notation inleftT := Specif.inleft. -Notation inrightT := Specif.inright. -Notation sigTT := Specif.sigT. -Notation existTT := Specif.existT. -Notation SigT := Specif.sigT. -]. (*********************************************************) (* Field axioms *) @@ -40,52 +25,53 @@ Notation SigT := Specif.sigT. (*********************************************************) (**********) -Axiom Rplus_sym:(r1,r2:R)``r1+r2==r2+r1``. -Hints Resolve Rplus_sym : real. +Axiom Rplus_comm : forall r1 r2:R, r1 + r2 = r2 + r1. +Hint Resolve Rplus_comm: real. (**********) -Axiom Rplus_assoc:(r1,r2,r3:R)``(r1+r2)+r3==r1+(r2+r3)``. -Hints Resolve Rplus_assoc : real. +Axiom Rplus_assoc : forall r1 r2 r3:R, r1 + r2 + r3 = r1 + (r2 + r3). +Hint Resolve Rplus_assoc: real. (**********) -Axiom Rplus_Ropp_r:(r:R)``r+(-r)==0``. -Hints Resolve Rplus_Ropp_r : real v62. +Axiom Rplus_opp_r : forall r:R, r + - r = 0. +Hint Resolve Rplus_opp_r: real v62. (**********) -Axiom Rplus_Ol:(r:R)``0+r==r``. -Hints Resolve Rplus_Ol : real. +Axiom Rplus_0_l : forall r:R, 0 + r = r. +Hint Resolve Rplus_0_l: real. (***********************************************************) (** Multiplication *) (***********************************************************) (**********) -Axiom Rmult_sym:(r1,r2:R)``r1*r2==r2*r1``. -Hints Resolve Rmult_sym : real v62. +Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1. +Hint Resolve Rmult_comm: real v62. (**********) -Axiom Rmult_assoc:(r1,r2,r3:R)``(r1*r2)*r3==r1*(r2*r3)``. -Hints Resolve Rmult_assoc : real v62. +Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3). +Hint Resolve Rmult_assoc: real v62. (**********) -Axiom Rinv_l:(r:R)``r<>0``->``(/r)*r==1``. -Hints Resolve Rinv_l : real. +Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1. +Hint Resolve Rinv_l: real. (**********) -Axiom Rmult_1l:(r:R)``1*r==r``. -Hints Resolve Rmult_1l : real. +Axiom Rmult_1_l : forall r:R, 1 * r = r. +Hint Resolve Rmult_1_l: real. (**********) -Axiom R1_neq_R0:``1<>0``. -Hints Resolve R1_neq_R0 : real. +Axiom R1_neq_R0 : 1 <> 0. +Hint Resolve R1_neq_R0: real. (*********************************************************) (** Distributivity *) (*********************************************************) (**********) -Axiom Rmult_Rplus_distr:(r1,r2,r3:R)``r1*(r2+r3)==(r1*r2)+(r1*r3)``. -Hints Resolve Rmult_Rplus_distr : real v62. +Axiom + Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3. +Hint Resolve Rmult_plus_distr_l: real v62. (*********************************************************) (** Order axioms *) @@ -95,37 +81,38 @@ Hints Resolve Rmult_Rplus_distr : real v62. (*********************************************************) (**********) -Axiom total_order_T:(r1,r2:R)(sumorT (sumboolT ``r1<r2`` r1==r2) ``r1>r2``). +Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}. (*********************************************************) (** Lower *) (*********************************************************) (**********) -Axiom Rlt_antisym:(r1,r2:R)``r1<r2`` -> ~ ``r2<r1``. +Axiom Rlt_asym : forall r1 r2:R, r1 < r2 -> ~ r2 < r1. (**********) -Axiom Rlt_trans:(r1,r2,r3:R) - ``r1<r2``->``r2<r3``->``r1<r3``. +Axiom Rlt_trans : forall r1 r2 r3:R, r1 < r2 -> r2 < r3 -> r1 < r3. (**********) -Axiom Rlt_compatibility:(r,r1,r2:R)``r1<r2``->``r+r1<r+r2``. +Axiom Rplus_lt_compat_l : forall r r1 r2:R, r1 < r2 -> r + r1 < r + r2. (**********) -Axiom Rlt_monotony:(r,r1,r2:R)``0<r``->``r1<r2``->``r*r1<r*r2``. +Axiom + Rmult_lt_compat_l : forall r r1 r2:R, 0 < r -> r1 < r2 -> r * r1 < r * r2. -Hints Resolve Rlt_antisym Rlt_compatibility Rlt_monotony : real. +Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real. (**********************************************************) (** Injection from N to R *) (**********************************************************) (**********) -Fixpoint INR [n:nat]:R:=(Cases n of - O => ``0`` - |(S O) => ``1`` - |(S n) => ``(INR n)+1`` - end). +Fixpoint INR (n:nat) : R := + match n with + | O => 0 + | S O => 1 + | S n => INR n + 1 + end. Arguments Scope INR [nat_scope]. @@ -134,11 +121,12 @@ Arguments Scope INR [nat_scope]. (**********************************************************) (**********) -Definition IZR:Z->R:=[z:Z](Cases z of - ZERO => ``0`` - |(POS n) => (INR (convert n)) - |(NEG n) => ``-(INR (convert n))`` - end). +Definition IZR (z:Z) : R := + match z with + | Z0 => 0 + | Zpos n => INR (nat_of_P n) + | Zneg n => - INR (nat_of_P n) + end. Arguments Scope IZR [Z_scope]. (**********************************************************) @@ -146,24 +134,24 @@ Arguments Scope IZR [Z_scope]. (**********************************************************) (**********) -Axiom archimed:(r:R)``(IZR (up r)) > r``/\``(IZR (up r))-r <= 1``. +Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1. (**********************************************************) (** [R] Complete *) (**********************************************************) (**********) -Definition is_upper_bound:=[E:R->Prop][m:R](x:R)(E x)->``x <= m``. +Definition is_upper_bound (E:R -> Prop) (m:R) := forall x:R, E x -> x <= m. (**********) -Definition bound:=[E:R->Prop](ExT [m:R](is_upper_bound E m)). +Definition bound (E:R -> Prop) := exists m : R | is_upper_bound E m. (**********) -Definition is_lub:=[E:R->Prop][m:R] - (is_upper_bound E m)/\(b:R)(is_upper_bound E b)->``m <= b``. +Definition is_lub (E:R -> Prop) (m:R) := + is_upper_bound E m /\ (forall b:R, is_upper_bound E b -> m <= b). (**********) -Axiom complet:(E:R->Prop)(bound E)-> - (ExT [x:R] (E x))-> - (sigTT R [m:R](is_lub E m)). - +Axiom + completeness : + forall E:R -> Prop, + bound E -> ( exists x : R | E x) -> sigT (fun m:R => is_lub E m). diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v index 1df44bbf5..f1e17e305 100644 --- a/theories/Reals/Rbase.v +++ b/theories/Reals/Rbase.v @@ -11,4 +11,4 @@ Require Export Rdefinitions. Require Export Raxioms. Require Export RIneq. -Require Export DiscrR. +Require Export DiscrR.
\ No newline at end of file diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index c586acdca..d5b090677 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -13,69 +13,68 @@ (* *) (*********************************************************) -Require Rbase. -Require R_Ifp. -Require Fourier. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import R_Ifp. +Require Import Fourier. Open Local Scope R_scope. -Implicit Variable Type r:R. +Implicit Type r : R. (*******************************) (** Rmin *) (*******************************) (*********) -Definition Rmin :R->R->R:=[x,y:R] - Cases (total_order_Rle x y) of - (leftT _) => x - | (rightT _) => y +Definition Rmin (x y:R) : R := + match Rle_dec x y with + | left _ => x + | right _ => y end. (*********) -Lemma Rmin_Rgt_l:(r1,r2,r:R)(Rgt (Rmin r1 r2) r) -> - ((Rgt r1 r)/\(Rgt r2 r)). -Intros r1 r2 r;Unfold Rmin;Case (total_order_Rle r1 r2);Intros. -Split. -Assumption. -Unfold Rgt;Unfold Rgt in H;Exact (Rlt_le_trans r r1 r2 H r0). -Split. -Generalize (not_Rle r1 r2 n);Intro;Exact (Rgt_trans r1 r2 r H0 H). -Assumption. +Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r. +intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros. +split. +assumption. +unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0). +split. +generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H). +assumption. Qed. (*********) -Lemma Rmin_Rgt_r:(r1,r2,r:R)(((Rgt r1 r)/\(Rgt r2 r)) -> - (Rgt (Rmin r1 r2) r)). -Intros;Unfold Rmin;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros; - Assumption. +Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r. +intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + assumption. Qed. (*********) -Lemma Rmin_Rgt:(r1,r2,r:R)(Rgt (Rmin r1 r2) r)<-> - ((Rgt r1 r)/\(Rgt r2 r)). -Intros; Split. -Exact (Rmin_Rgt_l r1 r2 r). -Exact (Rmin_Rgt_r r1 r2 r). +Lemma Rmin_Rgt : forall r1 r2 r, Rmin r1 r2 > r <-> r1 > r /\ r2 > r. +intros; split. +exact (Rmin_Rgt_l r1 r2 r). +exact (Rmin_Rgt_r r1 r2 r). Qed. (*********) -Lemma Rmin_l : (x,y:R) ``(Rmin x y)<=x``. -Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Right; Reflexivity | Auto with real]. +Lemma Rmin_l : forall x y:R, Rmin x y <= x. +intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + [ right; reflexivity | auto with real ]. Qed. (*********) -Lemma Rmin_r : (x,y:R) ``(Rmin x y)<=y``. -Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Assumption | Auto with real]. +Lemma Rmin_r : forall x y:R, Rmin x y <= y. +intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + [ assumption | auto with real ]. Qed. (*********) -Lemma Rmin_sym : (a,b:R) (Rmin a b)==(Rmin b a). -Intros; Unfold Rmin; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse (Apply Rle_antisym; Assumption Orelse Auto with real). +Lemma Rmin_comm : forall a b:R, Rmin a b = Rmin b a. +intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || (apply Rle_antisym; assumption || auto with real). Qed. (*********) -Lemma Rmin_stable_in_posreal : (x,y:posreal) ``0<(Rmin x y)``. -Intros; Apply Rmin_Rgt_r; Split; [Apply (cond_pos x) | Apply (cond_pos y)]. +Lemma Rmin_stable_in_posreal : forall x y:posreal, 0 < Rmin x y. +intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ]. Qed. (*******************************) @@ -83,54 +82,52 @@ Qed. (*******************************) (*********) -Definition Rmax :R->R->R:=[x,y:R] - Cases (total_order_Rle x y) of - (leftT _) => y - | (rightT _) => x +Definition Rmax (x y:R) : R := + match Rle_dec x y with + | left _ => y + | right _ => x end. (*********) -Lemma Rmax_Rle:(r1,r2,r:R)(Rle r (Rmax r1 r2))<-> - ((Rle r r1)\/(Rle r r2)). -Intros;Split. -Unfold Rmax;Case (total_order_Rle r1 r2);Intros;Auto. -Intro;Unfold Rmax;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;Auto. -Apply (Rle_trans r r1 r2);Auto. -Generalize (not_Rle r1 r2 n);Clear n;Intro;Unfold Rgt in H0; - Apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)). +Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2. +intros; split. +unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto. +intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + auto. +apply (Rle_trans r r1 r2); auto. +generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0; + apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)). Qed. -Lemma RmaxLess1: (r1, r2 : R) (Rle r1 (Rmax r1 r2)). -Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real. +Lemma RmaxLess1 : forall r1 r2, r1 <= Rmax r1 r2. +intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. Qed. -Lemma RmaxLess2: (r1, r2 : R) (Rle r2 (Rmax r1 r2)). -Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real. +Lemma RmaxLess2 : forall r1 r2, r2 <= Rmax r1 r2. +intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. Qed. -Lemma RmaxSym: (p, q : R) (Rmax p q) == (Rmax q p). -Intros p q; Unfold Rmax; - Case (total_order_Rle p q); Case (total_order_Rle q p); Auto; Intros H1 H2; - Apply Rle_antisym; Auto with real. +Lemma RmaxSym : forall p q:R, Rmax p q = Rmax q p. +intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto; + intros H1 H2; apply Rle_antisym; auto with real. Qed. -Lemma RmaxRmult: - (p, q, r : R) - (Rle R0 r) -> (Rmax (Rmult r p) (Rmult r q)) == (Rmult r (Rmax p q)). -Intros p q r H; Unfold Rmax. -Case (total_order_Rle p q); Case (total_order_Rle (Rmult r p) (Rmult r q)); - Auto; Intros H1 H2; Auto. -Case H; Intros E1. -Case H1; Auto with real. -Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto. -Case H; Intros E1. -Case H2; Auto with real. -Apply Rle_monotony_contra with z := r; Auto. -Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto. +Lemma RmaxRmult : + forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q. +intros p q r H; unfold Rmax in |- *. +case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto. +case H; intros E1. +case H1; auto with real. +rewrite <- E1; repeat rewrite Rmult_0_l; auto. +case H; intros E1. +case H2; auto with real. +apply Rmult_le_reg_l with (r := r); auto. +rewrite <- E1; repeat rewrite Rmult_0_l; auto. Qed. -Lemma Rmax_stable_in_negreal : (x,y:negreal) ``(Rmax x y)<0``. -Intros; Unfold Rmax; Case (total_order_Rle x y); Intro; [Apply (cond_neg y) | Apply (cond_neg x)]. +Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0. +intros; unfold Rmax in |- *; case (Rle_dec x y); intro; + [ apply (cond_neg y) | apply (cond_neg x) ]. Qed. (*******************************) @@ -138,339 +135,336 @@ Qed. (*******************************) (*********) -Lemma case_Rabsolu:(r:R)(sumboolT (Rlt r R0) (Rge r R0)). -Intro;Generalize (total_order_Rle R0 r);Intro X;Elim X;Intro;Clear X. -Right;Apply (Rle_sym1 R0 r a). -Left;Fold (Rgt R0 r);Apply (not_Rle R0 r b). +Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. +intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X. +right; apply (Rle_ge 0 r a). +left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b). Qed. (*********) -Definition Rabsolu:R->R:= - [r:R](Cases (case_Rabsolu r) of - (leftT _) => (Ropp r) - |(rightT _) => r - end). +Definition Rabs r : R := + match Rcase_abs r with + | left _ => - r + | right _ => r + end. (*********) -Lemma Rabsolu_R0:(Rabsolu R0)==R0. -Unfold Rabsolu;Case (case_Rabsolu R0);Auto;Intro. -Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto. +Lemma Rabs_R0 : Rabs 0 = 0. +unfold Rabs in |- *; case (Rcase_abs 0); auto; intro. +generalize (Rlt_irrefl 0); intro; elimtype False; auto. Qed. -Lemma Rabsolu_R1: (Rabsolu R1)==R1. -Unfold Rabsolu; Case (case_Rabsolu R1); Auto with real. -Intros H; Absurd ``1 < 0``;Auto with real. +Lemma Rabs_R1 : Rabs 1 = 1. +unfold Rabs in |- *; case (Rcase_abs 1); auto with real. +intros H; absurd (1 < 0); auto with real. Qed. (*********) -Lemma Rabsolu_no_R0:(r:R)~r==R0->~(Rabsolu r)==R0. -Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro;Auto. -Apply Ropp_neq;Auto. +Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0. +intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto. +apply Ropp_neq_0_compat; auto. Qed. (*********) -Lemma Rabsolu_left: (r:R)(Rlt r R0)->((Rabsolu r) == (Ropp r)). -Intros;Unfold Rabsolu;Case (case_Rabsolu r);Trivial;Intro;Absurd (Rge r R0). -Exact (Rlt_ge_not r R0 H). -Assumption. +Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r. +intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro; + absurd (r >= 0). +exact (Rlt_not_ge r 0 H). +assumption. Qed. (*********) -Lemma Rabsolu_right: (r:R)(Rge r R0)->((Rabsolu r) == r). -Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro. -Absurd (Rge r R0). -Exact (Rlt_ge_not r R0 r0). -Assumption. -Trivial. +Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r. +intros; unfold Rabs in |- *; case (Rcase_abs r); intro. +absurd (r >= 0). +exact (Rlt_not_ge r 0 r0). +assumption. +trivial. Qed. -Lemma Rabsolu_left1: (a : R) (Rle a R0) -> (Rabsolu a) == (Ropp a). -Intros a H; Case H; Intros H1. -Apply Rabsolu_left; Auto. -Rewrite H1; Simpl; Rewrite Rabsolu_right; Auto with real. +Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a. +intros a H; case H; intros H1. +apply Rabs_left; auto. +rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real. Qed. (*********) -Lemma Rabsolu_pos:(x:R)(Rle R0 (Rabsolu x)). -Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro. -Generalize (Rlt_Ropp x R0 r);Intro;Unfold Rgt in H; - Rewrite Ropp_O in H;Unfold Rle;Left;Assumption. -Apply Rle_sym2;Assumption. +Lemma Rabs_pos : forall x:R, 0 <= Rabs x. +intros; unfold Rabs in |- *; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H; + rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption. +apply Rge_le; assumption. Qed. -Lemma Rle_Rabsolu: - (x:R) (Rle x (Rabsolu x)). -Intro; Unfold Rabsolu;Case (case_Rabsolu x);Intros;Fourier. +Lemma RRle_abs : forall x:R, x <= Rabs x. +intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier. Qed. (*********) -Lemma Rabsolu_pos_eq:(x:R)(Rle R0 x)->(Rabsolu x)==x. -Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro; - [Generalize (Rle_not R0 x r);Intro;ElimType False;Auto|Trivial]. +Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x. +intros; unfold Rabs in |- *; case (Rcase_abs x); intro; + [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ]. Qed. (*********) -Lemma Rabsolu_Rabsolu:(x:R)(Rabsolu (Rabsolu x))==(Rabsolu x). -Intro;Apply (Rabsolu_pos_eq (Rabsolu x) (Rabsolu_pos x)). +Lemma Rabs_Rabsolu : forall x:R, Rabs (Rabs x) = Rabs x. +intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)). Qed. (*********) -Lemma Rabsolu_pos_lt:(x:R)(~x==R0)->(Rlt R0 (Rabsolu x)). -Intros;Generalize (Rabsolu_pos x);Intro;Unfold Rle in H0; - Elim H0;Intro;Auto. -ElimType False;Clear H0;Elim H;Clear H;Generalize H1; - Unfold Rabsolu;Case (case_Rabsolu x);Intros;Auto. -Clear r H1; Generalize (Rplus_plus_r x R0 (Ropp x) H0); - Rewrite (let (H1,H2)=(Rplus_ne x) in H1);Rewrite (Rplus_Ropp_r x);Trivial. +Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x. +intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro; + auto. +elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *; + case (Rcase_abs x); intros; auto. +clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0); + rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); + trivial. Qed. (*********) -Lemma Rabsolu_minus_sym:(x,y:R) - (Rabsolu (Rminus x y))==(Rabsolu (Rminus y x)). -Intros;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y)); - Case (case_Rabsolu (Rminus y x));Intros. - Generalize (Rminus_lt y x r);Generalize (Rminus_lt x y r0);Intros; - Generalize (Rlt_antisym x y H);Intro;ElimType False;Auto. -Rewrite (Ropp_distr2 x y);Trivial. -Rewrite (Ropp_distr2 y x);Trivial. -Unfold Rge in r r0;Elim r;Elim r0;Intros;Clear r r0. -Generalize (Rgt_RoppO (Rminus x y) H);Rewrite (Ropp_distr2 x y); - Intro;Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rminus y x) H0); - Intro;ElimType False;Auto. -Rewrite (Rminus_eq x y H);Trivial. -Rewrite (Rminus_eq y x H0);Trivial. -Rewrite (Rminus_eq y x H0);Trivial. +Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x). +intros; unfold Rabs in |- *; case (Rcase_abs (x - y)); + case (Rcase_abs (y - x)); intros. + generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros; + generalize (Rlt_asym x y H); intro; elimtype False; + auto. +rewrite (Ropp_minus_distr x y); trivial. +rewrite (Ropp_minus_distr y x); trivial. +unfold Rge in r, r0; elim r; elim r0; intros; clear r r0. +generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y); + intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); + intro; elimtype False; auto. +rewrite (Rminus_diag_uniq x y H); trivial. +rewrite (Rminus_diag_uniq y x H0); trivial. +rewrite (Rminus_diag_uniq y x H0); trivial. Qed. (*********) -Lemma Rabsolu_mult:(x,y:R) - (Rabsolu (Rmult x y))==(Rmult (Rabsolu x) (Rabsolu y)). -Intros;Unfold Rabsolu;Case (case_Rabsolu (Rmult x y)); - Case (case_Rabsolu x);Case (case_Rabsolu y);Intros;Auto. -Generalize (Rlt_anti_monotony y x R0 r r0);Intro; - Rewrite (Rmult_Or y) in H;Generalize (Rlt_antisym (Rmult x y) R0 r1); - Intro;Unfold Rgt in H;ElimType False;Rewrite (Rmult_sym y x) in H; - Auto. -Rewrite (Ropp_mul1 x y);Trivial. -Rewrite (Rmult_sym x (Ropp y));Rewrite (Ropp_mul1 y x); - Rewrite (Rmult_sym x y);Trivial. -Unfold Rge in r r0;Elim r;Elim r0;Clear r r0;Intros;Unfold Rgt in H H0. -Generalize (Rlt_monotony x R0 y H H0);Intro;Rewrite (Rmult_Or x) in H1; - Generalize (Rlt_antisym (Rmult x y) R0 r1);Intro;ElimType False;Auto. -Rewrite H in r1;Rewrite (Rmult_Ol y) in r1;Generalize (Rlt_antirefl R0); - Intro;ElimType False;Auto. -Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0); - Intro;ElimType False;Auto. -Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0); - Intro;ElimType False;Auto. -Rewrite (Ropp_mul2 x y);Trivial. -Unfold Rge in r r1;Elim r;Elim r1;Clear r r1;Intros;Unfold Rgt in H0 H. -Generalize (Rlt_monotony y x R0 H0 r0);Intro;Rewrite (Rmult_Or y) in H1; - Rewrite (Rmult_sym y x) in H1; - Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto. -Generalize (imp_not_Req x R0 (or_introl (Rlt x R0) (Rgt x R0) r0)); - Generalize (imp_not_Req y R0 (or_intror (Rlt y R0) (Rgt y R0) H0));Intros; - Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False; - Auto. -Rewrite H0 in H;Rewrite (Rmult_Or x) in H;Unfold Rgt in H; - Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto. -Rewrite H0;Rewrite (Rmult_Or x);Rewrite (Rmult_Or (Ropp x));Trivial. -Unfold Rge in r0 r1;Elim r0;Elim r1;Clear r0 r1;Intros;Unfold Rgt in H0 H. -Generalize (Rlt_monotony x y R0 H0 r);Intro;Rewrite (Rmult_Or x) in H1; - Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto. -Generalize (imp_not_Req y R0 (or_introl (Rlt y R0) (Rgt y R0) r)); - Generalize (imp_not_Req R0 x (or_introl (Rlt R0 x) (Rgt R0 x) H0));Intros; - Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False; - Auto. -Rewrite H0 in H;Rewrite (Rmult_Ol y) in H;Unfold Rgt in H; - Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto. -Rewrite H0;Rewrite (Rmult_Ol y);Rewrite (Rmult_Ol (Ropp y));Trivial. +Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y. +intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x); + case (Rcase_abs y); intros; auto. +generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro; + rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); + intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; + auto. +rewrite (Ropp_mult_distr_l_reverse x y); trivial. +rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x); + rewrite (Rmult_comm x y); trivial. +unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0. +generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1; + generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; + auto. +rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. +rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. +rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. +rewrite (Rmult_opp_opp x y); trivial. +unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H. +generalize (Rmult_lt_compat_l y x 0 H0 r0); intro; + rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + auto. +generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0)); + generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. +rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H; + generalize (Rlt_irrefl 0); intro; elimtype False; + auto. +rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial. +unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros; + unfold Rgt in H0, H. +generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + auto. +generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r)); + generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. +rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H; + generalize (Rlt_irrefl 0); intro; elimtype False; + auto. +rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial. Qed. (*********) -Lemma Rabsolu_Rinv:(r:R)(~r==R0)->(Rabsolu (Rinv r))== - (Rinv (Rabsolu r)). -Intro;Unfold Rabsolu;Case (case_Rabsolu r); - Case (case_Rabsolu (Rinv r));Auto;Intros. -Apply Ropp_Rinv;Auto. -Generalize (Rlt_Rinv2 r r1);Intro;Unfold Rge in r0;Elim r0;Intros. -Unfold Rgt in H1;Generalize (Rlt_antisym R0 (Rinv r) H1);Intro; - ElimType False;Auto. -Generalize - (imp_not_Req (Rinv r) R0 - (or_introl (Rlt (Rinv r) R0) (Rgt (Rinv r) R0) H0));Intro; - ElimType False;Auto. -Unfold Rge in r1;Elim r1;Clear r1;Intro. -Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rinv r) - (Rlt_Rinv r H0));Intro;ElimType False;Auto. -ElimType False;Auto. +Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r. +intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto; + intros. +apply Ropp_inv_permute; auto. +generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros. +unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False; + auto. +generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro; + elimtype False; auto. +unfold Rge in r1; elim r1; clear r1; intro. +unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0)); + intro; elimtype False; auto. +elimtype False; auto. Qed. -Lemma Rabsolu_Ropp: - (x:R) (Rabsolu (Ropp x))==(Rabsolu x). -Intro;Cut (Ropp x)==(Rmult (Ropp R1) x). -Intros; Rewrite H. -Rewrite Rabsolu_mult. -Cut (Rabsolu (Ropp R1))==R1. -Intros; Rewrite H0. -Ring. -Unfold Rabsolu; Case (case_Rabsolu (Ropp R1)). -Intro; Ring. -Intro H0;Generalize (Rle_sym2 R0 (Ropp R1) H0);Intros. -Generalize (Rle_Ropp R0 (Ropp R1) H1). -Rewrite Ropp_Ropp; Rewrite Ropp_O. -Intro;Generalize (Rle_not R1 R0 Rlt_R0_R1);Intro; - Generalize (Rle_sym2 R1 R0 H2);Intro; - ElimType False;Auto. -Ring. +Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x. +intro; cut (- x = -1 * x). +intros; rewrite H. +rewrite Rabs_mult. +cut (Rabs (-1) = 1). +intros; rewrite H0. +ring. +unfold Rabs in |- *; case (Rcase_abs (-1)). +intro; ring. +intro H0; generalize (Rge_le (-1) 0 H0); intros. +generalize (Ropp_le_ge_contravar 0 (-1) H1). +rewrite Ropp_involutive; rewrite Ropp_0. +intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2); + intro; elimtype False; auto. +ring. Qed. (*********) -Lemma Rabsolu_triang:(a,b:R)(Rle (Rabsolu (Rplus a b)) - (Rplus (Rabsolu a) (Rabsolu b))). -Intros a b;Unfold Rabsolu;Case (case_Rabsolu (Rplus a b)); - Case (case_Rabsolu a);Case (case_Rabsolu b);Intros. -Apply (eq_Rle (Ropp (Rplus a b)) (Rplus (Ropp a) (Ropp b))); - Rewrite (Ropp_distr1 a b);Reflexivity. +Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b. +intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a); + case (Rcase_abs b); intros. +apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b); + reflexivity. (**) -Rewrite (Ropp_distr1 a b); - Apply (Rle_compatibility (Ropp a) (Ropp b) b); - Unfold Rle;Unfold Rge in r;Elim r;Intro. -Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp b) R0 b H); - Intro;Elim (Rplus_ne (Ropp b));Intros v w;Rewrite v in H0;Clear v w; - Rewrite (Rplus_Ropp_l b) in H0;Apply (Rlt_trans (Ropp b) R0 b H0 H). -Right;Rewrite H;Apply Ropp_O. +rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b); + unfold Rle in |- *; unfold Rge in r; elim r; intro. +left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro; + elim (Rplus_ne (- b)); intros v w; rewrite v in H0; + clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H). +right; rewrite H; apply Ropp_0. (**) -Rewrite (Ropp_distr1 a b); - Rewrite (Rplus_sym (Ropp a) (Ropp b)); - Rewrite (Rplus_sym a (Ropp b)); - Apply (Rle_compatibility (Ropp b) (Ropp a) a); - Unfold Rle;Unfold Rge in r0;Elim r0;Intro. -Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp a) R0 a H); - Intro;Elim (Rplus_ne (Ropp a));Intros v w;Rewrite v in H0;Clear v w; - Rewrite (Rplus_Ropp_l a) in H0;Apply (Rlt_trans (Ropp a) R0 a H0 H). -Right;Rewrite H;Apply Ropp_O. +rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b)); + rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a); + unfold Rle in |- *; unfold Rge in r0; elim r0; intro. +left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro; + elim (Rplus_ne (- a)); intros v w; rewrite v in H0; + clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H). +right; rewrite H; apply Ropp_0. (**) -ElimType False;Generalize (Rge_plus_plus_r a b R0 r);Intro; - Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w; - Generalize (Rge_trans (Rplus a b) a R0 H r0);Intro;Clear H; - Unfold Rge in H0;Elim H0;Intro;Clear H0. -Unfold Rgt in H;Generalize (Rlt_antisym (Rplus a b) R0 r1);Intro;Auto. -Absurd (Rplus a b)==R0;Auto. -Apply (imp_not_Req (Rplus a b) R0);Left;Assumption. +elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro; + elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; + generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; + unfold Rge in H0; elim H0; intro; clear H0. +unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto. +absurd (a + b = 0); auto. +apply (Rlt_dichotomy_converse (a + b) 0); left; assumption. (**) -ElimType False;Generalize (Rlt_compatibility a b R0 r);Intro; - Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w; - Generalize (Rlt_trans (Rplus a b) a R0 H r0);Intro;Clear H; - Unfold Rge in r1;Elim r1;Clear r1;Intro. -Unfold Rgt in H; - Generalize (Rlt_trans (Rplus a b) R0 (Rplus a b) H0 H);Intro; - Apply (Rlt_antirefl (Rplus a b));Assumption. -Rewrite H in H0;Apply (Rlt_antirefl R0);Assumption. +elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro; + elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; + generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; + unfold Rge in r1; elim r1; clear r1; intro. +unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro; + apply (Rlt_irrefl (a + b)); assumption. +rewrite H in H0; apply (Rlt_irrefl 0); assumption. (**) -Rewrite (Rplus_sym a b);Rewrite (Rplus_sym (Ropp a) b); - Apply (Rle_compatibility b a (Ropp a)); - Apply (Rminus_le a (Ropp a));Unfold Rminus;Rewrite (Ropp_Ropp a); - Generalize (Rlt_compatibility a a R0 r0);Clear r r1;Intro; - Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w; - Generalize (Rlt_trans (Rplus a a) a R0 H r0);Intro; - Apply (Rlt_le (Rplus a a) R0 H0). +rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b); + apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a)); + unfold Rminus in |- *; rewrite (Ropp_involutive a); + generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; + intro; elim (Rplus_ne a); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (a + a) a 0 H r0); + intro; apply (Rlt_le (a + a) 0 H0). (**) -Apply (Rle_compatibility a b (Ropp b)); - Apply (Rminus_le b (Ropp b));Unfold Rminus;Rewrite (Ropp_Ropp b); - Generalize (Rlt_compatibility b b R0 r);Clear r0 r1;Intro; - Elim (Rplus_ne b);Intros v w;Rewrite v in H;Clear v w; - Generalize (Rlt_trans (Rplus b b) b R0 H r);Intro; - Apply (Rlt_le (Rplus b b) R0 H0). +apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b)); + unfold Rminus in |- *; rewrite (Ropp_involutive b); + generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; + intro; elim (Rplus_ne b); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (b + b) b 0 H r); + intro; apply (Rlt_le (b + b) 0 H0). (**) -Unfold Rle;Right;Reflexivity. +unfold Rle in |- *; right; reflexivity. Qed. (*********) -Lemma Rabsolu_triang_inv:(a,b:R)(Rle (Rminus (Rabsolu a) (Rabsolu b)) - (Rabsolu (Rminus a b))). -Intros; - Apply (Rle_anti_compatibility (Rabsolu b) - (Rminus (Rabsolu a) (Rabsolu b)) (Rabsolu (Rminus a b))); - Unfold Rminus; - Rewrite <- (Rplus_assoc (Rabsolu b) (Rabsolu a) (Ropp (Rabsolu b))); - Rewrite (Rplus_sym (Rabsolu b) (Rabsolu a)); - Rewrite (Rplus_assoc (Rabsolu a) (Rabsolu b) (Ropp (Rabsolu b))); - Rewrite (Rplus_Ropp_r (Rabsolu b)); - Rewrite (proj1 ? ? (Rplus_ne (Rabsolu a))); - Replace (Rabsolu a) with (Rabsolu (Rplus a R0)). - Rewrite <- (Rplus_Ropp_r b); - Rewrite <- (Rplus_assoc a b (Ropp b)); - Rewrite (Rplus_sym a b); - Rewrite (Rplus_assoc b a (Ropp b)). - Exact (Rabsolu_triang b (Rplus a (Ropp b))). - Rewrite (proj1 ? ? (Rplus_ne a));Trivial. +Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b). +intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b))); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b)); + rewrite (Rplus_comm (Rabs b) (Rabs a)); + rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b)); + rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a))); + replace (Rabs a) with (Rabs (a + 0)). + rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b)); + rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)). + exact (Rabs_triang b (a + - b)). + rewrite (proj1 (Rplus_ne a)); trivial. Qed. (* ||a|-|b||<=|a-b| *) -Lemma Rabsolu_triang_inv2 : (a,b:R) ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))<=(Rabsolu (a-b))``. -Cut (a,b:R) ``(Rabsolu b)<=(Rabsolu a)``->``(Rabsolu ((Rabsolu a)-(Rabsolu b))) <= (Rabsolu (a-b))``. -Intros; NewDestruct (total_order (Rabsolu a) (Rabsolu b)) as [Hlt|[Heq|Hgt]]. -Rewrite <- (Rabsolu_Ropp ``(Rabsolu a)-(Rabsolu b)``); Rewrite <- (Rabsolu_Ropp ``a-b``); Do 2 Rewrite Ropp_distr2. -Apply H; Left; Assumption. -Rewrite Heq; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos. -Apply H; Left; Assumption. -Intros; Replace ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))`` with ``(Rabsolu a)-(Rabsolu b)``. -Apply Rabsolu_triang_inv. -Rewrite (Rabsolu_right ``(Rabsolu a)-(Rabsolu b)``); [Reflexivity | Apply Rle_sym1; Apply Rle_anti_compatibility with (Rabsolu b); Rewrite Rplus_Or; Replace ``(Rabsolu b)+((Rabsolu a)-(Rabsolu b))`` with (Rabsolu a); [Assumption | Ring]]. +Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). +cut + (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). +intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]]. +rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b)); + do 2 rewrite Ropp_minus_distr. +apply H; left; assumption. +rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rabs_pos. +apply H; left; assumption. +intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). +apply Rabs_triang_inv. +rewrite (Rabs_right (Rabs a - Rabs b)); + [ reflexivity + | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r; + replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); + [ assumption | ring ] ]. Qed. (*********) -Lemma Rabsolu_def1:(x,a:R)(Rlt x a)->(Rlt (Ropp a) x)->(Rlt (Rabsolu x) a). -Unfold Rabsolu;Intros;Case (case_Rabsolu x);Intro. -Generalize (Rlt_Ropp (Ropp a) x H0);Unfold Rgt;Rewrite Ropp_Ropp;Intro; - Assumption. -Assumption. +Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a. +unfold Rabs in |- *; intros; case (Rcase_abs x); intro. +generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *; + rewrite Ropp_involutive; intro; assumption. +assumption. Qed. (*********) -Lemma Rabsolu_def2:(x,a:R)(Rlt (Rabsolu x) a)->(Rlt x a)/\(Rlt (Ropp a) x). -Unfold Rabsolu;Intro x;Case (case_Rabsolu x);Intros. -Generalize (Rlt_RoppO x r);Unfold Rgt;Intro; - Generalize (Rlt_trans R0 (Ropp x) a H0 H);Intro;Split. -Apply (Rlt_trans x R0 a r H1). -Generalize (Rlt_Ropp (Ropp x) a H);Rewrite (Ropp_Ropp x);Unfold Rgt;Trivial. -Fold (Rgt a x) in H;Generalize (Rgt_ge_trans a x R0 H r);Intro; - Generalize (Rgt_RoppO a H0);Intro;Fold (Rgt R0 (Ropp a)); - Generalize (Rge_gt_trans x R0 (Ropp a) r H1);Unfold Rgt;Intro;Split; - Assumption. -Qed. - -Lemma RmaxAbs: - (p, q, r : R) - (Rle p q) -> (Rle q r) -> (Rle (Rabsolu q) (Rmax (Rabsolu p) (Rabsolu r))). -Intros p q r H' H'0; Case (Rle_or_lt R0 p); Intros H'1. -Repeat Rewrite Rabsolu_right; Auto with real. -Apply Rle_trans with r; Auto with real. -Apply RmaxLess2; Auto. -Apply Rge_trans with p; Auto with real; Apply Rge_trans with q; Auto with real. -Apply Rge_trans with p; Auto with real. -Rewrite (Rabsolu_left p); Auto. -Case (Rle_or_lt R0 q); Intros H'2. -Repeat Rewrite Rabsolu_right; Auto with real. -Apply Rle_trans with r; Auto. -Apply RmaxLess2; Auto. -Apply Rge_trans with q; Auto with real. -Rewrite (Rabsolu_left q); Auto. -Case (Rle_or_lt R0 r); Intros H'3. -Repeat Rewrite Rabsolu_right; Auto with real. -Apply Rle_trans with (Ropp p); Auto with real. -Apply RmaxLess1; Auto. -Rewrite (Rabsolu_left r); Auto. -Apply Rle_trans with (Ropp p); Auto with real. -Apply RmaxLess1; Auto. -Qed. - -Lemma Rabsolu_Zabs: (z : Z) (Rabsolu (IZR z)) == (IZR (Zabs z)). -Intros z; Case z; Simpl; Auto with real. -Apply Rabsolu_right; Auto with real. -Intros p0; Apply Rabsolu_right; Auto with real zarith. -Intros p0; Rewrite Rabsolu_Ropp. -Apply Rabsolu_right; Auto with real zarith. -Qed. - +Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x. +unfold Rabs in |- *; intro x; case (Rcase_abs x); intros. +generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro; + generalize (Rlt_trans 0 (- x) a H0 H); intro; split. +apply (Rlt_trans x 0 a r H1). +generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x); + unfold Rgt in |- *; trivial. +fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro; + generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *; + generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; + intro; split; assumption. +Qed. + +Lemma RmaxAbs : + forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r). +intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1. +repeat rewrite Rabs_right; auto with real. +apply Rle_trans with r; auto with real. +apply RmaxLess2; auto. +apply Rge_trans with p; auto with real; apply Rge_trans with q; + auto with real. +apply Rge_trans with p; auto with real. +rewrite (Rabs_left p); auto. +case (Rle_or_lt 0 q); intros H'2. +repeat rewrite Rabs_right; auto with real. +apply Rle_trans with r; auto. +apply RmaxLess2; auto. +apply Rge_trans with q; auto with real. +rewrite (Rabs_left q); auto. +case (Rle_or_lt 0 r); intros H'3. +repeat rewrite Rabs_right; auto with real. +apply Rle_trans with (- p); auto with real. +apply RmaxLess1; auto. +rewrite (Rabs_left r); auto. +apply Rle_trans with (- p); auto with real. +apply RmaxLess1; auto. +Qed. + +Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs z). +intros z; case z; simpl in |- *; auto with real. +apply Rabs_right; auto with real. +intros p0; apply Rabs_right; auto with real zarith. +intros p0; rewrite Rabs_Ropp. +apply Rabs_right; auto with real zarith. +Qed. +
\ No newline at end of file diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v index 5dca3068c..53624cbb2 100644 --- a/theories/Reals/Rcomplete.v +++ b/theories/Reals/Rcomplete.v @@ -8,12 +8,11 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require SeqProp. -Require Max. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import SeqProp. +Require Import Max. Open Local Scope R_scope. (****************************************************) @@ -24,152 +23,176 @@ Open Local Scope R_scope. (* Proof with adjacent sequences (Vn and Wn) *) (****************************************************) -Theorem R_complete : (Un:nat->R) (Cauchy_crit Un) -> (sigTT R [l:R](Un_cv Un l)). -Intros. -Pose Vn := (sequence_minorant Un (cauchy_min Un H)). -Pose Wn := (sequence_majorant Un (cauchy_maj Un H)). -Assert H0 := (maj_cv Un H). -Fold Wn in H0. -Assert H1 := (min_cv Un H). -Fold Vn in H1. -Elim H0; Intros. -Elim H1; Intros. -Cut x==x0. -Intros. -Apply existTT with x. -Rewrite <- H2 in p0. -Unfold Un_cv. -Intros. -Unfold Un_cv in p; Unfold Un_cv in p0. -Cut ``0<eps/3``. -Intro. -Elim (p ``eps/3`` H4); Intros. -Elim (p0 ``eps/3`` H4); Intros. -Exists (max x1 x2). -Intros. -Unfold R_dist. -Apply Rle_lt_trans with ``(Rabsolu ((Un n)-(Vn n)))+(Rabsolu ((Vn n)-x))``. -Replace ``(Un n)-x`` with ``((Un n)-(Vn n))+((Vn n)-x)``; [Apply Rabsolu_triang | Ring]. -Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-(Vn n)))+(Rabsolu ((Vn n)-x))``. -Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``). -Apply Rle_compatibility. -Repeat Rewrite Rabsolu_right. -Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-(Vn n)``); Apply Rle_compatibility. -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_sym1. -Unfold Rminus; Apply Rle_anti_compatibility with (Vn n). -Rewrite Rplus_Or. -Replace ``(Vn n)+((Wn n)+ -(Vn n))`` with (Wn n); [Idtac | Ring]. -Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). -Fold Vn Wn in H8. -Elim (H8 n); Intros. -Apply Rle_trans with (Un n); Assumption. -Apply Rle_sym1. -Unfold Rminus; Apply Rle_anti_compatibility with (Vn n). -Rewrite Rplus_Or. -Replace ``(Vn n)+((Un n)+ -(Vn n))`` with (Un n); [Idtac | Ring]. -Assert H8 := (Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). -Fold Vn Wn in H8. -Elim (H8 n); Intros. -Assumption. -Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-x))+(Rabsolu (x-(Vn n)))+(Rabsolu ((Vn n)-x))``. -Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``). -Apply Rle_compatibility. -Replace ``(Wn n)-(Vn n)`` with ``((Wn n)-x)+(x-(Vn n))``; [Apply Rabsolu_triang | Ring]. -Apply Rlt_le_trans with ``eps/3+eps/3+eps/3``. -Repeat Apply Rplus_lt. -Unfold R_dist in H5. -Apply H5. -Unfold ge; Apply le_trans with (max x1 x2). -Apply le_max_l. -Assumption. -Rewrite <- Rabsolu_Ropp. -Replace ``-(x-(Vn n))`` with ``(Vn n)-x``; [Idtac | Ring]. -Unfold R_dist in H6. -Apply H6. -Unfold ge; Apply le_trans with (max x1 x2). -Apply le_max_r. -Assumption. -Unfold R_dist in H6. -Apply H6. -Unfold ge; Apply le_trans with (max x1 x2). -Apply le_max_r. -Assumption. -Right. -Pattern 4 eps; Replace ``eps`` with ``3*eps/3``. -Ring. -Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Apply cond_eq. -Intros. -Cut ``0<eps/5``. -Intro. -Unfold Un_cv in p; Unfold Un_cv in p0. -Unfold R_dist in p; Unfold R_dist in p0. -Elim (p ``eps/5`` H3); Intros N1 H4. -Elim (p0 ``eps/5`` H3); Intros N2 H5. -Unfold Cauchy_crit in H. -Unfold R_dist in H. -Elim (H ``eps/5`` H3); Intros N3 H6. -Pose N := (max (max N1 N2) N3). -Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-x0))``. -Replace ``x-x0`` with ``(x-(Wn N))+((Wn N)-x0)``; [Apply Rabsolu_triang | Ring]. -Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-(Vn N)))+(Rabsolu (((Vn N)-x0)))``. -Rewrite Rplus_assoc. -Apply Rle_compatibility. -Replace ``(Wn N)-x0`` with ``((Wn N)-(Vn N))+((Vn N)-x0)``; [Apply Rabsolu_triang | Ring]. -Replace ``eps`` with ``eps/5+3*eps/5+eps/5``. -Repeat Apply Rplus_lt. -Rewrite <- Rabsolu_Ropp. -Replace ``-(x-(Wn N))`` with ``(Wn N)-x``; [Apply H4 | Ring]. -Unfold ge N. -Apply le_trans with (max N1 N2); Apply le_max_l. -Unfold Wn Vn. -Unfold sequence_majorant sequence_minorant. -Assert H7 := (approx_maj [k:nat](Un (plus N k)) (maj_ss Un N (cauchy_maj Un H))). -Assert H8 := (approx_min [k:nat](Un (plus N k)) (min_ss Un N (cauchy_min Un H))). -Cut (Wn N)==(majorant ([k:nat](Un (plus N k))) (maj_ss Un N (cauchy_maj Un H))). -Cut (Vn N)==(minorant ([k:nat](Un (plus N k))) (min_ss Un N (cauchy_min Un H))). -Intros. -Rewrite <- H9; Rewrite <- H10. -Rewrite <- H9 in H8. -Rewrite <- H10 in H7. -Elim (H7 ``eps/5`` H3); Intros k2 H11. -Elim (H8 ``eps/5`` H3); Intros k1 H12. -Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Vn N)))``. -Replace ``(Wn N)-(Vn N)`` with ``((Wn N)-(Un (plus N k2)))+((Un (plus N k2))-(Vn N))``; [Apply Rabsolu_triang | Ring]. -Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Un (plus N k1))))+(Rabsolu ((Un (plus N k1))-(Vn N)))``. -Rewrite Rplus_assoc. -Apply Rle_compatibility. -Replace ``(Un (plus N k2))-(Vn N)`` with ``((Un (plus N k2))-(Un (plus N k1)))+((Un (plus N k1))-(Vn N))``; [Apply Rabsolu_triang | Ring]. -Replace ``3*eps/5`` with ``eps/5+eps/5+eps/5``; [Repeat Apply Rplus_lt | Ring]. -Assumption. -Apply H6. -Unfold ge. -Apply le_trans with N. -Unfold N; Apply le_max_r. -Apply le_plus_l. -Unfold ge. -Apply le_trans with N. -Unfold N; Apply le_max_r. -Apply le_plus_l. -Rewrite <- Rabsolu_Ropp. -Replace ``-((Un (plus N k1))-(Vn N))`` with ``(Vn N)-(Un (plus N k1))``; [Assumption | Ring]. -Reflexivity. -Reflexivity. -Apply H5. -Unfold ge; Apply le_trans with (max N1 N2). -Apply le_max_r. -Unfold N; Apply le_max_l. -Pattern 4 eps; Replace ``eps`` with ``5*eps/5``. -Ring. -Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m. -DiscrR. -Unfold Rdiv; Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv. -Sup0; Try Apply lt_O_Sn. -Qed. +Theorem R_complete : + forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l). +intros. +pose (Vn := sequence_minorant Un (cauchy_min Un H)). +pose (Wn := sequence_majorant Un (cauchy_maj Un H)). +assert (H0 := maj_cv Un H). +fold Wn in H0. +assert (H1 := min_cv Un H). +fold Vn in H1. +elim H0; intros. +elim H1; intros. +cut (x = x0). +intros. +apply existT with x. +rewrite <- H2 in p0. +unfold Un_cv in |- *. +intros. +unfold Un_cv in p; unfold Un_cv in p0. +cut (0 < eps / 3). +intro. +elim (p (eps / 3) H4); intros. +elim (p0 (eps / 3) H4); intros. +exists (max x1 x2). +intros. +unfold R_dist in |- *. +apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)). +replace (Un n - x) with (Un n - Vn n + (Vn n - x)); + [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)). +do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). +apply Rplus_le_compat_l. +repeat rewrite Rabs_right. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n)); + apply Rplus_le_compat_l. +assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). +fold Vn Wn in H8. +elim (H8 n); intros. +assumption. +apply Rle_ge. +unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). +rewrite Rplus_0_r. +replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ]. +assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). +fold Vn Wn in H8. +elim (H8 n); intros. +apply Rle_trans with (Un n); assumption. +apply Rle_ge. +unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). +rewrite Rplus_0_r. +replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ]. +assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). +fold Vn Wn in H8. +elim (H8 n); intros. +assumption. +apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)). +do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). +apply Rplus_le_compat_l. +replace (Wn n - Vn n) with (Wn n - x + (x - Vn n)); + [ apply Rabs_triang | ring ]. +apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3). +repeat apply Rplus_lt_compat. +unfold R_dist in H5. +apply H5. +unfold ge in |- *; apply le_trans with (max x1 x2). +apply le_max_l. +assumption. +rewrite <- Rabs_Ropp. +replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ]. +unfold R_dist in H6. +apply H6. +unfold ge in |- *; apply le_trans with (max x1 x2). +apply le_max_r. +assumption. +unfold R_dist in H6. +apply H6. +unfold ge in |- *; apply le_trans with (max x1 x2). +apply le_max_r. +assumption. +right. +pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). +ring. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +apply cond_eq. +intros. +cut (0 < eps / 5). +intro. +unfold Un_cv in p; unfold Un_cv in p0. +unfold R_dist in p; unfold R_dist in p0. +elim (p (eps / 5) H3); intros N1 H4. +elim (p0 (eps / 5) H3); intros N2 H5. +unfold Cauchy_crit in H. +unfold R_dist in H. +elim (H (eps / 5) H3); intros N3 H6. +pose (N := max (max N1 N2) N3). +apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)). +replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with + (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)). +rewrite Rplus_assoc. +apply Rplus_le_compat_l. +replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0)); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5). +repeat apply Rplus_lt_compat. +rewrite <- Rabs_Ropp. +replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ]. +unfold ge, N in |- *. +apply le_trans with (max N1 N2); apply le_max_l. +unfold Wn, Vn in |- *. +unfold sequence_majorant, sequence_minorant in |- *. +assert + (H7 := + approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). +assert + (H8 := + approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). +cut + (Wn N = + majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). +cut + (Vn N = + minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). +intros. +rewrite <- H9; rewrite <- H10. +rewrite <- H9 in H8. +rewrite <- H10 in H7. +elim (H7 (eps / 5) H3); intros k2 H11. +elim (H8 (eps / 5) H3); intros k1 H12. +apply Rle_lt_trans with + (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)). +replace (Wn N - Vn N) with + (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N)); + [ apply Rabs_triang | ring ]. +apply Rle_lt_trans with + (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) + + Rabs (Un (N + k1)%nat - Vn N)). +rewrite Rplus_assoc. +apply Rplus_le_compat_l. +replace (Un (N + k2)%nat - Vn N) with + (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N)); + [ apply Rabs_triang | ring ]. +replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5); + [ repeat apply Rplus_lt_compat | ring ]. +assumption. +apply H6. +unfold ge in |- *. +apply le_trans with N. +unfold N in |- *; apply le_max_r. +apply le_plus_l. +unfold ge in |- *. +apply le_trans with N. +unfold N in |- *; apply le_max_r. +apply le_plus_l. +rewrite <- Rabs_Ropp. +replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat); + [ assumption | ring ]. +reflexivity. +reflexivity. +apply H5. +unfold ge in |- *; apply le_trans with (max N1 N2). +apply le_max_r. +unfold N in |- *; apply le_max_l. +pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)). +ring. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +discrR. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat. +prove_sup0; try apply lt_O_Sn. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v index 75a082cfc..a862a0ac3 100644 --- a/theories/Reals/Rdefinitions.v +++ b/theories/Reals/Rdefinitions.v @@ -15,55 +15,55 @@ Require Export ZArith_base. -Parameter R:Set. +Parameter R : Set. (* Declare Scope positive_scope with Key R *) -Delimits Scope R_scope with R. +Delimit Scope R_scope with R. (* Automatically open scope R_scope for arguments of type R *) Bind Scope R_scope with R. -Parameter R0:R. -Parameter R1:R. -Parameter Rplus:R->R->R. -Parameter Rmult:R->R->R. -Parameter Ropp:R->R. -Parameter Rinv:R->R. -Parameter Rlt:R->R->Prop. -Parameter up:R->Z. +Parameter R0 : R. +Parameter R1 : R. +Parameter Rplus : R -> R -> R. +Parameter Rmult : R -> R -> R. +Parameter Ropp : R -> R. +Parameter Rinv : R -> R. +Parameter Rlt : R -> R -> Prop. +Parameter up : R -> Z. -V8Infix "+" Rplus : R_scope. -V8Infix "*" Rmult : R_scope. -V8Notation "- x" := (Ropp x) : R_scope. -V8Notation "/ x" := (Rinv x) : R_scope. +Infix "+" := Rplus : R_scope. +Infix "*" := Rmult : R_scope. +Notation "- x" := (Ropp x) : R_scope. +Notation "/ x" := (Rinv x) : R_scope. -V8Infix "<" Rlt : R_scope. +Infix "<" := Rlt : R_scope. (*i*******************************************************i*) (**********) -Definition Rgt:R->R->Prop:=[r1,r2:R](Rlt r2 r1). +Definition Rgt (r1 r2:R) : Prop := (r2 < r1)%R. (**********) -Definition Rle:R->R->Prop:=[r1,r2:R]((Rlt r1 r2)\/(r1==r2)). +Definition Rle (r1 r2:R) : Prop := (r1 < r2)%R \/ r1 = r2. (**********) -Definition Rge:R->R->Prop:=[r1,r2:R]((Rgt r1 r2)\/(r1==r2)). +Definition Rge (r1 r2:R) : Prop := Rgt r1 r2 \/ r1 = r2. (**********) -Definition Rminus:R->R->R:=[r1,r2:R](Rplus r1 (Ropp r2)). +Definition Rminus (r1 r2:R) : R := (r1 + - r2)%R. (**********) -Definition Rdiv:R->R->R:=[r1,r2:R](Rmult r1 (Rinv r2)). +Definition Rdiv (r1 r2:R) : R := (r1 * / r2)%R. -V8Infix "-" Rminus : R_scope. -V8Infix "/" Rdiv : R_scope. +Infix "-" := Rminus : R_scope. +Infix "/" := Rdiv : R_scope. -V8Infix "<=" Rle : R_scope. -V8Infix ">=" Rge : R_scope. -V8Infix ">" Rgt : R_scope. +Infix "<=" := Rle : R_scope. +Infix ">=" := Rge : R_scope. +Infix ">" := Rgt : R_scope. -V8Notation "x <= y <= z" := (Rle x y)/\(Rle y z) : R_scope. -V8Notation "x <= y < z" := (Rle x y)/\(Rlt y z) : R_scope. -V8Notation "x < y < z" := (Rlt x y)/\(Rlt y z) : R_scope. -V8Notation "x < y <= z" := (Rlt x y)/\(Rle y z) : R_scope. +Notation "x <= y <= z" := ((x <= y)%R /\ (y <= z)%R) : R_scope. +Notation "x <= y < z" := ((x <= y)%R /\ (y < z)%R) : R_scope. +Notation "x < y < z" := ((x < y)%R /\ (y < z)%R) : R_scope. +Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope.
\ No newline at end of file diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v index 4f7420306..3f56ccdf1 100644 --- a/theories/Reals/Rderiv.v +++ b/theories/Reals/Rderiv.v @@ -13,441 +13,419 @@ (* *) (*********************************************************) -Require Rbase. -Require Rfunctions. -Require Rlimit. -Require Fourier. -Require Classical_Prop. -Require Classical_Pred_Type. -Require Omega. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rlimit. +Require Import Fourier. +Require Import Classical_Prop. +Require Import Classical_Pred_Type. +Require Import Omega. Open Local Scope R_scope. (*********) -Definition D_x:(R->Prop)->R->R->Prop:=[D:R->Prop][y:R][x:R] - (D x)/\(~y==x). +Definition D_x (D:R -> Prop) (y x:R) : Prop := D x /\ y <> x. (*********) -Definition continue_in:(R->R)->(R->Prop)->R->Prop:= - [f:R->R; D:R->Prop; x0:R](limit1_in f (D_x D x0) (f x0) x0). +Definition continue_in (f:R -> R) (D:R -> Prop) (x0:R) : Prop := + limit1_in f (D_x D x0) (f x0) x0. (*********) -Definition D_in:(R->R)->(R->R)->(R->Prop)->R->Prop:= - [f:R->R; d:R->R; D:R->Prop; x0:R](limit1_in - [x:R] (Rdiv (Rminus (f x) (f x0)) (Rminus x x0)) - (D_x D x0) (d x0) x0). +Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop := + limit1_in (fun x:R => (f x - f x0) / (x - x0)) (D_x D x0) (d x0) x0. (*********) -Lemma cont_deriv:(f,d:R->R;D:R->Prop;x0:R) - (D_in f d D x0)->(continue_in f D x0). -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_EM (d x0) R0);Intro. -Split with (Rmin R1 x);Split. -Elim (Rmin_Rgt R1 x R0);Intros a b; - Apply (b (conj (Rgt R1 R0) (Rgt x R0) Rlt_R0_R1 H)). -Intros;Elim H3;Clear H3;Intros; -Generalize (let (H1,H2)=(Rmin_Rgt R1 x (R_dist x1 x0)) in H1); - Unfold Rgt;Intro;Elim (H5 H4);Clear H5;Intros; - Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H6)); - Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros. -Rewrite H2 in H1;Unfold R_dist; Unfold R_dist in H1; - Cut (Rlt (Rabsolu (Rminus (f x1) (f x0))) - (Rmult eps (Rabsolu (Rminus x1 x0)))). -Intro;Unfold R_dist in H5; - Generalize (Rlt_monotony eps ``(Rabsolu (x1-x0))`` ``1`` H0 H5); -Rewrite Rmult_1r;Intro;Apply Rlt_trans with r2:=``eps*(Rabsolu (x1-x0))``; - Assumption. -Rewrite (minus_R0 ``((f x1)-(f x0))*/(x1-x0)``) in H1; - Rewrite Rabsolu_mult in H1; Cut ``x1-x0 <> 0``. -Intro;Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9) in H1; - Generalize (Rlt_monotony ``(Rabsolu (x1-x0))`` - ``(Rabsolu ((f x1)-(f x0)))*/(Rabsolu (x1-x0))`` eps - (Rabsolu_pos_lt ``x1-x0`` H9) H1);Intro; Rewrite Rmult_sym in H10; - Rewrite Rmult_assoc in H10;Rewrite Rinv_l in H10. -Rewrite Rmult_1r in H10;Rewrite Rmult_sym;Assumption. -Apply Rabsolu_no_R0;Auto. -Apply Rminus_eq_contra;Auto. +Lemma cont_deriv : + forall (f d:R -> R) (D:R -> Prop) (x0:R), + D_in f d D x0 -> continue_in f D x0. +unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; + intros; elim (H eps H0); clear H; intros; elim H; + clear H; intros; elim (Req_dec (d x0) 0); intro. +split with (Rmin 1 x); split. +elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)). +intros; elim H3; clear H3; intros; + generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1); + unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (H1 x1 (conj H3 H6)); clear H1; + intro; unfold D_x in H3; elim H3; intros. +rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1; + cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)). +intro; unfold R_dist in H5; + generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5); + rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0)); + assumption. +rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1; + rewrite Rabs_mult in H1; cut (x1 - x0 <> 0). +intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1; + generalize + (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0)) + eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10; + rewrite Rmult_assoc in H10; rewrite Rinv_l in H10. +rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption. +apply Rabs_no_R0; auto. +apply Rminus_eq_contra; auto. (**) - Split with (Rmin (Rmin (Rinv (Rplus R1 R1)) x) - (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0)))))); - Split. -Cut (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0). -Cut (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0). -Intros;Elim (Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x) - (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0); - Intros a b; - Apply (b (conj (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0) - (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0) - H4 H3)). -Apply Rmult_gt;Auto. -Unfold Rgt;Apply Rlt_Rinv;Apply Rabsolu_pos_lt;Apply mult_non_zero; - Split. -DiscrR. -Assumption. -Elim (Rmin_Rgt (Rinv (Rplus R1 R1)) x R0);Intros a b; - Cut (Rlt R0 (Rplus R1 R1)). -Intro;Generalize (Rlt_Rinv (Rplus R1 R1) H3);Intro; - Fold (Rgt (Rinv (Rplus R1 R1)) R0) in H4; - Apply (b (conj (Rgt (Rinv (Rplus R1 R1)) R0) (Rgt x R0) H4 H)). -Fourier. -Intros;Elim H3;Clear H3;Intros; - Generalize (let (H1,H2)=(Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x) - (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) - (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H5 H4);Clear H5; - Intros; - Generalize (let (H1,H2)=(Rmin_Rgt (Rinv (Rplus R1 R1)) x - (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H7 H5);Clear H7; - Intros;Clear H4 H5; - Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H8)); - Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros; - Generalize (sym_not_eqT R x0 x1 H5);Clear H5;Intro H5; - Generalize (Rminus_eq_contra x1 x0 H5); - Intro;Generalize H1;Pattern 1 (d x0); - Rewrite <-(let (H1,H2)=(Rmult_ne (d x0)) in H2); - Rewrite <-(Rinv_l (Rminus x1 x0) H9); Unfold R_dist;Unfold 1 Rminus; - Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))); - Rewrite (Rmult_sym (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)) (d x0)); - Rewrite <-(Ropp_mul1 (d x0) (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0))); - Rewrite (Rmult_sym (Ropp (d x0)) - (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0))); - Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus x1 x0) (Ropp (d x0))); - Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0)) - (Rmult (Rminus x1 x0) (Ropp (d x0)))); - Rewrite (Rabsolu_mult (Rinv (Rminus x1 x0)) - (Rplus (Rminus (f x1) (f x0)) - (Rmult (Rminus x1 x0) (Ropp (d x0))))); - Clear H1;Intro;Generalize (Rlt_monotony (Rabsolu (Rminus x1 x0)) - (Rmult (Rabsolu (Rinv (Rminus x1 x0))) - (Rabsolu - (Rplus (Rminus (f x1) (f x0)) - (Rmult (Rminus x1 x0) (Ropp (d x0)))))) eps - (Rabsolu_pos_lt (Rminus x1 x0) H9) H1); - Rewrite <-(Rmult_assoc (Rabsolu (Rminus x1 x0)) - (Rabsolu (Rinv (Rminus x1 x0))) - (Rabsolu - (Rplus (Rminus (f x1) (f x0)) - (Rmult (Rminus x1 x0) (Ropp (d x0)))))); - Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9); - Rewrite (Rinv_r (Rabsolu (Rminus x1 x0)) - (Rabsolu_no_R0 (Rminus x1 x0) H9)); - Rewrite (let (H1,H2)=(Rmult_ne (Rabsolu - (Rplus (Rminus (f x1) (f x0)) - (Rmult (Rminus x1 x0) (Ropp (d x0)))))) in H2); - Generalize (Rabsolu_triang_inv (Rminus (f x1) (f x0)) - (Rmult (Rminus x1 x0) (d x0)));Intro; - Rewrite (Rmult_sym (Rminus x1 x0) (Ropp (d x0))); - Rewrite (Ropp_mul1 (d x0) (Rminus x1 x0)); - Fold (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0))); - Rewrite (Rmult_sym (Rminus x1 x0) (d x0)) in H10; - Clear H1;Intro;Generalize (Rle_lt_trans - (Rminus (Rabsolu (Rminus (f x1) (f x0))) - (Rabsolu (Rmult (d x0) (Rminus x1 x0)))) - (Rabsolu - (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0)))) - (Rmult (Rabsolu (Rminus x1 x0)) eps) H10 H1); - Clear H1;Intro; - Generalize (Rlt_compatibility (Rabsolu (Rmult (d x0) (Rminus x1 x0))) - (Rminus (Rabsolu (Rminus (f x1) (f x0))) - (Rabsolu (Rmult (d x0) (Rminus x1 x0)))) - (Rmult (Rabsolu (Rminus x1 x0)) eps) H1); - Unfold 2 Rminus;Rewrite (Rplus_sym (Rabsolu (Rminus (f x1) (f x0))) - (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0))))); - Rewrite <-(Rplus_assoc (Rabsolu (Rmult (d x0) (Rminus x1 x0))) - (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0)))) - (Rabsolu (Rminus (f x1) (f x0)))); - Rewrite (Rplus_Ropp_r (Rabsolu (Rmult (d x0) (Rminus x1 x0)))); - Rewrite (let (H1,H2)=(Rplus_ne (Rabsolu (Rminus (f x1) (f x0)))) in H2); - Clear H1;Intro;Cut (Rlt (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0))) - (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps). -Intro;Apply (Rlt_trans (Rabsolu (Rminus (f x1) (f x0))) - (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0))) - (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps H1 H11). -Clear H1 H5 H3 H10;Generalize (Rabsolu_pos_lt (d x0) H2); - Intro;Unfold Rgt in H0;Generalize (Rlt_monotony eps (R_dist x1 x0) - (Rinv (Rplus R1 R1)) H0 H7);Clear H7;Intro; - Generalize (Rlt_monotony (Rabsolu (d x0)) (R_dist x1 x0) - (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) H1 H6); - Clear H6;Intro;Rewrite (Rmult_sym eps (R_dist x1 x0)) in H3; - Unfold R_dist in H3 H5; - Rewrite <-(Rabsolu_mult (d x0) (Rminus x1 x0)) in H5; - Rewrite (Rabsolu_mult (Rplus R1 R1) (d x0)) in H5; - Cut ~(Rabsolu (Rplus R1 R1))==R0. -Intro;Fold (Rgt (Rabsolu (d x0)) R0) in H1; - Rewrite (Rinv_Rmult (Rabsolu (Rplus R1 R1)) (Rabsolu (d x0)) - H6 (imp_not_Req (Rabsolu (d x0)) R0 - (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1))) - in H5; - Rewrite (Rmult_sym (Rabsolu (d x0)) (Rmult eps - (Rmult (Rinv (Rabsolu (Rplus R1 R1))) - (Rinv (Rabsolu (d x0)))))) in H5; - Rewrite <-(Rmult_assoc eps (Rinv (Rabsolu (Rplus R1 R1))) - (Rinv (Rabsolu (d x0)))) in H5; - Rewrite (Rmult_assoc (Rmult eps (Rinv (Rabsolu (Rplus R1 R1)))) - (Rinv (Rabsolu (d x0))) (Rabsolu (d x0))) in H5; - Rewrite (Rinv_l (Rabsolu (d x0)) (imp_not_Req (Rabsolu (d x0)) R0 - (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1))) - in H5; - Rewrite (let (H1,H2)=(Rmult_ne (Rmult eps (Rinv (Rabsolu (Rplus R1 R1))))) - in H1) in H5;Cut (Rabsolu (Rplus R1 R1))==(Rplus R1 R1). -Intro;Rewrite H7 in H5; - Generalize (Rplus_lt (Rabsolu (Rmult (d x0) (Rminus x1 x0))) - (Rmult eps (Rinv (Rplus R1 R1))) - (Rmult (Rabsolu (Rminus x1 x0)) eps) - (Rmult eps (Rinv (Rplus R1 R1))) H5 H3);Intro; - Rewrite eps2 in H10;Assumption. -Unfold Rabsolu;Case (case_Rabsolu (Rplus R1 R1));Auto. - Intro;Cut (Rlt R0 (Rplus R1 R1)). -Intro;Generalize (Rlt_antisym R0 (Rplus R1 R1) H7);Intro;ElimType False; - Auto. -Fourier. -Apply Rabsolu_no_R0. -DiscrR. + split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split. +cut (Rmin (/ 2) x > 0). +cut (eps * / Rabs (2 * d x0) > 0). +intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0); + intros a b; apply (b (conj H4 H3)). +apply Rmult_gt_0_compat; auto. +unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt; + apply Rmult_integral_contrapositive; split. +discrR. +assumption. +elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2). +intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4; + apply (b (conj H4 H)). +fourier. +intros; elim H3; clear H3; intros; + generalize + (let (H1, H2) := + Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in + H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1); + unfold Rgt in |- *; intro; elim (H7 H5); clear H7; + intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); + clear H1; intro; unfold D_x in H3; elim H3; intros; + generalize (sym_not_eq H5); clear H5; intro H5; + generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; + pattern (d x0) at 1 in |- *; + rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2); + rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *; + unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))); + rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0)); + rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0))); + rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0))); + rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0)); + rewrite <- + (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0)) + ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0)); + clear H1; intro; + generalize + (Rmult_lt_compat_l (Rabs (x1 - x0)) + (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps + (Rabs_pos_lt (x1 - x0) H9) H1); + rewrite <- + (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0))) + (Rabs (f x1 - f x0 + (x1 - x0) * - d x0))); + rewrite (Rabs_Rinv (x1 - x0) H9); + rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9)); + rewrite + (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2) + ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); + intro; rewrite (Rmult_comm (x1 - x0) (- d x0)); + rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0)); + fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *; + rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; + intro; + generalize + (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1); + clear H1; intro; + generalize + (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) ( + Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *; + rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0)))); + rewrite <- + (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0)))); + rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); + clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps). +intro; + apply + (Rlt_trans (Rabs (f x1 - f x0)) + (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). +clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro; + unfold Rgt in H0; + generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); + clear H7; intro; + generalize + (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) ( + eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro; + rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5; + rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5; + rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0). +intro; fold (Rabs (d x0) > 0) in H1; + rewrite + (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6 + (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) + in H5; + rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5; + rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5; + rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5; + rewrite + (Rinv_l (Rabs (d x0)) + (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) + in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5; + cut (Rabs 2 = 2). +intro; rewrite H7 in H5; + generalize + (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2) + (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; + rewrite eps2 in H10; assumption. +unfold Rabs in |- *; case (Rcase_abs 2); auto. + intro; cut (0 < 2). +intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto. +fourier. +apply Rabs_no_R0. +discrR. Qed. (*********) -Lemma Dconst:(D:R->Prop)(y:R)(x0:R)(D_in [x:R]y [x:R]R0 D x0). -Unfold D_in;Intros;Unfold limit1_in;Unfold limit_in;Unfold Rdiv;Intros;Simpl; - Split with eps;Split;Auto. -Intros;Rewrite (eq_Rminus y y (refl_eqT R y)); - Rewrite Rmult_Ol;Unfold R_dist; - Rewrite (eq_Rminus R0 R0 (refl_eqT R R0));Unfold Rabsolu; - Case (case_Rabsolu R0);Intro. -Absurd (Rlt R0 R0);Auto. -Red;Intro;Apply (Rlt_antirefl R0 H1). -Unfold Rgt in H0;Assumption. +Lemma Dconst : + forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0. +unfold D_in in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold Rdiv in |- *; intros; + simpl in |- *; split with eps; split; auto. +intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l; + unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0)); + unfold Rabs in |- *; case (Rcase_abs 0); intro. +absurd (0 < 0); auto. +red in |- *; intro; apply (Rlt_irrefl 0 H1). +unfold Rgt in H0; assumption. Qed. (*********) -Lemma Dx:(D:R->Prop)(x0:R)(D_in [x:R]x [x:R]R1 D x0). -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 (Rminus x x0) (Rminus_eq_contra x x0 - (sym_not_eqT R x0 x H3))); - Unfold R_dist; - Rewrite (eq_Rminus R1 R1 (refl_eqT R R1));Unfold Rabsolu; - Case (case_Rabsolu R0);Intro. -Absurd (Rlt R0 R0);Auto. -Red;Intro;Apply (Rlt_antirefl R0 r). -Unfold Rgt in H;Assumption. +Lemma Dx : + forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0. +unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; intros; simpl in |- *; split with eps; + split; auto. +intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros; + rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3))); + unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1)); + unfold Rabs in |- *; case (Rcase_abs 0); intro. +absurd (0 < 0); auto. +red in |- *; intro; apply (Rlt_irrefl 0 r). +unfold Rgt in H; assumption. Qed. (*********) -Lemma Dadd:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R) - (D_in f df D x0)->(D_in g dg D x0)-> - (D_in [x:R](Rplus (f x) (g x)) [x:R](Rplus (df x) (dg x)) D x0). -Unfold D_in;Intros;Generalize (limit_plus - [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) - [x:R](Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0))) - (D_x D x0) (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_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1; - Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1; - Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) - (Rminus (f x1) (f x0)) - (Rminus (g x1) (g x0))) in H1; - Rewrite (Rmult_sym (Rinv (Rminus x1 x0)) - (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))) in H1; - Cut (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))== - (Rminus (Rplus (f x1) (g x1)) (Rplus (f x0) (g x0))). -Intro;Rewrite H3 in H1;Assumption. -Ring. +Lemma Dadd : + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0. +unfold D_in in |- *; intros; + generalize + (limit_plus (fun x:R => (f x - f x0) * / (x - x0)) + (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) ( + df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); + clear H; intros; elim H; clear H; intros; split with x; + split; auto; intros; generalize (H1 x1 H2); clear H1; + intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; + rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0)) + in H1; + rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1; + cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)). +intro; rewrite H3 in H1; assumption. +ring. Qed. (*********) -Lemma Dmult:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R) - (D_in f df D x0)->(D_in g dg D x0)-> - (D_in [x:R](Rmult (f x) (g x)) - [x:R](Rplus (Rmult (df x) (g x)) (Rmult (f x) (dg x))) D x0). -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 - [x:R](Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0))) - [x:R](f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3);Intro; - Cut (limit1_in [x:R](g x0) (D_x D x0) (g x0) x0). -Intro;Generalize (limit_mul - [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) - [_:R](g x0) (D_x D x0) (df x0) (g x0) x0 H H5);Clear H H0 H1 H2 H3 H5; - Intro;Generalize (limit_plus - [x:R](Rmult (Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) (g x0)) - [x:R](Rmult (Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0))) - (f x)) (D_x D x0) (Rmult (df x0) (g x0)) - (Rmult (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;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_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1; - Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1; - Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0)) - (g x0)) in H1; - Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (g x1) (g x0)) - (f x1)) in H1; - Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) - (Rmult (Rminus (f x1) (f x0)) (g x0)) - (Rmult (Rminus (g x1) (g x0)) (f x1))) in H1; - Rewrite (Rmult_sym (Rinv (Rminus x1 x0)) - (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0)) - (Rmult (Rminus (g x1) (g x0)) (f x1)))) in H1; - Rewrite (Rmult_sym (dg x0) (f x0)) in H1; - Cut (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0)) - (Rmult (Rminus (g x1) (g x0)) (f x1)))== - (Rminus (Rmult (f x1) (g x1)) (Rmult (f x0) (g x0))). -Intro;Rewrite H3 in H1;Assumption. -Ring. -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_eqT R (g x0)));Unfold Rgt in H;Assumption. +Lemma Dmult : + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0. +intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0; + generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; + intro; + generalize + (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( + fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); + intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0). +intro; + generalize + (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( + fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5); + clear H H0 H1 H2 H3 H5; intro; + generalize + (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0) + (fun x:R => (g x - g x0) * / (x - x0) * f x) ( + D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); + clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; + simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; intros; elim (H eps H0); clear H; intros; + elim H; clear H; intros; split with x; split; auto; + intros; generalize (H1 x1 H2); clear H1; intro; + rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1; + rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1; + rewrite <- + (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0) + ((g x1 - g x0) * f x1)) in H1; + rewrite + (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1)) + in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1; + cut + ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0). +intro; rewrite H3 in H1; assumption. +ring. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0)); + intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; + assumption. Qed. (*********) -Lemma Dmult_const:(D:R->Prop)(f,df:R->R)(x0:R)(a:R)(D_in f df D x0)-> - (D_in [x:R](Rmult a (f x)) ([x:R](Rmult a (df x))) D x0). -Intros;Generalize (Dmult D [_:R]R0 df [_:R]a f x0 (Dconst D a x0) H); - Unfold D_in;Intros; - Rewrite (Rmult_Ol (f x0)) in H0; - Rewrite (let (H1,H2)=(Rplus_ne (Rmult a (df x0))) in H2) in H0; - Assumption. +Lemma Dmult_const : + forall (D:R -> Prop) (f df:R -> R) (x0 a:R), + D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0. +intros; + generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H); + unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0; + rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; + assumption. Qed. (*********) -Lemma Dopp:(D:R->Prop)(f,df:R->R)(x0:R)(D_in f df D x0)-> - (D_in [x:R](Ropp (f x)) ([x:R](Ropp (df x))) D x0). -Intros;Generalize (Dmult_const D f df x0 (Ropp R1) 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;Intros;Split with x;Split;Auto. -Intros;Generalize (H2 x1 H3);Clear H2;Intro;Rewrite Ropp_mul1 in H2; - Rewrite Ropp_mul1 in H2;Rewrite Ropp_mul1 in H2; - Rewrite (let (H1,H2)=(Rmult_ne (f x1)) in H2) in H2; - Rewrite (let (H1,H2)=(Rmult_ne (f x0)) in H2) in H2; - Rewrite (let (H1,H2)=(Rmult_ne (df x0)) in H2) in H2;Assumption. +Lemma Dopp : + forall (D:R -> Prop) (f df:R -> R) (x0:R), + D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0. +intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; generalize (H0 eps H1); clear H0; intro; elim H0; + clear H0; intros; elim H0; clear H0; simpl in |- *; + intros; split with x; split; auto. +intros; generalize (H2 x1 H3); clear H2; intro; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2; + assumption. Qed. (*********) -Lemma Dminus:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R) - (D_in f df D x0)->(D_in g dg D x0)-> - (D_in [x:R](Rminus (f x) (g x)) [x:R](Rminus (df x) (dg x)) D x0). -Unfold Rminus;Intros;Generalize (Dopp D g dg x0 H0);Intro; - Apply (Dadd D df [x:R](Ropp (dg x)) f [x:R](Ropp (g x)) x0);Assumption. +Lemma Dminus : + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0. +unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro; + apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); + assumption. Qed. (*********) -Lemma Dx_pow_n:(n:nat)(D:R->Prop)(x0:R) - (D_in [x:R](pow x n) - [x:R](Rmult (INR n) (pow x (minus n (1)))) D x0). -Induction n;Intros. -Simpl; Rewrite Rmult_Ol; Apply Dconst. -Intros;Cut n0=(minus (S n0) (1)); - [ Intro a; Rewrite <- a;Clear a | Simpl; Apply minus_n_O ]. -Generalize (Dmult D [_:R]R1 - [x:R](Rmult (INR n0) (pow x (minus n0 (1)))) [x:R]x [x:R](pow x n0) - x0 (Dx D x0) (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; - Rewrite (let (H1,H2)=(Rmult_ne (pow x0 n0)) in H2) in H2; - Rewrite (tech_pow_Rmult x1 n0) in H2; - Rewrite (tech_pow_Rmult x0 n0) in H2; - Rewrite (Rmult_sym (INR n0) (pow x0 (minus n0 (1)))) in H2; - Rewrite <-(Rmult_assoc x0 (pow x0 (minus n0 (1))) (INR n0)) in H2; - Rewrite (tech_pow_Rmult x0 (minus n0 (1))) in H2; - Elim (classic (n0=O));Intro cond. -Rewrite cond in H2;Rewrite cond;Simpl in H2;Simpl; - Cut (Rplus R1 (Rmult (Rmult x0 R1) R0))==(Rmult R1 R1); - [Intro A; Rewrite A in H2; Assumption|Ring]. -Cut ~(n0=O)->(S (minus n0 (1)))=n0;[Intro|Omega]; - Rewrite (H3 cond) in H2; Rewrite (Rmult_sym (pow x0 n0) (INR n0)) in H2; - Rewrite (tech_pow_Rplus x0 n0 n0) in H2; Assumption. +Lemma Dx_pow_n : + forall (n:nat) (D:R -> Prop) (x0:R), + D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0. +simple induction n; intros. +simpl in |- *; rewrite Rmult_0_l; apply Dconst. +intros; cut (n0 = (S n0 - 1)%nat); + [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ]. +generalize + (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) ( + fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) ( + H D x0)); unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); + clear H0; intros; elim H0; clear H0; intros; split with x; + split; auto. +intros; generalize (H2 x1 H3); clear H2 H3; intro; + rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2; + rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2; + rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2; + rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2; + rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat)); + intro cond. +rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *; + cut (1 + x0 * 1 * 0 = 1 * 1); + [ intro A; rewrite A in H2; assumption | ring ]. +cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ]; + rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2; + rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption. Qed. (*********) -Lemma Dcomp:(Df,Dg:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R) - (D_in f df Df x0)->(D_in g dg Dg (f x0))-> - (D_in [x:R](g (f x)) [x:R](Rmult (df x) (dg (f x))) - (Dgf Df Dg f) x0). -Intros Df Dg df dg f g x0 H H0;Generalize H H0;Unfold D_in;Unfold Rdiv;Intros; -Generalize (limit_comp f [x:R](Rmult (Rminus (g x) (g (f x0))) - (Rinv (Rminus x (f x0)))) (D_x Df x0) - (D_x Dg (f x0)) - (f x0) (dg (f x0)) x0);Intro; - Generalize (cont_deriv f df Df x0 H);Intro;Unfold continue_in in H4; - Generalize (H3 H4 H2);Clear H3;Intro; - Generalize (limit_mul [x:R](Rmult (Rminus (g (f x)) (g (f x0))) - (Rinv (Rminus (f x) (f x0)))) - [x:R](Rmult (Rminus (f x) (f x0)) - (Rinv (Rminus x x0))) - (Dgf (D_x Df x0) (D_x Dg (f x0)) f) - (dg (f x0)) (df x0) x0 H3);Intro; - Cut (limit1_in - [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) - (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0). -Intro;Generalize (H5 H6);Clear H5;Intro; - Generalize (limit_mul - [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) - [x:R](dg (f x0)) - (D_x Df x0) (df x0) (dg (f x0)) x0 H1 - (limit_free [x:R](dg (f x0)) (D_x Df x0) x0 x0)); - 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. -Elim (Rmin_Rgt x x1 R0);Intros a b; - Apply (b (conj (Rgt x R0) (Rgt x1 R0) H9 H5));Clear a b. -Intros;Elim H11;Clear H11;Intros;Elim (Rmin_Rgt x x1 (R_dist x2 x0)); - Intros a b;Clear b;Unfold Rgt in a;Elim (a H12);Clear H5 a;Intros; - Unfold D_x Dgf in H11 H7 H10;Clear H12; - Elim (classic (f x2)==(f x0));Intro. -Elim H11;Clear H11;Intros;Elim H11;Clear H11;Intros; - Generalize (H10 x2 (conj (Df x2)/\~x0==x2 (Rlt (R_dist x2 x0) x) - (conj (Df x2) ~x0==x2 H11 H14) H5));Intro; - Rewrite (eq_Rminus (f x2) (f x0) H12) in H16; - Rewrite (Rmult_Ol (Rinv (Rminus x2 x0))) in H16; - Rewrite (Rmult_Ol (dg (f x0))) in H16; - Rewrite H12; - Rewrite (eq_Rminus (g (f x0)) (g (f x0)) (refl_eqT R (g (f x0)))); - Rewrite (Rmult_Ol (Rinv (Rminus x2 x0)));Assumption. -Clear H10 H5;Elim H11;Clear H11;Intros;Elim H5;Clear H5;Intros; -Cut (((Df x2)/\~x0==x2)/\(Dg (f x2))/\~(f x0)==(f x2)) - /\(Rlt (R_dist x2 x0) x1);Auto;Intro; - Generalize (H7 x2 H14);Intro; - Generalize (Rminus_eq_contra (f x2) (f x0) H12);Intro; - Rewrite (Rmult_assoc (Rminus (g (f x2)) (g (f x0))) - (Rinv (Rminus (f x2) (f x0))) - (Rmult (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0)))) in H15; - Rewrite <-(Rmult_assoc (Rinv (Rminus (f x2) (f x0))) - (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0))) in H15; - Rewrite (Rinv_l (Rminus (f x2) (f x0)) H16) in H15; - Rewrite (let (H1,H2)=(Rmult_ne (Rinv (Rminus x2 x0))) in H2) in H15; - Rewrite (Rmult_sym (df x0) (dg (f x0)));Assumption. -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;Intros;Elim H4;Clear H4;Intros; - Exact (H3 x1 (conj (Df x1)/\~x0==x1 (Rlt (R_dist x1 x0) x) H4 H5)). +Lemma Dcomp : + forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df Df x0 -> + D_in g dg Dg (f x0) -> + D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0. +intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *; + unfold Rdiv in |- *; intros; + generalize + (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) ( + D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); + intro; generalize (cont_deriv f df Df x0 H); intro; + unfold continue_in in H4; generalize (H3 H4 H2); clear H3; + intro; + generalize + (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0)) + (fun x:R => (f x - f x0) * / (x - x0)) + (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) ( + df x0) x0 H3); intro; + cut + (limit1_in (fun x:R => (f x - f x0) * / (x - x0)) + (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0). +intro; generalize (H5 H6); clear H5; intro; + generalize + (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( + fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1 + (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); + intro; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7; + simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); + clear H5 H7; intros; elim H5; elim H7; clear H5 H7; + intros; split with (Rmin x x1); split. +elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b. +intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0)); + intros a b; clear b; unfold Rgt in a; elim (a H12); + clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; + clear H12; elim (classic (f x2 = f x0)); intro. +elim H11; clear H11; intros; elim H11; clear H11; intros; + generalize (H10 x2 (conj (conj H11 H14) H5)); intro; + rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16; + rewrite (Rmult_0_l (/ (x2 - x0))) in H16; + rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12; + rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0)))); + rewrite (Rmult_0_l (/ (x2 - x0))); assumption. +clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros; + cut + (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ R_dist x2 x0 < x1); + auto; intro; generalize (H7 x2 H14); intro; + generalize (Rminus_eq_contra (f x2) (f x0) H12); intro; + rewrite + (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0)) + ((f x2 - f x0) * / (x2 - x0))) in H15; + rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0))) + in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15; + rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15; + rewrite (Rmult_comm (df x0) (dg (f x0))); assumption. +clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; + simpl in H1; intros; elim (H1 eps H2); clear H1; intros; + elim H1; clear H1; intros; split with x; split; auto; + intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; + intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)). Qed. (*********) -Lemma D_pow_n:(n:nat)(D:R->Prop)(x0:R)(expr,dexpr:R->R) - (D_in expr dexpr D x0)-> (D_in [x:R](pow (expr x) n) - [x:R](Rmult (Rmult (INR n) (pow (expr x) (minus n (1)))) (dexpr x)) - (Dgf D D expr) x0). -Intros n D x0 expr dexpr H; - Generalize (Dcomp D D dexpr [x:R](Rmult (INR n) (pow x (minus n (1)))) - expr [x:R](pow x n) x0 H (Dx_pow_n n D (expr x0))); - 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. -Cut ``((dexpr x0)*((INR n)*(pow (expr x0) (minus n (S O)))))== - ((INR n)*(pow (expr x0) (minus n (S O)))*(dexpr x0))``; - [Intro Rew;Rewrite <- Rew;Exact (H2 x1 H3)|Ring]. +Lemma D_pow_n : + forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R), + D_in expr dexpr D x0 -> + D_in (fun x:R => expr x ^ n) + (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) ( + Dgf D D expr) x0. +intros n D x0 expr dexpr H; + generalize + (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr ( + fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); + intro; unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0; + unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; + elim (H0 eps H1); clear H0; intros; elim H0; clear H0; + intros; split with x; split; intros; auto. +cut + (dexpr x0 * (INR n * expr x0 ^ (n - 1)) = + INR n * expr x0 ^ (n - 1) * dexpr x0); + [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ]. Qed. - diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v index db6df635c..6e10fa8f1 100644 --- a/theories/Reals/Reals.v +++ b/theories/Reals/Reals.v @@ -29,4 +29,4 @@ Require Export Rfunctions. Require Export SeqSeries. Require Export Rtrigo. Require Export Ranalysis. -Require Export Integration. +Require Export Integration.
\ No newline at end of file diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v index b283b9fd8..30b4a5396 100644 --- a/theories/Reals/Rfunctions.v +++ b/theories/Reals/Rfunctions.v @@ -16,16 +16,15 @@ (* *) (********************************************************) -Require Rbase. +Require Import Rbase. Require Export R_Ifp. Require Export Rbasic_fun. Require Export R_sqr. Require Export SplitAbsolu. Require Export SplitRmult. Require Export ArithProp. -Require Omega. -Require Zpower. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Omega. +Require Import Zpower. Open Local Scope nat_scope. Open Local Scope R_scope. @@ -33,522 +32,491 @@ Open Local Scope R_scope. (** Lemmas about factorial *) (*******************************) (*********) -Lemma INR_fact_neq_0:(n:nat)~(INR (fact n))==R0. +Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0. Proof. -Intro;Red;Intro;Apply (not_O_INR (fact n) (fact_neq_0 n));Assumption. +intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n)); + assumption. Qed. (*********) -Lemma fact_simpl : (n:nat) (fact (S n))=(mult (S n) (fact n)). +Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat. Proof. -Intro; Reflexivity. +intro; reflexivity. Qed. (*********) -Lemma simpl_fact:(n:nat)(Rmult (Rinv (INR (fact (S n)))) - (Rinv (Rinv (INR (fact n)))))== - (Rinv (INR (S n))). +Lemma simpl_fact : + forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n). Proof. -Intro;Rewrite (Rinv_Rinv (INR (fact n)) (INR_fact_neq_0 n)); - Unfold 1 fact;Cbv Beta Iota;Fold fact; - Rewrite (mult_INR (S n) (fact n)); - Rewrite (Rinv_Rmult (INR (S n)) (INR (fact n))). -Rewrite (Rmult_assoc (Rinv (INR (S n))) (Rinv (INR (fact n))) - (INR (fact n)));Rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n)); - Apply (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1). -Apply not_O_INR;Auto. -Apply INR_fact_neq_0. +intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n)); + unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *; + rewrite (mult_INR (S n) (fact n)); + rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))). +rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n))); + rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n)); + apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1). +apply not_O_INR; auto. +apply INR_fact_neq_0. Qed. (*******************************) (* Power *) (*******************************) (*********) -Fixpoint pow [r:R;n:nat]:R:= - Cases n of - O => R1 - |(S n) => (Rmult r (pow r n)) +Fixpoint pow (r:R) (n:nat) {struct n} : R := + match n with + | O => 1 + | S n => r * pow r n end. -Infix "^" pow (at level 2, left associativity) : R_scope V8only. +Infix "^" := pow : R_scope. -Lemma pow_O: (x : R) (pow x O) == R1. +Lemma pow_O : forall x:R, x ^ 0 = 1. Proof. -Reflexivity. +reflexivity. Qed. -Lemma pow_1: (x : R) (pow x (1)) == x. +Lemma pow_1 : forall x:R, x ^ 1 = x. Proof. -Simpl; Auto with real. +simpl in |- *; auto with real. Qed. -Lemma pow_add: - (x : R) (n, m : nat) (pow x (plus n m)) == (Rmult (pow x n) (pow x m)). +Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m. Proof. -Intros x n; Elim n; Simpl; Auto with real. -Intros n0 H' m; Rewrite H'; Auto with real. +intros x n; elim n; simpl in |- *; auto with real. +intros n0 H' m; rewrite H'; auto with real. Qed. -Lemma pow_nonzero: - (x:R) (n:nat) ~(x==R0) -> ~((pow x n)==R0). +Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0. Proof. -Intro; Induction n; Simpl. -Intro; Red;Intro;Apply R1_neq_R0;Assumption. -Intros;Red; Intro;Elim (without_div_Od x (pow x n0) H1). -Intro; Auto. -Apply H;Assumption. +intro; simple induction n; simpl in |- *. +intro; red in |- *; intro; apply R1_neq_R0; assumption. +intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1). +intro; auto. +apply H; assumption. Qed. -Hints Resolve pow_O pow_1 pow_add pow_nonzero:real. +Hint Resolve pow_O pow_1 pow_add pow_nonzero: real. -Lemma pow_RN_plus: - (x : R) - (n, m : nat) - ~ x == R0 -> (pow x n) == (Rmult (pow x (plus n m)) (Rinv (pow x m))). -Proof. -Intros x n; Elim n; Simpl; Auto with real. -Intros n0 H' m H'0. -Rewrite Rmult_assoc; Rewrite <- H'; Auto. -Qed. - -Lemma pow_lt: (x : R) (n : nat) (Rlt R0 x) -> (Rlt R0 (pow x n)). -Proof. -Intros x n; Elim n; Simpl; Auto with real. -Intros n0 H' H'0; Replace R0 with (Rmult x R0); Auto with real. -Qed. -Hints Resolve pow_lt :real. - -Lemma Rlt_pow_R1: - (x : R) (n : nat) (Rlt R1 x) -> (lt O n) -> (Rlt R1 (pow x n)). -Proof. -Intros x n; Elim n; Simpl; Auto with real. -Intros H' H'0; ElimType False; Omega. -Intros n0; Case n0. -Simpl; Rewrite Rmult_1r; Auto. -Intros n1 H' H'0 H'1. -Replace R1 with (Rmult R1 R1); Auto with real. -Apply Rlt_trans with r2 := (Rmult x R1); Auto with real. -Apply Rlt_monotony; Auto with real. -Apply Rlt_trans with r2 := R1; Auto with real. -Apply H'; Auto with arith. -Qed. -Hints Resolve Rlt_pow_R1 :real. - -Lemma Rlt_pow: - (x : R) (n, m : nat) (Rlt R1 x) -> (lt n m) -> (Rlt (pow x n) (pow x m)). -Proof. -Intros x n m H' H'0; Replace m with (plus (minus m n) n). -Rewrite pow_add. -Pattern 1 (pow x n); Replace (pow x n) with (Rmult R1 (pow x n)); - Auto with real. -Apply Rminus_lt. -Repeat Rewrite [y : R] (Rmult_sym y (pow x n)); Rewrite <- Rminus_distr. -Replace R0 with (Rmult (pow x n) R0); Auto with real. -Apply Rlt_monotony; Auto with real. -Apply pow_lt; Auto with real. -Apply Rlt_trans with r2 := R1; Auto with real. -Apply Rlt_minus; Auto with real. -Apply Rlt_pow_R1; Auto with arith. -Apply simpl_lt_plus_l with p := n; Auto with arith. -Rewrite le_plus_minus_r; Auto with arith; Rewrite <- plus_n_O; Auto. -Rewrite plus_sym; Auto with arith. -Qed. -Hints Resolve Rlt_pow :real. +Lemma pow_RN_plus : + forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros n0 H' m H'0. +rewrite Rmult_assoc; rewrite <- H'; auto. +Qed. + +Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros n0 H' H'0; replace 0 with (x * 0); auto with real. +Qed. +Hint Resolve pow_lt: real. + +Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n. +Proof. +intros x n; elim n; simpl in |- *; auto with real. +intros H' H'0; elimtype False; omega. +intros n0; case n0. +simpl in |- *; rewrite Rmult_1_r; auto. +intros n1 H' H'0 H'1. +replace 1 with (1 * 1); auto with real. +apply Rlt_trans with (r2 := x * 1); auto with real. +apply Rmult_lt_compat_l; auto with real. +apply Rlt_trans with (r2 := 1); auto with real. +apply H'; auto with arith. +Qed. +Hint Resolve Rlt_pow_R1: real. + +Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m. +Proof. +intros x n m H' H'0; replace m with (m - n + n)%nat. +rewrite pow_add. +pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n); + auto with real. +apply Rminus_lt. +repeat rewrite (fun y:R => Rmult_comm y (x ^ n)); + rewrite <- Rmult_minus_distr_l. +replace 0 with (x ^ n * 0); auto with real. +apply Rmult_lt_compat_l; auto with real. +apply pow_lt; auto with real. +apply Rlt_trans with (r2 := 1); auto with real. +apply Rlt_minus; auto with real. +apply Rlt_pow_R1; auto with arith. +apply plus_lt_reg_l with (p := n); auto with arith. +rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto. +rewrite plus_comm; auto with arith. +Qed. +Hint Resolve Rlt_pow: real. (*********) -Lemma tech_pow_Rmult:(x:R)(n:nat)(Rmult x (pow x n))==(pow x (S n)). +Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n. Proof. -Induction n; Simpl; Trivial. +simple induction n; simpl in |- *; trivial. Qed. (*********) -Lemma tech_pow_Rplus:(x:R)(a,n:nat) - (Rplus (pow x a) (Rmult (INR n) (pow x a)))== - (Rmult (INR (S n)) (pow x a)). -Proof. -Intros; Pattern 1 (pow x a); - Rewrite <-(let (H1,H2)=(Rmult_ne (pow x a)) in H1); - Rewrite (Rmult_sym (INR n) (pow x a)); - Rewrite <- (Rmult_Rplus_distr (pow x a) R1 (INR n)); - Rewrite (Rplus_sym R1 (INR n)); Rewrite <-(S_INR n); - Apply Rmult_sym. -Qed. - -Lemma poly: (n:nat)(x:R)(Rlt R0 x)-> - (Rle (Rplus R1 (Rmult (INR n) x)) (pow (Rplus R1 x) n)). -Proof. -Intros;Elim n. -Simpl;Cut (Rplus R1 (Rmult R0 x))==R1. -Intro;Rewrite H0;Unfold Rle;Right; Reflexivity. -Ring. -Intros;Unfold pow; Fold pow; - Apply (Rle_trans (Rplus R1 (Rmult (INR (S n0)) x)) - (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x))) - (Rmult (Rplus R1 x) (pow (Rplus R1 x) n0))). -Cut (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x)))== - (Rplus (Rplus R1 (Rmult (INR (S n0)) x)) - (Rmult (INR n0) (Rmult x x))). -Intro;Rewrite H1;Pattern 1 (Rplus R1 (Rmult (INR (S n0)) x)); - Rewrite <-(let (H1,H2)= - (Rplus_ne (Rplus R1 (Rmult (INR (S n0)) x))) in H1); - Apply Rle_compatibility;Elim n0;Intros. -Simpl;Rewrite Rmult_Ol;Unfold Rle;Right;Auto. -Unfold Rle;Left;Generalize Rmult_gt;Unfold Rgt;Intro; - Fold (Rsqr x);Apply (H3 (INR (S n1)) (Rsqr x) - (lt_INR_0 (S n1) (lt_O_Sn n1)));Fold (Rgt x R0) in H; - Apply (pos_Rsqr1 x (imp_not_Req x R0 - (or_intror (Rlt x R0) (Rgt x R0) H))). -Rewrite (S_INR n0);Ring. -Unfold Rle in H0;Elim H0;Intro. -Unfold Rle;Left;Apply Rlt_monotony. -Rewrite Rplus_sym; - Apply (Rlt_r_plus_R1 x (Rlt_le R0 x H)). -Assumption. -Rewrite H1;Unfold Rle;Right;Trivial. -Qed. - -Lemma Power_monotonic: - (x:R) (m,n:nat) (Rgt (Rabsolu x) R1) - -> (le m n) - -> (Rle (Rabsolu (pow x m)) (Rabsolu (pow x n))). -Proof. -Intros x m n H;Induction n;Intros;Inversion H0. -Unfold Rle; Right; Reflexivity. -Unfold Rle; Right; Reflexivity. -Apply (Rle_trans (Rabsolu (pow x m)) - (Rabsolu (pow x n)) - (Rabsolu (pow x (S n)))). -Apply Hrecn; Assumption. -Simpl;Rewrite Rabsolu_mult. -Pattern 1 (Rabsolu (pow x n)). -Rewrite <-Rmult_1r. -Rewrite (Rmult_sym (Rabsolu x) (Rabsolu (pow x n))). -Apply Rle_monotony. -Apply Rabsolu_pos. -Unfold Rgt in H. -Apply Rlt_le; Assumption. -Qed. - -Lemma Pow_Rabsolu: (x:R) (n:nat) - (pow (Rabsolu x) n)==(Rabsolu (pow x n)). -Proof. -Intro;Induction n;Simpl. -Apply sym_eqT;Apply Rabsolu_pos_eq;Apply Rlt_le;Apply Rlt_R0_R1. -Intros; Rewrite H;Apply sym_eqT;Apply Rabsolu_mult. -Qed. - - -Lemma Pow_x_infinity: - (x:R) (Rgt (Rabsolu x) R1) - -> (b:R) (Ex [N:nat] ((n:nat) (ge n N) - -> (Rge (Rabsolu (pow x n)) b ))). -Proof. -Intros;Elim (archimed (Rmult b (Rinv (Rminus (Rabsolu x) R1))));Intros; - Clear H1; - Cut (Ex[N:nat] (Rge (INR N) (Rmult b (Rinv (Rminus (Rabsolu x) R1))))). -Intro; Elim H1;Clear H1;Intros;Exists x0;Intros; - Apply (Rge_trans (Rabsolu (pow x n)) (Rabsolu (pow x x0)) b). -Apply Rle_sym1;Apply Power_monotonic;Assumption. -Rewrite <- Pow_Rabsolu;Cut (Rabsolu x)==(Rplus R1 (Rminus (Rabsolu x) R1)). -Intro; Rewrite H3; - Apply (Rge_trans (pow (Rplus R1 (Rminus (Rabsolu x) R1)) x0) - (Rplus R1 (Rmult (INR x0) - (Rminus (Rabsolu x) R1))) - b). -Apply Rle_sym1;Apply poly;Fold (Rgt (Rminus (Rabsolu x) R1) R0); - Apply Rgt_minus;Assumption. -Apply (Rge_trans - (Rplus R1 (Rmult (INR x0) (Rminus (Rabsolu x) R1))) - (Rmult (INR x0) (Rminus (Rabsolu x) R1)) - b). -Apply Rle_sym1; Apply Rlt_le;Rewrite (Rplus_sym R1 - (Rmult (INR x0) (Rminus (Rabsolu x) R1))); - Pattern 1 (Rmult (INR x0) (Rminus (Rabsolu x) R1)); - Rewrite <- (let (H1,H2) = (Rplus_ne - (Rmult (INR x0) (Rminus (Rabsolu x) R1))) in - H1); - Apply Rlt_compatibility; - Apply Rlt_R0_R1. -Cut b==(Rmult (Rmult b (Rinv (Rminus (Rabsolu x) R1))) - (Rminus (Rabsolu x) R1)). -Intros; Rewrite H4;Apply Rge_monotony. -Apply Rge_minus;Unfold Rge; Left; Assumption. -Assumption. -Rewrite Rmult_assoc;Rewrite Rinv_l. -Ring. -Apply imp_not_Req; Right;Apply Rgt_minus;Assumption. -Ring. -Cut `0<= (up (Rmult b (Rinv (Rminus (Rabsolu x) R1))))`\/ - `(up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) <= 0`. -Intros;Elim H1;Intro. -Elim (IZN (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) H2);Intros;Exists x0; - Apply (Rge_trans - (INR x0) - (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1))))) - (Rmult b (Rinv (Rminus (Rabsolu x) R1)))). -Rewrite INR_IZR_INZ;Apply IZR_ge;Omega. -Unfold Rge; Left; Assumption. -Exists O;Apply (Rge_trans (INR (0)) - (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1))))) - (Rmult b (Rinv (Rminus (Rabsolu x) R1)))). -Rewrite INR_IZR_INZ;Apply IZR_ge;Simpl;Omega. -Unfold Rge; Left; Assumption. -Omega. -Qed. - -Lemma pow_ne_zero: - (n:nat) ~(n=(0))-> (pow R0 n) == R0. -Proof. -Induction n. -Simpl;Auto. -Intros;Elim H;Reflexivity. -Intros; Simpl;Apply Rmult_Ol. -Qed. - -Lemma Rinv_pow: - (x:R) (n:nat) ~(x==R0) -> (Rinv (pow x n))==(pow (Rinv x) n). -Proof. -Intros; Elim n; Simpl. -Apply Rinv_R1. -Intro m;Intro;Rewrite Rinv_Rmult. -Rewrite H0; Reflexivity;Assumption. -Assumption. -Apply pow_nonzero;Assumption. -Qed. - -Lemma pow_lt_1_zero: - (x:R) (Rlt (Rabsolu x) R1) - -> (y:R) (Rlt R0 y) - -> (Ex[N:nat] (n:nat) (ge n N) - -> (Rlt (Rabsolu (pow x n)) y)). -Proof. -Intros;Elim (Req_EM x R0);Intro. -Exists (1);Rewrite H1;Intros n GE;Rewrite pow_ne_zero. -Rewrite Rabsolu_R0;Assumption. -Inversion GE;Auto. -Cut (Rgt (Rabsolu (Rinv x)) R1). -Intros;Elim (Pow_x_infinity (Rinv x) H2 (Rplus (Rinv y) R1));Intros N. -Exists N;Intros;Rewrite <- (Rinv_Rinv y). -Rewrite <- (Rinv_Rinv (Rabsolu (pow x n))). -Apply Rinv_lt. -Apply Rmult_lt_pos. -Apply Rlt_Rinv. -Assumption. -Apply Rlt_Rinv. -Apply Rabsolu_pos_lt. -Apply pow_nonzero. -Assumption. -Rewrite <- Rabsolu_Rinv. -Rewrite Rinv_pow. -Apply (Rlt_le_trans (Rinv y) - (Rplus (Rinv y) R1) - (Rabsolu (pow (Rinv x) n))). -Pattern 1 (Rinv y). -Rewrite <- (let (H1,H2) = - (Rplus_ne (Rinv y)) in H1). -Apply Rlt_compatibility. -Apply Rlt_R0_R1. -Apply Rle_sym2. -Apply H3. -Assumption. -Assumption. -Apply pow_nonzero. -Assumption. -Apply Rabsolu_no_R0. -Apply pow_nonzero. -Assumption. -Apply imp_not_Req. -Right; Unfold Rgt; Assumption. -Rewrite <- (Rinv_Rinv R1). -Rewrite Rabsolu_Rinv. -Unfold Rgt; Apply Rinv_lt. -Apply Rmult_lt_pos. -Apply Rabsolu_pos_lt. -Assumption. -Rewrite Rinv_R1; Apply Rlt_R0_R1. -Rewrite Rinv_R1; Assumption. -Assumption. -Red;Intro; Apply R1_neq_R0;Assumption. -Qed. - -Lemma pow_R1: - (r : R) (n : nat) (pow r n) == R1 -> (Rabsolu r) == R1 \/ n = O. -Proof. -Intros r n H'. -Case (Req_EM (Rabsolu r) R1); Auto; Intros H'1. -Case (not_Req ? ? H'1); Intros H'2. -Generalize H'; Case n; Auto. -Intros n0 H'0. -Cut ~ r == R0; [Intros Eq1 | Idtac]. -Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto. -Absurd (Rlt (pow (Rabsolu (Rinv r)) O) (pow (Rabsolu (Rinv r)) (S n0))); Auto. -Replace (pow (Rabsolu (Rinv r)) (S n0)) with R1. -Simpl; Apply Rlt_antirefl; Auto. -Rewrite Rabsolu_Rinv; Auto. -Rewrite <- Rinv_pow; Auto. -Rewrite Pow_Rabsolu; Auto. -Rewrite H'0; Rewrite Rabsolu_right; Auto with real. -Apply Rle_ge; Auto with real. -Apply Rlt_pow; Auto with arith. -Rewrite Rabsolu_Rinv; Auto. -Apply Rlt_monotony_contra with z := (Rabsolu r). -Case (Rabsolu_pos r); Auto. -Intros H'3; Case Eq2; Auto. -Rewrite Rmult_1r; Rewrite Rinv_r; Auto with real. -Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto. -Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real. -Generalize H'; Case n; Auto. -Intros n0 H'0. -Cut ~ r == R0; [Intros Eq1 | Auto with real]. -Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto. -Absurd (Rlt (pow (Rabsolu r) O) (pow (Rabsolu r) (S n0))); - Auto with real arith. -Repeat Rewrite Pow_Rabsolu; Rewrite H'0; Simpl; Auto with real. -Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto. -Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real. -Qed. - -Lemma pow_Rsqr : (x:R;n:nat) (pow x (mult (2) n))==(pow (Rsqr x) n). -Proof. -Intros; Induction n. -Reflexivity. -Replace (mult (2) (S n)) with (S (S (mult (2) n))). -Replace (pow x (S (S (mult (2) n)))) with ``x*x*(pow x (mult (S (S O)) n))``. -Rewrite Hrecn; Reflexivity. -Simpl; Ring. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Qed. - -Lemma pow_le : (a:R;n:nat) ``0<=a`` -> ``0<=(pow a n)``. -Proof. -Intros; Induction n. -Simpl; Left; Apply Rlt_R0_R1. -Simpl; Apply Rmult_le_pos; Assumption. +Lemma tech_pow_Rplus : + forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a. +Proof. +intros; pattern (x ^ a) at 1 in |- *; + rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1); + rewrite (Rmult_comm (INR n) (x ^ a)); + rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n)); + rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); + apply Rmult_comm. +Qed. + +Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n. +Proof. +intros; elim n. +simpl in |- *; cut (1 + 0 * x = 1). +intro; rewrite H0; unfold Rle in |- *; right; reflexivity. +ring. +intros; unfold pow in |- *; fold pow in |- *; + apply + (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x)) + ((1 + x) * (1 + x) ^ n0)). +cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)). +intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *; + rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1); + apply Rplus_le_compat_l; elim n0; intros. +simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto. +unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *; + intro; fold (Rsqr x) in |- *; + apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1))); + fold (x > 0) in H; + apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))). +rewrite (S_INR n0); ring. +unfold Rle in H0; elim H0; intro. +unfold Rle in |- *; left; apply Rmult_lt_compat_l. +rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)). +assumption. +rewrite H1; unfold Rle in |- *; right; trivial. +Qed. + +Lemma Power_monotonic : + forall (x:R) (m n:nat), + Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n). +Proof. +intros x m n H; induction n as [| n Hrecn]; intros; inversion H0. +unfold Rle in |- *; right; reflexivity. +unfold Rle in |- *; right; reflexivity. +apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))). +apply Hrecn; assumption. +simpl in |- *; rewrite Rabs_mult. +pattern (Rabs (x ^ n)) at 1 in |- *. +rewrite <- Rmult_1_r. +rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))). +apply Rmult_le_compat_l. +apply Rabs_pos. +unfold Rgt in H. +apply Rlt_le; assumption. +Qed. + +Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n). +Proof. +intro; simple induction n; simpl in |- *. +apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. +intros; rewrite H; apply sym_eq; apply Rabs_mult. +Qed. + + +Lemma Pow_x_infinity : + forall x:R, + Rabs x > 1 -> + forall b:R, + exists N : nat | (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b). +Proof. +intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1; + cut ( exists N : nat | INR N >= b * / (Rabs x - 1)). +intro; elim H1; clear H1; intros; exists x0; intros; + apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b). +apply Rle_ge; apply Power_monotonic; assumption. +rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)). +intro; rewrite H3; + apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b). +apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus; + assumption. +apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b). +apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1))); + pattern (INR x0 * (Rabs x - 1)) at 1 in |- *; + rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1); + apply Rplus_lt_compat_l; apply Rlt_0_1. +cut (b = b * / (Rabs x - 1) * (Rabs x - 1)). +intros; rewrite H4; apply Rmult_ge_compat_r. +apply Rge_minus; unfold Rge in |- *; left; assumption. +assumption. +rewrite Rmult_assoc; rewrite Rinv_l. +ring. +apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption. +ring. +cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z). +intros; elim H1; intro. +elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0; + apply + (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). +rewrite INR_IZR_INZ; apply IZR_ge; omega. +unfold Rge in |- *; left; assumption. +exists 0%nat; + apply + (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). +rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega. +unfold Rge in |- *; left; assumption. +omega. +Qed. + +Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0. +Proof. +simple induction n. +simpl in |- *; auto. +intros; elim H; reflexivity. +intros; simpl in |- *; apply Rmult_0_l. +Qed. + +Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n. +Proof. +intros; elim n; simpl in |- *. +apply Rinv_1. +intro m; intro; rewrite Rinv_mult_distr. +rewrite H0; reflexivity; assumption. +assumption. +apply pow_nonzero; assumption. +Qed. + +Lemma pow_lt_1_zero : + forall x:R, + Rabs x < 1 -> + forall y:R, + 0 < y -> + exists N : nat | (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y). +Proof. +intros; elim (Req_dec x 0); intro. +exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero. +rewrite Rabs_R0; assumption. +inversion GE; auto. +cut (Rabs (/ x) > 1). +intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N. +exists N; intros; rewrite <- (Rinv_involutive y). +rewrite <- (Rinv_involutive (Rabs (x ^ n))). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat. +assumption. +apply Rinv_0_lt_compat. +apply Rabs_pos_lt. +apply pow_nonzero. +assumption. +rewrite <- Rabs_Rinv. +rewrite Rinv_pow. +apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))). +pattern (/ y) at 1 in |- *. +rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1). +apply Rplus_lt_compat_l. +apply Rlt_0_1. +apply Rge_le. +apply H3. +assumption. +assumption. +apply pow_nonzero. +assumption. +apply Rabs_no_R0. +apply pow_nonzero. +assumption. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *; assumption. +rewrite <- (Rinv_involutive 1). +rewrite Rabs_Rinv. +unfold Rgt in |- *; apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply Rabs_pos_lt. +assumption. +rewrite Rinv_1; apply Rlt_0_1. +rewrite Rinv_1; assumption. +assumption. +red in |- *; intro; apply R1_neq_R0; assumption. +Qed. + +Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat. +Proof. +intros r n H'. +case (Req_dec (Rabs r) 1); auto; intros H'1. +case (Rdichotomy _ _ H'1); intros H'2. +generalize H'; case n; auto. +intros n0 H'0. +cut (r <> 0); [ intros Eq1 | idtac ]. +cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. +absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto. +replace (Rabs (/ r) ^ S n0) with 1. +simpl in |- *; apply Rlt_irrefl; auto. +rewrite Rabs_Rinv; auto. +rewrite <- Rinv_pow; auto. +rewrite RPow_abs; auto. +rewrite H'0; rewrite Rabs_right; auto with real. +apply Rle_ge; auto with real. +apply Rlt_pow; auto with arith. +rewrite Rabs_Rinv; auto. +apply Rmult_lt_reg_l with (r := Rabs r). +case (Rabs_pos r); auto. +intros H'3; case Eq2; auto. +rewrite Rmult_1_r; rewrite Rinv_r; auto with real. +red in |- *; intro; absurd (r ^ S n0 = 1); auto. +simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. +generalize H'; case n; auto. +intros n0 H'0. +cut (r <> 0); [ intros Eq1 | auto with real ]. +cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. +absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith. +repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real. +red in |- *; intro; absurd (r ^ S n0 = 1); auto. +simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. +Qed. + +Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n. +Proof. +intros; induction n as [| n Hrecn]. +reflexivity. +replace (2 * S n)%nat with (S (S (2 * n))). +replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)). +rewrite Hrecn; reflexivity. +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +Qed. + +Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n. +Proof. +intros; induction n as [| n Hrecn]. +simpl in |- *; left; apply Rlt_0_1. +simpl in |- *; apply Rmult_le_pos; assumption. Qed. (**********) -Lemma pow_1_even : (n:nat) ``(pow (-1) (mult (S (S O)) n))==1``. +Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1. Proof. -Intro; Induction n. -Reflexivity. -Replace (mult (2) (S n)) with (plus (2) (mult (2) n)). -Rewrite pow_add; Rewrite Hrecn; Simpl; Ring. -Replace (S n) with (plus n (1)); [Ring | Ring]. +intro; induction n as [| n Hrecn]. +reflexivity. +replace (2 * S n)%nat with (2 + 2 * n)%nat. +rewrite pow_add; rewrite Hrecn; simpl in |- *; ring. +replace (S n) with (n + 1)%nat; [ ring | ring ]. Qed. (**********) -Lemma pow_1_odd : (n:nat) ``(pow (-1) (S (mult (S (S O)) n)))==-1``. +Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1. Proof. -Intro; Replace (S (mult (2) n)) with (plus (mult (2) n) (1)); [Idtac | Ring]. -Rewrite pow_add; Rewrite pow_1_even; Simpl; Ring. +intro; replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring. Qed. (**********) -Lemma pow_1_abs : (n:nat) ``(Rabsolu (pow (-1) n))==1``. -Proof. -Intro; Induction n. -Simpl; Apply Rabsolu_R1. -Replace (S n) with (plus n (1)); [Rewrite pow_add | Ring]. -Rewrite Rabsolu_mult. -Rewrite Hrecn; Rewrite Rmult_1l; Simpl; Rewrite Rmult_1r; Rewrite Rabsolu_Ropp; Apply Rabsolu_R1. -Qed. - -Lemma pow_mult : (x:R;n1,n2:nat) (pow x (mult n1 n2))==(pow (pow x n1) n2). -Proof. -Intros; Induction n2. -Simpl; Replace (mult n1 O) with O; [Reflexivity | Ring]. -Replace (mult n1 (S n2)) with (plus (mult n1 n2) n1). -Replace (S n2) with (plus n2 (1)); [Idtac | Ring]. -Do 2 Rewrite pow_add. -Rewrite Hrecn2. -Simpl. -Ring. -Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite mult_INR; Rewrite S_INR; Ring. -Qed. - -Lemma pow_incr : (x,y:R;n:nat) ``0<=x<=y`` -> ``(pow x n)<=(pow y n)``. -Proof. -Intros. -Induction n. -Right; Reflexivity. -Simpl. -Elim H; Intros. -Apply Rle_trans with ``y*(pow x n)``. -Do 2 Rewrite <- (Rmult_sym (pow x n)). -Apply Rle_monotony. -Apply pow_le; Assumption. -Assumption. -Apply Rle_monotony. -Apply Rle_trans with x; Assumption. -Apply Hrecn. -Qed. - -Lemma pow_R1_Rle : (x:R;k:nat) ``1<=x`` -> ``1<=(pow x k)``. -Proof. -Intros. -Induction k. -Right; Reflexivity. -Simpl. -Apply Rle_trans with ``x*1``. -Rewrite Rmult_1r; Assumption. -Apply Rle_monotony. -Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption]. -Exact Hreck. -Qed. - -Lemma Rle_pow : (x:R;m,n:nat) ``1<=x`` -> (le m n) -> ``(pow x m)<=(pow x n)``. -Proof. -Intros. -Replace n with (plus (minus n m) m). -Rewrite pow_add. -Rewrite Rmult_sym. -Pattern 1 (pow x m); Rewrite <- Rmult_1r. -Apply Rle_monotony. -Apply pow_le; Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption]. -Apply pow_R1_Rle; Assumption. -Rewrite plus_sym. -Symmetry; Apply le_plus_minus; Assumption. -Qed. - -Lemma pow1 : (n:nat) (pow R1 n)==R1. -Proof. -Intro; Induction n. -Reflexivity. -Simpl; Rewrite Hrecn; Rewrite Rmult_1r; Reflexivity. -Qed. - -Lemma pow_Rabs : (x:R;n:nat) ``(pow x n)<=(pow (Rabsolu x) n)``. -Proof. -Intros; Induction n. -Right; Reflexivity. -Simpl; Case (case_Rabsolu x); Intro. -Apply Rle_trans with (Rabsolu ``x*(pow x n)``). -Apply Rle_Rabsolu. -Rewrite Rabsolu_mult. -Apply Rle_monotony. -Apply Rabsolu_pos. -Right; Symmetry; Apply Pow_Rabsolu. -Pattern 1 (Rabsolu x); Rewrite (Rabsolu_right x r); Apply Rle_monotony. -Apply Rle_sym2; Exact r. -Apply Hrecn. -Qed. - -Lemma pow_maj_Rabs : (x,y:R;n:nat) ``(Rabsolu y)<=x`` -> ``(pow y n)<=(pow x n)``. -Proof. -Intros; Cut ``0<=x``. -Intro; Apply Rle_trans with (pow (Rabsolu y) n). -Apply pow_Rabs. -Induction n. -Right; Reflexivity. -Simpl; Apply Rle_trans with ``x*(pow (Rabsolu y) n)``. -Do 2 Rewrite <- (Rmult_sym (pow (Rabsolu y) n)). -Apply Rle_monotony. -Apply pow_le; Apply Rabsolu_pos. -Assumption. -Apply Rle_monotony. -Apply H0. -Apply Hrecn. -Apply Rle_trans with (Rabsolu y); [Apply Rabsolu_pos | Exact H]. +Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1. +Proof. +intro; induction n as [| n Hrecn]. +simpl in |- *; apply Rabs_R1. +replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ]. +rewrite Rabs_mult. +rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r; + rewrite Rabs_Ropp; apply Rabs_R1. +Qed. + +Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = x ^ n1 ^ n2. +Proof. +intros; induction n2 as [| n2 Hrecn2]. +simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ]. +replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat. +replace (S n2) with (n2 + 1)%nat; [ idtac | ring ]. +do 2 rewrite pow_add. +rewrite Hrecn2. +simpl in |- *. +ring. +apply INR_eq; rewrite plus_INR; do 2 rewrite mult_INR; rewrite S_INR; ring. +Qed. + +Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n. +Proof. +intros. +induction n as [| n Hrecn]. +right; reflexivity. +simpl in |- *. +elim H; intros. +apply Rle_trans with (y * x ^ n). +do 2 rewrite <- (Rmult_comm (x ^ n)). +apply Rmult_le_compat_l. +apply pow_le; assumption. +assumption. +apply Rmult_le_compat_l. +apply Rle_trans with x; assumption. +apply Hrecn. +Qed. + +Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k. +Proof. +intros. +induction k as [| k Hreck]. +right; reflexivity. +simpl in |- *. +apply Rle_trans with (x * 1). +rewrite Rmult_1_r; assumption. +apply Rmult_le_compat_l. +left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. +exact Hreck. +Qed. + +Lemma Rle_pow : + forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n. +Proof. +intros. +replace n with (n - m + m)%nat. +rewrite pow_add. +rewrite Rmult_comm. +pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r. +apply Rmult_le_compat_l. +apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. +apply pow_R1_Rle; assumption. +rewrite plus_comm. +symmetry in |- *; apply le_plus_minus; assumption. +Qed. + +Lemma pow1 : forall n:nat, 1 ^ n = 1. +Proof. +intro; induction n as [| n Hrecn]. +reflexivity. +simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity. +Qed. + +Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n. +Proof. +intros; induction n as [| n Hrecn]. +right; reflexivity. +simpl in |- *; case (Rcase_abs x); intro. +apply Rle_trans with (Rabs (x * x ^ n)). +apply RRle_abs. +rewrite Rabs_mult. +apply Rmult_le_compat_l. +apply Rabs_pos. +right; symmetry in |- *; apply RPow_abs. +pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r); + apply Rmult_le_compat_l. +apply Rge_le; exact r. +apply Hrecn. +Qed. + +Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n. +Proof. +intros; cut (0 <= x). +intro; apply Rle_trans with (Rabs y ^ n). +apply pow_Rabs. +induction n as [| n Hrecn]. +right; reflexivity. +simpl in |- *; apply Rle_trans with (x * Rabs y ^ n). +do 2 rewrite <- (Rmult_comm (Rabs y ^ n)). +apply Rmult_le_compat_l. +apply pow_le; apply Rabs_pos. +assumption. +apply Rmult_le_compat_l. +apply H0. +apply Hrecn. +apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ]. Qed. (*******************************) @@ -556,207 +524,200 @@ Qed. (*******************************) (*i Due to L.Thery i*) -Tactic Definition CaseEqk name := -Generalize (refl_equal ? name); Pattern -1 name; Case name. +Ltac case_eq name := + generalize (refl_equal name); pattern name at -1 in |- *; case name. -Definition powerRZ := - [x : R] [n : Z] Cases n of - ZERO => R1 - | (POS p) => (pow x (convert p)) - | (NEG p) => (Rinv (pow x (convert p))) - end. +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 + end. -Infix Local "^Z" powerRZ (at level 2, left associativity) : R_scope. +Infix Local "^Z" := powerRZ (at level 30, left associativity) : R_scope. -Lemma Zpower_NR0: - (x : Z) (n : nat) (Zle ZERO x) -> (Zle ZERO (Zpower_nat x n)). +Lemma Zpower_NR0 : + forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z. Proof. -NewInduction n; Unfold Zpower_nat; Simpl; Auto with zarith. +induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. Qed. -Lemma powerRZ_O: (x : R) (powerRZ x ZERO) == R1. +Lemma powerRZ_O : forall x:R, x ^Z 0 = 1. Proof. -Reflexivity. +reflexivity. Qed. -Lemma powerRZ_1: (x : R) (powerRZ x (Zs ZERO)) == x. +Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x. Proof. -Simpl; Auto with real. +simpl in |- *; auto with real. Qed. -Lemma powerRZ_NOR: (x : R) (z : Z) ~ x == R0 -> ~ (powerRZ x z) == R0. +Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0. Proof. -NewDestruct z; Simpl; Auto with real. +destruct z; simpl in |- *; auto with real. Qed. -Lemma powerRZ_add: - (x : R) - (n, m : Z) - ~ x == R0 -> (powerRZ x (Zplus n m)) == (Rmult (powerRZ x n) (powerRZ x m)). +Lemma powerRZ_add : + forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m. Proof. -Intro x; NewDestruct n as [|n1|n1]; NewDestruct m as [|m1|m1]; Simpl; - Auto with real. +intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *; + auto with real. (* POS/POS *) -Rewrite convert_add; Auto with real. +rewrite nat_of_P_plus_morphism; auto with real. (* POS/NEG *) -(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real. -Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real. -Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real. -Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1)); - Auto with real. -Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real. -Rewrite Rinv_Rmult; Auto with real. -Rewrite Rinv_Rinv; Auto with real. -Apply lt_le_weak. -Apply compare_convert_INFERIEUR; Auto. -Apply ZC2; Auto. -Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real. -Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1)); - Auto with real. -Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real. -Apply lt_le_weak. -Change (gt (convert n1) (convert m1)). -Apply compare_convert_SUPERIEUR; Auto. +case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real. +intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. +intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. +rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); + auto with real. +rewrite plus_comm; rewrite le_plus_minus_r; auto with real. +rewrite Rinv_mult_distr; auto with real. +rewrite Rinv_involutive; auto with real. +apply lt_le_weak. +apply nat_of_P_lt_Lt_compare_morphism; auto. +apply ZC2; auto. +intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. +rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); + auto with real. +rewrite plus_comm; rewrite le_plus_minus_r; auto with real. +apply lt_le_weak. +change (nat_of_P n1 > nat_of_P m1)%nat in |- *. +apply nat_of_P_gt_Gt_compare_morphism; auto. (* NEG/POS *) -(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real. -Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real. -Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real. -Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1)); - Auto with real. -Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real. -Apply lt_le_weak. -Apply compare_convert_INFERIEUR; Auto. -Apply ZC2; Auto. -Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real. -Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1)); - Auto with real. -Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real. -Rewrite Rinv_Rmult; Auto with real. -Apply lt_le_weak. -Change (gt (convert n1) (convert m1)). -Apply compare_convert_SUPERIEUR; Auto. +case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real. +intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. +intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. +rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); + auto with real. +rewrite plus_comm; rewrite le_plus_minus_r; auto with real. +apply lt_le_weak. +apply nat_of_P_lt_Lt_compare_morphism; auto. +apply ZC2; auto. +intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. +rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); + auto with real. +rewrite plus_comm; rewrite le_plus_minus_r; auto with real. +rewrite Rinv_mult_distr; auto with real. +apply lt_le_weak. +change (nat_of_P n1 > nat_of_P m1)%nat in |- *. +apply nat_of_P_gt_Gt_compare_morphism; auto. (* NEG/NEG *) -Rewrite convert_add; Auto with real. -Intros H'; Rewrite pow_add; Auto with real. -Apply Rinv_Rmult; Auto. -Apply pow_nonzero; Auto. -Apply pow_nonzero; Auto. +rewrite nat_of_P_plus_morphism; auto with real. +intros H'; rewrite pow_add; auto with real. +apply Rinv_mult_distr; auto. +apply pow_nonzero; auto. +apply pow_nonzero; auto. Qed. -Hints Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add :real. +Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real. -Lemma Zpower_nat_powerRZ: - (n, m : nat) - (IZR (Zpower_nat (inject_nat n) m)) == (powerRZ (INR n) (inject_nat m)). -Proof. -Intros n m; Elim m; Simpl; Auto with real. -Intros m1 H'; Rewrite bij1; Simpl. -Replace (Zpower_nat (inject_nat n) (S m1)) - with (Zmult (inject_nat n) (Zpower_nat (inject_nat n) m1)). -Rewrite mult_IZR; Auto with real. -Repeat Rewrite <- INR_IZR_INZ; Simpl. -Rewrite H'; Simpl. -Case m1; Simpl; Auto with real. -Intros m2; Rewrite bij1; Auto. -Unfold Zpower_nat; Auto. +Lemma Zpower_nat_powerRZ : + forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m. +Proof. +intros n m; elim m; simpl in |- *; auto with real. +intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *. +replace (Zpower_nat (Z_of_nat n) (S m1)) with + (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z. +rewrite mult_IZR; auto with real. +repeat rewrite <- INR_IZR_INZ; simpl in |- *. +rewrite H'; simpl in |- *. +case m1; simpl in |- *; auto with real. +intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto. +unfold Zpower_nat in |- *; auto. Qed. -Lemma powerRZ_lt: (x : R) (z : Z) (Rlt R0 x) -> (Rlt R0 (powerRZ x z)). +Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z. Proof. -Intros x z; Case z; Simpl; Auto with real. +intros x z; case z; simpl in |- *; auto with real. Qed. -Hints Resolve powerRZ_lt :real. +Hint Resolve powerRZ_lt: real. -Lemma powerRZ_le: (x : R) (z : Z) (Rlt R0 x) -> (Rle R0 (powerRZ x z)). +Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z. Proof. -Intros x z H'; Apply Rlt_le; Auto with real. +intros x z H'; apply Rlt_le; auto with real. Qed. -Hints Resolve powerRZ_le :real. +Hint Resolve powerRZ_le: real. -Lemma Zpower_nat_powerRZ_absolu: - (n, m : Z) - (Zle ZERO m) -> (IZR (Zpower_nat n (absolu m))) == (powerRZ (IZR n) m). +Lemma Zpower_nat_powerRZ_absolu : + forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m. Proof. -Intros n m; Case m; Simpl; Auto with zarith. -Intros p H'; Elim (convert 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 <= (NEG p)`;Auto with zarith. +intros n m; case m; simpl in |- *; auto with zarith. +intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith. +intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith. +rewrite <- mult_IZR; auto. +intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith. Qed. -Lemma powerRZ_R1: (n : Z) (powerRZ R1 n) == R1. +Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1. Proof. -Intros n; Case n; Simpl; Auto. -Intros p; Elim (convert p); Simpl; Auto; Intros n0 H'; Rewrite H'; Ring. -Intros p; Elim (convert p); Simpl. -Exact Rinv_R1. -Intros n1 H'; Rewrite Rinv_Rmult; Try Rewrite Rinv_R1; Try Rewrite H'; - Auto with real. +intros n; case n; simpl in |- *; auto. +intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H'; + ring. +intros p; elim (nat_of_P p); simpl in |- *. +exact Rinv_1. +intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H'; + auto with real. Qed. (*******************************) (** Sum of n first naturals *) (*******************************) (*********) -Fixpoint sum_nat_f_O [f:nat->nat;n:nat]:nat:= - Cases n of - O => (f O) - |(S n') => (plus (sum_nat_f_O f n') (f (S n'))) +Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat := + match n with + | O => f 0%nat + | S n' => (sum_nat_f_O f n' + f (S n'))%nat end. (*********) -Definition sum_nat_f [s,n:nat;f:nat->nat]:nat:= - (sum_nat_f_O [x:nat](f (plus x s)) (minus n s)). +Definition sum_nat_f (s n:nat) (f:nat -> nat) : nat := + sum_nat_f_O (fun x:nat => f (x + s)%nat) (n - s). (*********) -Definition sum_nat_O [n:nat]:nat:= - (sum_nat_f_O [x:nat]x n). +Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n. (*********) -Definition sum_nat [s,n:nat]:nat:= - (sum_nat_f s n [x:nat]x). +Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x). (*******************************) (** Sum *) (*******************************) (*********) -Fixpoint sum_f_R0 [f:nat->R;N:nat]:R:= - Cases N of - O => (f O) - |(S i) => (Rplus (sum_f_R0 f i) (f (S i))) +Fixpoint sum_f_R0 (f:nat -> R) (N:nat) {struct N} : R := + match N with + | O => f 0%nat + | S i => sum_f_R0 f i + f (S i) end. (*********) -Definition sum_f [s,n:nat;f:nat->R]:R:= - (sum_f_R0 [x:nat](f (plus x s)) (minus n s)). - -Lemma GP_finite: - (x:R) (n:nat) (Rmult (sum_f_R0 [n:nat] (pow x n) n) - (Rminus x R1)) == - (Rminus (pow x (plus n (1))) R1). -Proof. -Intros; Induction n; Simpl. -Ring. -Rewrite Rmult_Rplus_distrl;Rewrite Hrecn;Cut (plus n (1))=(S n). -Intro H;Rewrite H;Simpl;Ring. -Omega. -Qed. - -Lemma sum_f_R0_triangle: - (x:nat->R)(n:nat) (Rle (Rabsolu (sum_f_R0 x n)) - (sum_f_R0 [i:nat] (Rabsolu (x i)) n)). -Proof. -Intro; Induction n; Simpl. -Unfold Rle; Right; Reflexivity. -Intro m; Intro;Apply (Rle_trans - (Rabsolu (Rplus (sum_f_R0 x m) (x (S m)))) - (Rplus (Rabsolu (sum_f_R0 x m)) - (Rabsolu (x (S m)))) - (Rplus (sum_f_R0 [i:nat](Rabsolu (x i)) m) - (Rabsolu (x (S m))))). -Apply Rabsolu_triang. -Rewrite Rplus_sym;Rewrite (Rplus_sym - (sum_f_R0 [i:nat](Rabsolu (x i)) m) (Rabsolu (x (S m)))); - Apply Rle_compatibility;Assumption. +Definition sum_f (s n:nat) (f:nat -> R) : R := + sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s). + +Lemma GP_finite : + forall (x:R) (n:nat), + sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1. +Proof. +intros; induction n as [| n Hrecn]; simpl in |- *. +ring. +rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n). +intro H; rewrite H; simpl in |- *; ring. +omega. +Qed. + +Lemma sum_f_R0_triangle : + forall (x:nat -> R) (n:nat), + Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n. +Proof. +intro; simple induction n; simpl in |- *. +unfold Rle in |- *; right; reflexivity. +intro m; intro; + apply + (Rle_trans (Rabs (sum_f_R0 x m + x (S m))) + (Rabs (sum_f_R0 x m) + Rabs (x (S m))) + (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))). +apply Rabs_triang. +rewrite Rplus_comm; + rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m)))); + apply Rplus_le_compat_l; assumption. Qed. (*******************************) @@ -764,69 +725,69 @@ Qed. (*******************************) (*********) -Definition R_dist:R->R->R:=[x,y:R](Rabsolu (Rminus x y)). +Definition R_dist (x y:R) : R := Rabs (x - y). (*********) -Lemma R_dist_pos:(x,y:R)(Rge (R_dist x y) R0). +Lemma R_dist_pos : forall x y:R, R_dist x y >= 0. Proof. -Intros;Unfold R_dist;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y));Intro l. -Unfold Rge;Left;Apply (Rlt_RoppO (Rminus x y) l). -Trivial. +intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y)); + intro l. +unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l). +trivial. Qed. (*********) -Lemma R_dist_sym:(x,y:R)(R_dist x y)==(R_dist y x). +Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x. Proof. -Unfold R_dist;Intros;SplitAbsolu;Ring. -Generalize (Rlt_RoppO (Rminus y x) r); Intro; - Rewrite (Ropp_distr2 y x) in H; - Generalize (Rlt_antisym (Rminus x y) R0 r0); Intro;Unfold Rgt in H; - ElimType False; Auto. -Generalize (minus_Rge y x r); Intro; - Generalize (minus_Rge x y r0); Intro; - Generalize (Rge_ge_eq x y H0 H); Intro;Rewrite H1;Ring. +unfold R_dist in |- *; intros; split_Rabs; ring. +generalize (Ropp_gt_lt_0_contravar (y - x) r); intro; + rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0); + intro; unfold Rgt in H; elimtype False; auto. +generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro; + generalize (Rge_antisym x y H0 H); intro; rewrite H1; + ring. Qed. (*********) -Lemma R_dist_refl:(x,y:R)((R_dist x y)==R0<->x==y). +Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y. Proof. -Unfold R_dist;Intros;SplitAbsolu;Split;Intros. -Rewrite (Ropp_distr2 x y) in H;Apply sym_eqT; - Apply (Rminus_eq y x H). -Rewrite (Ropp_distr2 x y);Generalize (sym_eqT R x y H);Intro; - Apply (eq_Rminus y x H0). -Apply (Rminus_eq x y H). -Apply (eq_Rminus x y H). +unfold R_dist in |- *; intros; split_Rabs; split; intros. +rewrite (Ropp_minus_distr x y) in H; apply sym_eq; + apply (Rminus_diag_uniq y x H). +rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro; + apply (Rminus_diag_eq y x H0). +apply (Rminus_diag_uniq x y H). +apply (Rminus_diag_eq x y H). Qed. -Lemma R_dist_eq:(x:R)(R_dist x x)==R0. +Lemma R_dist_eq : forall x:R, R_dist x x = 0. Proof. -Unfold R_dist;Intros;SplitAbsolu;Intros;Ring. +unfold R_dist in |- *; intros; split_Rabs; intros; ring. Qed. (***********) -Lemma R_dist_tri:(x,y,z:R)(Rle (R_dist x y) - (Rplus (R_dist x z) (R_dist z y))). +Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y. Proof. -Intros;Unfold R_dist; Replace ``x-y`` with ``(x-z)+(z-y)``; - [Apply (Rabsolu_triang ``x-z`` ``z-y``)|Ring]. +intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y)); + [ apply (Rabs_triang (x - z) (z - y)) | ring ]. Qed. (*********) -Lemma R_dist_plus: (a,b,c,d:R)(Rle (R_dist (Rplus a c) (Rplus b d)) - (Rplus (R_dist a b) (R_dist c d))). +Lemma R_dist_plus : + forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d. Proof. -Intros;Unfold R_dist; - Replace (Rminus (Rplus a c) (Rplus b d)) - with (Rplus (Rminus a b) (Rminus c d)). -Exact (Rabsolu_triang (Rminus a b) (Rminus c d)). -Ring. +intros; unfold R_dist in |- *; + replace (a + c - (b + d)) with (a - b + (c - d)). +exact (Rabs_triang (a - b) (c - d)). +ring. Qed. (*******************************) (** Infinit Sum *) (*******************************) (*********) -Definition infinit_sum:(nat->R)->R->Prop:=[s:nat->R;l:R] - (eps:R)(Rgt eps R0)-> - (Ex[N:nat](n:nat)(ge n N)->(Rlt (R_dist (sum_f_R0 s n) l) eps)). +Definition infinit_sum (s:nat -> R) (l:R) : Prop := + forall eps:R, + eps > 0 -> + exists N : nat + | (forall n:nat, (n >= N)%nat -> R_dist (sum_f_R0 s n) l < eps).
\ No newline at end of file diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v index 6e7a3bc67..522ae235c 100644 --- a/theories/Reals/Rgeom.v +++ b/theories/Reals/Rgeom.v @@ -8,77 +8,180 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require R_sqrt. -V7only [Import R_scope.]. Open Local Scope R_scope. - -Definition dist_euc [x0,y0,x1,y1:R] : R := ``(sqrt ((Rsqr (x0-x1))+(Rsqr (y0-y1))))``. - -Lemma distance_refl : (x0,y0:R) ``(dist_euc x0 y0 x0 y0)==0``. -Intros x0 y0; Unfold dist_euc; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr] | Right; Reflexivity | Rewrite Rsqr_O; Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr]]]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import R_sqrt. Open Local Scope R_scope. + +Definition dist_euc (x0 y0 x1 y1:R) : R := + sqrt (Rsqr (x0 - x1) + Rsqr (y0 - y1)). + +Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0. +intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat; + [ apply Rle_0_sqr | apply Rle_0_sqr ] + | right; reflexivity + | rewrite Rsqr_0; rewrite Rsqr_sqrt; + [ unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ]. Qed. -Lemma distance_symm : (x0,y0,x1,y1:R) ``(dist_euc x0 y0 x1 y1) == (dist_euc x1 y1 x0 y0)``. -Intros x0 y0 x1 y1; Unfold dist_euc; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 |Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr. +Lemma distance_symm : + forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. +intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat + | apply sqrt_positivity; apply Rplus_le_le_0_compat + | repeat rewrite Rsqr_sqrt; + [ unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. Qed. -Lemma law_cosines : (x0,y0,x1,y1,x2,y2,ac:R) let a = (dist_euc x1 y1 x0 y0) in let b=(dist_euc x2 y2 x0 y0) in let c=(dist_euc x2 y2 x1 y1) in ( ``a*c*(cos ac) == ((x0-x1)*(x2-x1) + (y0-y1)*(y2-y1))`` -> ``(Rsqr b)==(Rsqr c)+(Rsqr a)-2*(a*c*(cos ac))`` ). -Unfold dist_euc; Intros; Repeat Rewrite -> Rsqr_sqrt; [ Rewrite H; Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]; Apply pos_Rsqr. +Lemma law_cosines : + forall x0 y0 x1 y1 x2 y2 ac:R, + let a := dist_euc x1 y1 x0 y0 in + let b := dist_euc x2 y2 x0 y0 in + let c := dist_euc x2 y2 x1 y1 in + a * c * cos ac = (x0 - x1) * (x2 - x1) + (y0 - y1) * (y2 - y1) -> + Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac). +unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt; + [ rewrite H; unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr. Qed. -Lemma triangle : (x0,y0,x1,y1,x2,y2:R) ``(dist_euc x0 y0 x1 y1)<=(dist_euc x0 y0 x2 y2)+(dist_euc x2 y2 x1 y1)``. -Intros; Unfold dist_euc; Apply Rsqr_incr_0; [Rewrite Rsqr_plus; Repeat Rewrite Rsqr_sqrt; [Replace ``(Rsqr (x0-x1))`` with ``(Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)``; [Replace ``(Rsqr (y0-y1))`` with ``(Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)``; [Apply Rle_anti_compatibility with ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))``; Replace `` -(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)+((Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)))`` with ``2*((x0-x2)*(x2-x1)+(y0-y2)*(y2-y1))``; [Replace ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (y0-y2))+((Rsqr (x2-x1))+(Rsqr (y2-y1)))+2*(sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))`` with ``2*((sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))``; [Apply Rle_monotony; [Left; Cut ~(O=(2)); [Intros; Generalize (lt_INR_0 (2) (neq_O_lt (2) H)); Intro H0; Assumption | Discriminate] | Apply sqrt_cauchy] | Ring] | Ring] | SqRing] | SqRing] | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr] | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr]. +Lemma triangle : + forall x0 y0 x1 y1 x2 y2:R, + dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1. +intros; unfold dist_euc in |- *; apply Rsqr_incr_0; + [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt; + [ replace (Rsqr (x0 - x1)) with + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1)); + [ replace (Rsqr (y0 - y1)) with + (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)); + [ apply Rplus_le_reg_l with + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1)); + replace + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1) + + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1) + + (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)))) + with (2 * ((x0 - x2) * (x2 - x1) + (y0 - y2) * (y2 - y1))); + [ replace + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1) + + (Rsqr (x0 - x2) + Rsqr (y0 - y2) + + (Rsqr (x2 - x1) + Rsqr (y2 - y1)) + + 2 * sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * + sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))) with + (2 * + (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * + sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))); + [ apply Rmult_le_compat_l; + [ left; cut (0%nat <> 2%nat); + [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H)); + intro H0; assumption + | discriminate ] + | apply sqrt_cauchy ] + | ring ] + | ring ] + | ring_Rsqr ] + | ring_Rsqr ] + | apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply Rle_0_sqr ] + | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply sqrt_positivity; + apply Rplus_le_le_0_compat; apply Rle_0_sqr ]. Qed. (******************************************************************) (** Translation *) (******************************************************************) -Definition xt[x,tx:R] : R := ``x+tx``. -Definition yt[y,ty:R] : R := ``y+ty``. +Definition xt (x tx:R) : R := x + tx. +Definition yt (y ty:R) : R := y + ty. -Lemma translation_0 : (x,y:R) ``(xt x 0)==x``/\``(yt y 0)==y``. -Intros x y; Split; [Unfold xt | Unfold yt]; Ring. +Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y. +intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring. Qed. -Lemma isometric_translation : (x1,x2,y1,y2,tx,ty:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2))==(Rsqr ((xt x1 tx)-(xt x2 tx)))+(Rsqr ((yt y1 ty)-(yt y2 ty)))``. -Intros; Unfold Rsqr xt yt; Ring. +Lemma isometric_translation : + forall x1 x2 y1 y2 tx ty:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty). +intros; unfold Rsqr, xt, yt in |- *; ring. Qed. (******************************************************************) (** Rotation *) (******************************************************************) -Definition xr [x,y,theta:R] : R := ``x*(cos theta)+y*(sin theta)``. -Definition yr [x,y,theta:R] : R := ``-x*(sin theta)+y*(cos theta)``. +Definition xr (x y theta:R) : R := x * cos theta + y * sin theta. +Definition yr (x y theta:R) : R := - x * sin theta + y * cos theta. -Lemma rotation_0 : (x,y:R) ``(xr x y 0)==x`` /\ ``(yr x y 0)==y``. -Intros x y; Unfold xr yr; Split; Rewrite cos_0; Rewrite sin_0; Ring. +Lemma rotation_0 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y. +intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring. Qed. -Lemma rotation_PI2 : (x,y:R) ``(xr x y PI/2)==y`` /\ ``(yr x y PI/2)==-x``. -Intros x y; Unfold xr yr; Split; Rewrite cos_PI2; Rewrite sin_PI2; Ring. +Lemma rotation_PI2 : + forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x. +intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2; + ring. Qed. -Lemma isometric_rotation_0 : (x1,y1,x2,y2,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr x1 y1 theta))-(xr x2 y2 theta)) + (Rsqr ((yr x1 y1 theta))-(yr x2 y2 theta))``. -Intros; Unfold xr yr; Replace ``x1*(cos theta)+y1*(sin theta)-(x2*(cos theta)+y2*(sin theta))`` with ``(cos theta)*(x1-x2)+(sin theta)*(y1-y2)``; [Replace ``-x1*(sin theta)+y1*(cos theta)-( -x2*(sin theta)+y2*(cos theta))`` with ``(cos theta)*(y1-y2)+(sin theta)*(x2-x1)``; [Repeat Rewrite Rsqr_plus; Repeat Rewrite Rsqr_times; Repeat Rewrite cos2; Ring; Replace ``x2-x1`` with ``-(x1-x2)``; [Rewrite <- Rsqr_neg; Ring | Ring] |Ring] | Ring]. +Lemma isometric_rotation_0 : + forall x1 y1 x2 y2 theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xr x1 y1 theta - xr x2 y2 theta) + + Rsqr (yr x1 y1 theta - yr x2 y2 theta). +intros; unfold xr, yr in |- *; + replace + (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with + (cos theta * (x1 - x2) + sin theta * (y1 - y2)); + [ replace + (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta)) + with (cos theta * (y1 - y2) + sin theta * (x2 - x1)); + [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2; + ring; replace (x2 - x1) with (- (x1 - x2)); + [ rewrite <- Rsqr_neg; ring | ring ] + | ring ] + | ring ]. Qed. -Lemma isometric_rotation : (x1,y1,x2,y2,theta:R) ``(dist_euc x1 y1 x2 y2) == (dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) (yr x2 y2 theta))``. -Unfold dist_euc; Intros; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [ Apply isometric_rotation_0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr. +Lemma isometric_rotation : + forall x1 y1 x2 y2 theta:R, + dist_euc x1 y1 x2 y2 = + dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) + (yr x2 y2 theta). +unfold dist_euc in |- *; intros; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat + | apply sqrt_positivity; apply Rplus_le_le_0_compat + | repeat rewrite Rsqr_sqrt; + [ apply isometric_rotation_0 + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. Qed. (******************************************************************) (** Similarity *) (******************************************************************) -Lemma isometric_rot_trans : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr (xt x1 tx) (yt y1 ty) theta)-(xr (xt x2 tx) (yt y2 ty) theta))) + (Rsqr ((yr (xt x1 tx) (yt y1 ty) theta)-(yr (xt x2 tx) (yt y2 ty) theta)))``. -Intros; Rewrite <- isometric_rotation_0; Apply isometric_translation. +Lemma isometric_rot_trans : + forall x1 y1 x2 y2 tx ty theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) + + Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). +intros; rewrite <- isometric_rotation_0; apply isometric_translation. Qed. -Lemma isometric_trans_rot : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xt (xr x1 y1 theta) tx)-(xt (xr x2 y2 theta) tx))) + (Rsqr ((yt (yr x1 y1 theta) ty)-(yt (yr x2 y2 theta) ty)))``. -Intros; Rewrite <- isometric_translation; Apply isometric_rotation_0. -Qed. +Lemma isometric_trans_rot : + forall x1 y1 x2 y2 tx ty theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + + Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). +intros; rewrite <- isometric_translation; apply isometric_rotation_0. +Qed.
\ No newline at end of file diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v index a44f3c1b5..2766aa2fe 100644 --- a/theories/Reals/RiemannInt.v +++ b/theories/Reals/RiemannInt.v @@ -8,1692 +8,3256 @@ (*i $Id$ i*) -Require Rfunctions. -Require SeqSeries. -Require Ranalysis. -Require Rbase. -Require RiemannInt_SF. -Require Classical_Prop. -Require Classical_Pred_Type. -Require Max. -V7only [Import R_scope.]. Open Local Scope R_scope. - -Implicit Arguments On. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Ranalysis. +Require Import Rbase. +Require Import RiemannInt_SF. +Require Import Classical_Prop. +Require Import Classical_Pred_Type. +Require Import Max. Open Local Scope R_scope. + +Set Implicit Arguments. (********************************************) (* Riemann's Integral *) (********************************************) -Definition Riemann_integrable [f:R->R;a,b:R] : Type := (eps:posreal) (SigT ? [phi:(StepFun a b)](SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi t)))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<eps``)). - -Definition phi_sequence [un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b)] := [n:nat](projT1 ? ? (pr (un n))). - -Lemma phi_sequence_prop : (un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b);N:nat) (SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-[(phi_sequence un pr N t)]))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<(un N)``). -Intros; Apply (projT2 ? ? (pr (un N))). +Definition Riemann_integrable (f:R -> R) (a b:R) : Type := + forall eps:posreal, + sigT + (fun phi:StepFun a b => + sigT + (fun psi:StepFun a b => + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ + Rabs (RiemannInt_SF psi) < eps)). + +Definition phi_sequence (un:nat -> posreal) (f:R -> R) + (a b:R) (pr:Riemann_integrable f a b) (n:nat) := + projT1 (pr (un n)). + +Lemma phi_sequence_prop : + forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + (N:nat), + sigT + (fun psi:StepFun a b => + (forall t:R, + Rmin a b <= t <= Rmax a b -> + Rabs (f t - phi_sequence un pr N t) <= psi t) /\ + Rabs (RiemannInt_SF psi) < un N). +intros; apply (projT2 (pr (un N))). Qed. -Lemma RiemannInt_P1 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable f b a). -Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros; Elim p; Clear p; Intros; Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x))); Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x0))); Elim p; Clear p; Intros; Split. -Intros; Apply (H t); Elim H1; Clear H1; Intros; Split; [Apply Rle_trans with (Rmin b a); Try Assumption; Right; Unfold Rmin | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]). -Generalize H0; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with (Int_SF (subdivision_val x0) (subdivision x0)); [Idtac | Apply StepFun_P17 with (fe x0) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0))))]]). -Apply H1. -Rewrite Rabsolu_Ropp; Apply H1. -Rewrite Rabsolu_Ropp in H1; Apply H1. -Apply H1. +Lemma RiemannInt_P1 : + forall (f:R -> R) (a b:R), + Riemann_integrable f a b -> Riemann_integrable f b a. +unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros; + elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x))); + apply existT with (mkStepFun (StepFun_P6 (pre x0))); + elim p; clear p; intros; split. +intros; apply (H t); elim H1; clear H1; intros; split; + [ apply Rle_trans with (Rmin b a); try assumption; right; + unfold Rmin in |- * + | apply Rle_trans with (Rmax b a); try assumption; right; + unfold Rmax in |- * ]; + (case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || apply Rle_antisym; + [ assumption | assumption | auto with real | auto with real ]). +generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + case (Rle_dec b a); intros; + (replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) + (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with + (Int_SF (subdivision_val x0) (subdivision x0)); + [ idtac + | apply StepFun_P17 with (fe x0) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0)))) ] ]). +apply H1. +rewrite Rabs_Ropp; apply H1. +rewrite Rabs_Ropp in H1; apply H1. +apply H1. Qed. -Lemma RiemannInt_P2 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ``a<=b`` -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (vn N)) l)). -Intros; Apply R_complete; Unfold Un_cv in H; Unfold Cauchy_crit; Intros; Assert H3 : ``0<eps/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -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))``; [Idtac | Ring]; Rewrite <- StepFun_P30; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (vn n) (vn m)))))). -Apply StepFun_P34; Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (wn n) (wn m)))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((vn n x)-(f x)))+(Rabsolu ((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 Rabsolu_triang | Ring]. -Assert H12 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Assert H13 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Rewrite <- H12 in H11; Pattern 2 b in H11; Rewrite <- H13 in H11; Rewrite Rmult_1l; Apply Rplus_le. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9. -Elim H11; Intros; Split; Left; Assumption. -Apply H7. -Elim H11; Intros; Split; Left; Assumption. -Rewrite StepFun_P30; Rewrite Rmult_1l; Apply Rlt_trans with ``(un n)+(un m)``. -Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (wn n)))+(Rabsolu (RiemannInt_SF (wn m)))``. -Apply Rplus_le; Apply Rle_Rabsolu. -Apply Rplus_lt; Assumption. -Apply Rle_lt_trans with ``(Rabsolu (un n))+(Rabsolu (un m))``. -Apply Rplus_le; Apply Rle_Rabsolu. -Replace (pos (un n)) with ``(un n)-0``; [Idtac | Ring]; Replace (pos (un m)) with ``(un m)-0``; [Idtac | Ring]; Rewrite (double_var eps); Apply Rplus_lt; Apply H4; Assumption. +Lemma RiemannInt_P2 : + forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), + Un_cv un 0 -> + a <= b -> + (forall n:nat, + (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ + Rabs (RiemannInt_SF (wn n)) < un n) -> + sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). +intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *; + intros; assert (H3 : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *; + unfold R_dist in H4; elim (H1 n); elim (H1 m); intros; + replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with + (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); + [ idtac | ring ]; rewrite <- StepFun_P30; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (vn n) (vn m)))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; + apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)). +replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x)); + [ apply Rabs_triang | ring ]. +assert (H12 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H13 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11; + rewrite Rmult_1_l; apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9. +elim H11; intros; split; left; assumption. +apply H7. +elim H11; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m). +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))). +apply Rplus_le_compat; apply RRle_abs. +apply Rplus_lt_compat; assumption. +apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)). +apply Rplus_le_compat; apply RRle_abs. +replace (pos (un n)) with (un n - 0); [ idtac | ring ]; + replace (pos (un m)) with (un m - 0); [ idtac | ring ]; + rewrite (double_var eps); apply Rplus_lt_compat; apply H4; + assumption. Qed. -Lemma RiemannInt_P3 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``)->(sigTT R ([l:R](Un_cv ([N:nat](RiemannInt_SF (vn N))) l))). -Intros; Case (total_order_Rle a b); Intro. -Apply RiemannInt_P2 with f un wn; Assumption. -Assert H1 : ``b<=a``; Auto with real. -Pose vn' := [n:nat](mkStepFun (StepFun_P6 (pre (vn n)))); Pose wn' := [n:nat](mkStepFun (StepFun_P6 (pre (wn n)))); Assert H2 : (n:nat)((t:R)``(Rmin b a)<=t<=(Rmax b a)``->``(Rabsolu ((f t)-(vn' n t)))<=(wn' n t)``)/\``(Rabsolu (RiemannInt_SF (wn' n)))<(un n)``. -Intro; Elim (H0 n0); Intros; Split. -Intros; Apply (H2 t); Elim H4; Clear H4; Intros; Split; [Apply Rle_trans with (Rmin b a); Try Assumption; Right; Unfold Rmin | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]). -Generalize H3; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Unfold wn'; Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); [Idtac | Apply StepFun_P17 with (fe (wn n0)) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0)))))]]). -Apply H4. -Rewrite Rabsolu_Ropp; Apply H4. -Rewrite Rabsolu_Ropp in H4; Apply H4. -Apply H4. -Assert H3 := (RiemannInt_P2 H H1 H2); Elim H3; Intros; Apply existTT with ``-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; Case (total_order_Rle b a); Case (total_order_Rle 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; Rewrite Ropp_Ropp; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Apply H7 | 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)))))]]. -Elim n1; Assumption. -Elim n2; Assumption. +Lemma RiemannInt_P3 : + forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), + Un_cv un 0 -> + (forall n:nat, + (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ + Rabs (RiemannInt_SF (wn n)) < un n) -> + sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). +intros; case (Rle_dec a b); intro. +apply RiemannInt_P2 with f un wn; assumption. +assert (H1 : b <= a); auto with real. +pose (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n)))); + pose (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n)))); + assert + (H2 : + forall n:nat, + (forall t:R, + Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\ + Rabs (RiemannInt_SF (wn' n)) < un n). +intro; elim (H0 n0); intros; split. +intros; apply (H2 t); elim H4; clear H4; intros; split; + [ apply Rle_trans with (Rmin b a); try assumption; right; + unfold Rmin in |- * + | apply Rle_trans with (Rmax b a); try assumption; right; + unfold Rmax in |- * ]; + (case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || apply Rle_antisym; + [ assumption | assumption | auto with real | auto with real ]). +generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + case (Rle_dec b a); unfold wn' in |- *; intros; + (replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) + (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with + (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); + [ idtac + | apply StepFun_P17 with (fe (wn n0)) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0))))) ] ]). +apply H4. +rewrite Rabs_Ropp; apply H4. +rewrite Rabs_Ropp in H4; apply H4. +apply H4. +assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros; + apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p; + intros; elim (p _ H4); intros; exists x0; intros; + generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *; + case (Rle_dec b a); case (Rle_dec a b); intros. +elim n; assumption. +unfold vn' in H7; + replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) + (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); + [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + apply H7 + | symmetry in |- *; apply StepFun_P17 with (fe (vn n0)) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ]. +elim n1; assumption. +elim n2; assumption. Qed. -Lemma RiemannInt_exists : (f:R->R;a,b:R;pr:(Riemann_integrable f a b);un:nat->posreal) (Un_cv un R0) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr N)) l)). -Intros f; Intros; Apply RiemannInt_P3 with f un [n:nat](projT1 ? ? (phi_sequence_prop un pr n)); [Apply H | Intro; Apply (projT2 ? ? (phi_sequence_prop un pr n))]. +Lemma RiemannInt_exists : + forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + (un:nat -> posreal), + Un_cv un 0 -> + sigT + (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l). +intros f; intros; + apply RiemannInt_P3 with + f un (fun n:nat => projT1 (phi_sequence_prop un pr n)); + [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ]. Qed. -Lemma RiemannInt_P4 : (f:R->R;a,b,l:R;pr1,pr2:(Riemann_integrable f a b);un,vn:nat->posreal) (Un_cv un R0) -> (Un_cv vn R0) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence vn pr2 N)) l). -Unfold Un_cv; Unfold R_dist; Intros f; Intros; Assert H3 : ``0<eps/3``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; 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; Pose N := (max (max N0 N1) N2); Exists N; Intros; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence un pr1 n)])-l))``. -Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-l`` with ``((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)]))+((RiemannInt_SF [(phi_sequence un pr1 n)])-l)``; [Apply Rabsolu_triang | Ring]. -Replace ``eps`` with ``2*eps/3+eps/3``. -Apply Rplus_lt. -Elim (phi_sequence_prop vn pr2 n); Intros psi_vn H5; Elim (phi_sequence_prop un pr1 n); Intros psi_un H6; Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])`` with ``(RiemannInt_SF [(phi_sequence vn pr2 n)])+(-1)*(RiemannInt_SF [(phi_sequence un pr1 n)])``; [Idtac | Ring]; Rewrite <- StepFun_P30. -Case (total_order_Rle a b); Intro. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n)))))). -Apply StepFun_P34; Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 psi_un psi_vn))). -Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``. -Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring]. -Assert H10 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Assert H11 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Rewrite (Rplus_sym (psi_un x)); Apply Rplus_le. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8. -Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption. -Elim H6; Intros; Apply H8. -Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption. -Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt. -Apply Rlt_trans with (pos (un n)). -Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)). -Apply Rle_Rabsolu. -Assumption. -Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [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; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))]. -Apply Rlt_trans with (pos (vn n)). -Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)). -Apply Rle_Rabsolu; Assumption. -Assumption. -Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [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; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))]. -Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n))))))))). -Apply StepFun_P34; Try Auto with real. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un)))))). -Apply StepFun_P37. -Auto with real. -Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``. -Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring]. -Assert H10 : (Rmin a b)==b. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity]. -Assert H11 : (Rmax a b)==a. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity]. -Apply Rplus_le. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8. -Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption. -Elim H6; Intros; Apply H8. -Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption. -Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un))))))); Rewrite <- StepFun_P39; Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Rewrite Ropp_distr1; Apply Rplus_lt. -Apply Rlt_trans with (pos (vn n)). -Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Assumption. -Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))]. -Apply Rlt_trans with (pos (un n)). -Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption. -Assumption. -Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [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; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))]. -Apply H1; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r. -Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. +Lemma RiemannInt_P4 : + forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b) + (un vn:nat -> posreal), + Un_cv un 0 -> + Un_cv vn 0 -> + Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l -> + Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l. +unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros; + assert (H3 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0; + elim (H1 _ H3); clear H1; intros N2 H1; pose (N := max (max N0 N1) N2); + exists N; intros; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n)) + + Rabs (RiemannInt_SF (phi_sequence un pr1 n) - l)). +replace (RiemannInt_SF (phi_sequence vn pr2 n) - l) with + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n) + + (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ]. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +elim (phi_sequence_prop vn pr2 n); intros psi_vn H5; + elim (phi_sequence_prop un pr1 n); intros psi_un H6; + replace + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n)) with + (RiemannInt_SF (phi_sequence vn pr2 n) + + -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ]; + rewrite <- StepFun_P30. +case (Rle_dec a b); intro. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence vn pr2 n) + (phi_sequence un pr1 n)))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))). +apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence vn pr2 n x - f x) + + Rabs (f x - phi_sequence un pr1 n x)). +replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with + (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); + [ apply Rabs_triang | ring ]. +assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +elim H6; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +apply Rlt_trans with (pos (un n)). +elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). +apply RRle_abs. +assumption. +replace (pos (un n)) with (Rabs (un n - 0)); + [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + apply le_max_l + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (un n)) ]. +apply Rlt_trans with (pos (vn n)). +elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). +apply RRle_abs; assumption. +assumption. +replace (pos (vn n)) with (Rabs (vn n - 0)); + [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + [ apply le_max_r | apply le_max_l ] + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (vn n)) ]. +rewrite StepFun_P39; rewrite Rabs_Ropp; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P6 + (pre + (mkStepFun + (StepFun_P28 (-1) (phi_sequence vn pr2 n) + (phi_sequence un pr1 n))))))))). +apply StepFun_P34; try auto with real. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))). +apply StepFun_P37. +auto with real. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence vn pr2 n x - f x) + + Rabs (f x - phi_sequence un pr1 n x)). +replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with + (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); + [ apply Rabs_triang | ring ]. +assert (H10 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +assert (H11 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +elim H6; intros; apply H8. +rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. +rewrite <- + (Ropp_involutive + (RiemannInt_SF + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un))))))) + ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l; + rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat. +apply Rlt_trans with (pos (vn n)). +elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). +rewrite <- Rabs_Ropp; apply RRle_abs. +assumption. +replace (pos (vn n)) with (Rabs (vn n - 0)); + [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + [ apply le_max_r | apply le_max_l ] + | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (vn n)) ]. +apply Rlt_trans with (pos (un n)). +elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). +rewrite <- Rabs_Ropp; apply RRle_abs; assumption. +assumption. +replace (pos (un n)) with (Rabs (un n - 0)); + [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_trans with (max N0 N1); + apply le_max_l + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (un n)) ]. +apply H1; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. -Lemma RinvN_pos : (n:nat) ``0</((INR n)+1)``. -Intro; Apply Rlt_Rinv; Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1]. +Lemma RinvN_pos : forall n:nat, 0 < / (INR n + 1). +intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat; + [ apply pos_INR | apply Rlt_0_1 ]. Qed. -Definition RinvN : nat->posreal := [N:nat](mkposreal ? (RinvN_pos N)). +Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N). -Lemma RinvN_cv : (Un_cv RinvN R0). -Unfold Un_cv; Intros; Assert H0 := (archimed ``/eps``); Elim H0; Clear H0; Intros; Assert H2 : `0<=(up (Rinv eps))`. -Apply le_IZR; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption]. -Elim (IZN ? H2); Intros; Exists x; Intros; Unfold R_dist; Simpl; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assert H5 : ``0<(INR n)+1``. -Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1]. -Rewrite Rabsolu_right; [Idtac | Left; Change ``0</((INR n)+1)``; Apply Rlt_Rinv; Assumption]; Apply Rle_lt_trans with ``/((INR x)+1)``. -Apply Rle_Rinv. -Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1]. -Assumption. -Do 2 Rewrite <- (Rplus_sym R1); Apply Rle_compatibility; Apply le_INR; Apply H4. -Rewrite <- (Rinv_Rinv eps). -Apply Rinv_lt. -Apply Rmult_lt_pos. -Apply Rlt_Rinv; Assumption. -Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1]. -Apply Rlt_trans with (INR x); [Rewrite INR_IZR_INZ; Rewrite <- H3; Apply H0 | Pattern 1 (INR x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1]. -Red; Intro; Rewrite H6 in H; Elim (Rlt_antirefl ? H). +Lemma RinvN_cv : Un_cv RinvN 0. +unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0; + clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z). +apply le_IZR; left; apply Rlt_trans with (/ eps); + [ apply Rinv_0_lt_compat; assumption | assumption ]. +elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *; + simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1). +apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. +rewrite Rabs_right; + [ idtac + | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat; + assumption ]; apply Rle_lt_trans with (/ (INR x + 1)). +apply Rle_Rinv. +apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. +assumption. +do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR; + apply H4. +rewrite <- (Rinv_involutive eps). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply Rinv_0_lt_compat; assumption. +apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. +apply Rlt_trans with (INR x); + [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0 + | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1 ]. +red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). Qed. (**********) -Definition RiemannInt [f:R->R;a,b:R;pr:(Riemann_integrable f a b)] : R := Cases -(RiemannInt_exists pr 5!RinvN RinvN_cv) of (existTT a' b') => a' end. - -Lemma RiemannInt_P5 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f a b)) (RiemannInt pr1)==(RiemannInt pr2). -Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Apply RiemannInt_P4 with pr2 RinvN; Apply RinvN_cv Orelse Assumption]. +Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R := + match RiemannInt_exists pr RinvN RinvN_cv with + | existT a' b' => a' + end. + +Lemma RiemannInt_P5 : + forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b), + RiemannInt pr1 = RiemannInt pr2. +intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + eapply UL_sequence; + [ apply u0 + | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ]. Qed. (**************************************) (* C°([a,b]) is included in L1([a,b]) *) (**************************************) -Lemma maxN : (a,b:R;del:posreal) ``a<b`` -> (sigTT ? [n:nat]``a+(INR n)*del<b``/\``b<=a+(INR (S n))*del``). -Intros; Pose I := [n:nat]``a+(INR n)*del < b``; Assert H0 : (EX n:nat | (I n)). -Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Assumption. -Cut (Nbound I). -Intro; Assert H2 := (Nzorn H0 H1); Elim H2; Intros; Exists x; Elim p; Intros; Split. -Apply H3. -Case (total_order_T ``a+(INR (S x))*del`` b); Intro. -Elim s; Intro. -Assert H5 := (H4 (S x) a0); Elim (le_Sn_n ? H5). -Right; Symmetry; Assumption. -Left; Apply r. -Assert H1 : ``0<=(b-a)/del``. -Unfold Rdiv; Apply Rmult_le_pos; [Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Left; Apply H | Left; Apply Rlt_Rinv; Apply (cond_pos del)]. -Elim (archimed ``(b-a)/del``); Intros; Assert H4 : `0<=(up (Rdiv (Rminus 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; 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 Rle_monotony_contra with (pos del); [Apply (cond_pos del) | Unfold Rdiv; Rewrite <- (Rmult_sym ``/del``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite Rmult_sym; Apply Rle_anti_compatibility with a; Replace ``a+(b-a)`` with b; [Left; Assumption | Ring] | Assert H7 := (cond_pos del); Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7)]]. +Lemma maxN : + forall (a b:R) (del:posreal), + a < b -> + sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del). +intros; pose (I := fun n:nat => a + INR n * del < b); + assert (H0 : exists n : nat | I n). +exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; + assumption. +cut (Nbound I). +intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros; + split. +apply H3. +case (total_order_T (a + INR (S x) * del) b); intro. +elim s; intro. +assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5). +right; symmetry in |- *; assumption. +left; apply r. +assert (H1 : 0 <= (b - a) / del). +unfold Rdiv in |- *; apply Rmult_le_pos; + [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H + | left; apply Rinv_0_lt_compat; apply (cond_pos del) ]. +elim (archimed ((b - a) / del)); intros; + assert (H4 : (0 <= up ((b - a) / del))%Z). +apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del); + assumption. +assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5; + unfold Nbound in |- *; exists N; intros; unfold I in H6; + apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; + left; apply Rle_lt_trans with ((b - a) / del); try assumption; + apply Rmult_le_reg_l with (pos del); + [ apply (cond_pos del) + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a; + replace (a + (b - a)) with b; [ left; assumption | ring ] + | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7; + elim (Rlt_irrefl _ H7) ] ]. Qed. -Fixpoint SubEquiN [N:nat] : R->R->posreal->Rlist := -[x:R][y:R][del:posreal] Cases N of -| O => (cons y nil) -| (S p) => (cons x (SubEquiN p ``x+del`` y del)) -end. - -Definition max_N [a,b:R;del:posreal;h:``a<b``] : nat := Cases (maxN del h) of (existTT N H0) => N end. - -Definition SubEqui [a,b:R;del:posreal;h:``a<b``] :Rlist := (SubEquiN (S (max_N del h)) a b del). - -Lemma Heine_cor1 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (eps:posreal) (sigTT ? [delta:posreal]``delta<=b-a``/\(x,y:R)``a<=x<=b``->``a<=y<=b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``). -Intro f; Intros; Pose E := [l:R]``0<l<=b-a``/\(x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < l``->``(Rabsolu ((f x)-(f y))) < eps``; Assert H1 : (bound E). -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 : (EXT x:R | (E x)). -Assert H2 := (Heine f [x:R]``a<=x<=b`` (compact_P3 a b) H0 eps); Elim H2; Intros; Exists (Rmin x ``b-a``); Unfold E; Split; [Split; [Unfold Rmin; Case (total_order_Rle x ``b-a``); Intro; [Apply (cond_pos x) | Apply Rlt_Rminus; Assumption] | Apply Rmin_r] | Intros; Apply H3; Try Assumption; Apply Rlt_le_trans with (Rmin x ``b-a``); [Assumption | Apply Rmin_l]]. -Assert H3 := (complet E H1 H2); Elim H3; Intros; Cut ``0<x<=b-a``. -Intro; Elim H4; Clear H4; Intros; Apply existTT with (mkposreal ? H4); Split. -Apply H5. -Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H6; Pose D := ``(Rabsolu (x0-y))``; Elim (classic (EXT y:R | ``D<y``/\(E y))); Intro. -Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15; Assumption. -Assert H12 := (not_ex_all_not ? [y:R]``D < y``/\(E y) H11); Assert H13 : (is_upper_bound E D). -Unfold is_upper_bound; Intros; Assert H14 := (H12 x1); Elim (not_and_or ``D<x1`` (E x1) H14); Intro. -Case (total_order_Rle x1 D); Intro. -Assumption. -Elim H15; Auto with real. -Elim H15; Assumption. -Assert H14 := (H7 ? H13); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H10)). -Unfold is_lub in p; Unfold is_upper_bound in p; Elim p; Clear p; Intros; Split. -Elim H2; Intros; Assert H7 := (H4 ? H6); Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Apply Rlt_le_trans with x0; Assumption. -Apply H5; Intros; Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Assumption. +Fixpoint SubEquiN (N:nat) (x y:R) (del:posreal) {struct N} : Rlist := + match N with + | O => cons y nil + | S p => cons x (SubEquiN p (x + del) y del) + end. + +Definition max_N (a b:R) (del:posreal) (h:a < b) : nat := + match maxN del h with + | existT N H0 => N + end. + +Definition SubEqui (a b:R) (del:posreal) (h:a < b) : Rlist := + SubEquiN (S (max_N del h)) a b del. + +Lemma Heine_cor1 : + forall (f:R -> R) (a b:R), + a < b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall eps:posreal, + sigT + (fun delta:posreal => + delta <= b - a /\ + (forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)). +intro f; intros; + pose + (E := + fun l:R => + 0 < l <= b - a /\ + (forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps)); + assert (H1 : bound E). +unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros; + unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; + intros; assumption. +assert (H2 : exists x : R | E x). +assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps); + elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; + split; + [ split; + [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro; + [ apply (cond_pos x) | apply Rlt_Rminus; assumption ] + | apply Rmin_r ] + | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a)); + [ assumption | apply Rmin_l ] ]. +assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a). +intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split. +apply H5. +unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6; + pose (D := Rabs (x0 - y)); elim (classic ( exists y : R | D < y /\ E y)); + intro. +elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13; + intros; apply H15; assumption. +assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11); + assert (H13 : is_upper_bound E D). +unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1); + elim (not_and_or (D < x1) (E x1) H14); intro. +case (Rle_dec x1 D); intro. +assumption. +elim H15; auto with real. +elim H15; assumption. +assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)). +unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros; + split. +elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6; + intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; + assumption. +apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; + intros; assumption. Qed. -Lemma Heine_cor2 : (f:(R->R); a,b:R) ((x:R)``a <= x <= b``->(continuity_pt f x))->(eps:posreal)(sigTT posreal [delta:posreal]((x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``)). -Intro f; Intros; Case (total_order_T a b); Intro. -Elim s; Intro. -Assert H0 := (Heine_cor1 a0 H eps); Elim H0; Intros; Apply existTT with x; Elim p; Intros; Apply H2; Assumption. -Apply existTT with (mkposreal ? Rlt_R0_R1); 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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps)]. -Apply existTT with (mkposreal ? Rlt_R0_R1); Intros; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H3 H4) r)). +Lemma Heine_cor2 : + forall (f:R -> R) (a b:R), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall eps:posreal, + sigT + (fun delta:posreal => + forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). +intro f; intros; case (total_order_T a b); intro. +elim s; intro. +assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; apply existT with x; + elim p; intros; apply H2; assumption. +apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y); + [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5; + apply Rle_antisym; apply Rle_trans with b; assumption + | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (cond_pos eps) ]. +apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)). Qed. -Lemma SubEqui_P1 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) O)==a. -Intros; Unfold SubEqui; Case (maxN del h); Intros; Reflexivity. +Lemma SubEqui_P1 : + forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a. +intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity. Qed. -Lemma SubEqui_P2 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))))==b. -Intros; Unfold SubEqui; Case (maxN del h); Intros; Clear a0; Cut (x:nat)(a:R)(del:posreal)(pos_Rl (SubEquiN (S x) a b del) (pred (Rlength (SubEquiN (S x) a b del)))) == b; [Intro; Apply H | Induction x0; [Intros; Reflexivity | Intros; Change (pos_Rl (SubEquiN (S n) ``a0+del0`` b del0) (pred (Rlength (SubEquiN (S n) ``a0+del0`` b del0))))==b; Apply H]]. +Lemma SubEqui_P2 : + forall (a b:R) (del:posreal) (h:a < b), + pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b. +intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0; + cut + (forall (x:nat) (a:R) (del:posreal), + pos_Rl (SubEquiN (S x) a b del) + (pred (Rlength (SubEquiN (S x) a b del))) = b); + [ intro; apply H + | simple induction x0; + [ intros; reflexivity + | intros; + change + (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) + (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) + in |- *; apply H ] ]. Qed. -Lemma SubEqui_P3 : (N:nat;a,b:R;del:posreal) (Rlength (SubEquiN N a b del))=(S N). -Induction N; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity]. +Lemma SubEqui_P3 : + forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N. +simple induction N; intros; + [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. Qed. -Lemma SubEqui_P4 : (N:nat;a,b:R;del:posreal;i:nat) (lt i (S N)) -> (pos_Rl (SubEquiN (S N) a b del) i)==``a+(INR i)*del``. -Induction N; [Intros; Inversion H; [Simpl; Ring | Elim (le_Sn_O ? H1)] | Intros; Induction i; [Simpl; Ring | Change (pos_Rl (SubEquiN (S n) ``a+del`` b del) i)==``a+(INR (S i))*del``; Rewrite H; [Rewrite S_INR; Ring | Apply lt_S_n; Apply H0]]]. +Lemma SubEqui_P4 : + forall (N:nat) (a b:R) (del:posreal) (i:nat), + (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del. +simple induction N; + [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ] + | intros; induction i as [| i Hreci]; + [ simpl in |- *; ring + | change + (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del) + in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ]. Qed. -Lemma SubEqui_P5 : (a,b:R;del:posreal;h:``a<b``) (Rlength (SubEqui del h))=(S (S (max_N del h))). -Intros; Unfold SubEqui; Apply SubEqui_P3. +Lemma SubEqui_P5 : + forall (a b:R) (del:posreal) (h:a < b), + Rlength (SubEqui del h) = S (S (max_N del h)). +intros; unfold SubEqui in |- *; apply SubEqui_P3. Qed. -Lemma SubEqui_P6 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (S (max_N del h))) -> (pos_Rl (SubEqui del h) i)==``a+(INR i)*del``. -Intros; Unfold SubEqui; Apply SubEqui_P4; Assumption. +Lemma SubEqui_P6 : + forall (a b:R) (del:posreal) (h:a < b) (i:nat), + (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del. +intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption. Qed. -Lemma SubEqui_P7 : (a,b:R;del:posreal;h:``a<b``) (ordered_Rlist (SubEqui del h)). -Intros; Unfold ordered_Rlist; Intros; Rewrite SubEqui_P5 in H; Simpl in H; Inversion H. -Rewrite (SubEqui_P6 3!del 4!h 5!(max_N del h)). -Replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))). -Rewrite SubEqui_P2; Unfold max_N; Case (maxN del h); Intros; Left; Elim a0; Intros; Assumption. -Rewrite SubEqui_P5; Reflexivity. -Apply lt_n_Sn. -Repeat Rewrite SubEqui_P6. -3:Assumption. -2:Apply le_lt_n_Sm; Assumption. -Apply Rle_compatibility; Rewrite S_INR; Rewrite Rmult_Rplus_distrl; Pattern 1 ``(INR i)*del``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite Rmult_1l; Left; Apply (cond_pos del). +Lemma SubEqui_P7 : + forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h). +intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H; + simpl in H; inversion H. +rewrite (SubEqui_P6 del h (i:=(max_N del h))). +replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))). +rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left; + elim a0; intros; assumption. +rewrite SubEqui_P5; reflexivity. +apply lt_n_Sn. +repeat rewrite SubEqui_P6. +3: assumption. +2: apply le_lt_n_Sm; assumption. +apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r; + pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; rewrite Rmult_1_l; left; + apply (cond_pos del). Qed. -Lemma SubEqui_P8 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (Rlength (SubEqui del h))) -> ``a<=(pos_Rl (SubEqui del h) i)<=b``. -Intros; Split. -Pattern 1 a; 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 2 b; 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]]. +Lemma SubEqui_P8 : + forall (a b:R) (del:posreal) (h:a < b) (i:nat), + (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b. +intros; split. +pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5. +apply SubEqui_P7. +elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1; + exists i; split; [ reflexivity | assumption ]. +pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7; + [ apply SubEqui_P7 + | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; + apply H1; exists i; split; [ reflexivity | assumption ] ]. Qed. -Lemma SubEqui_P9 : (a,b:R;del:posreal;f:R->R;h:``a<b``) (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength (SubEqui del h))))->(constant_D_eq g (co_interval (pos_Rl (SubEqui del h) i) (pos_Rl (SubEqui del h) (S i))) (f (pos_Rl (SubEqui del h) i)))). -Intros; Apply StepFun_P38; [Apply SubEqui_P7 | Apply SubEqui_P1 | Apply SubEqui_P2]. +Lemma SubEqui_P9 : + forall (a b:R) (del:posreal) (f:R -> R) (h:a < b), + sigT + (fun g:StepFun a b => + g b = f b /\ + (forall i:nat, + (i < pred (Rlength (SubEqui del h)))%nat -> + constant_D_eq g + (co_interval (pos_Rl (SubEqui del h) i) + (pos_Rl (SubEqui del h) (S i))) + (f (pos_Rl (SubEqui del h) i)))). +intros; apply StepFun_P38; + [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ]. Qed. -Lemma RiemannInt_P6 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b). -Intros; Unfold Riemann_integrable; Intro; Assert H1 : ``0<eps/(2*(b-a))``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rminus; Assumption]]. -Assert H2 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption]. -Assert H3 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle 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; Rewrite Rinv_Rmult. -2:Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -2:Rewrite Rmult_1r; Rewrite Rabsolu_right. -2:Apply Rlt_monotony_contra with ``2``. -2:Sup0. -2:Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -2:Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps). -2:DiscrR. -2:Apply Rle_sym1; Left; Apply Rmult_lt_pos. -2:Apply (cond_pos eps). -2:Apply Rlt_Rinv; Sup0. -2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H). -2:DiscrR. -2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H). -Intros; Rewrite H2 in H7; Rewrite H3 in H7; Simpl; Unfold fct_cte; Cut (t:R)``a<=t<=b``->t==b\/(EX i:nat | (lt i (pred (Rlength (SubEqui del H))))/\(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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_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; Intro; Rewrite <- H12 in H9; Elim (lt_n_O ? H9). -Unfold co_interval in H10; Elim H10; Clear H10; Intros; Rewrite Rabsolu_right. -Rewrite SubEqui_P5 in H9; Simpl in H9; Inversion H9. -Apply Rlt_anti_compatibility with (pos_Rl (SubEqui del H) (max_N del H)). -Replace ``(pos_Rl (SubEqui del H) (max_N del H))+(t-(pos_Rl (SubEqui del H) (max_N del H)))`` with t; [Idtac | Ring]; Apply Rlt_le_trans with b. -Rewrite H14 in H12; Assert H13 : (S (max_N del H))=(pred (Rlength (SubEqui del H))). -Rewrite SubEqui_P5; Reflexivity. -Rewrite H13 in H12; Rewrite SubEqui_P2 in H12; Apply H12. -Rewrite SubEqui_P6. -2:Apply lt_n_Sn. -Unfold max_N; 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 Rlt_anti_compatibility with (pos_Rl (SubEqui del H) I); Replace ``(pos_Rl (SubEqui del H) I)+(t-(pos_Rl (SubEqui del H) I))`` with t; [Idtac | Ring]; Replace ``(pos_Rl (SubEqui del H) I)+del`` with (pos_Rl (SubEqui del H) (S I)). -Assumption. -Repeat Rewrite SubEqui_P6. -Rewrite S_INR; Ring. -Assumption. -Apply le_lt_n_Sm; Assumption. -Apply Rge_minus; Apply Rle_sym1; Assumption. -Intros; Clear H0 H1 H4 phi H5 H6 t H7; Case (Req_EM t0 b); Intro. -Left; Assumption. -Right; Pose I := [j:nat]``a+(INR j)*del<=t0``; Assert H1 : (EX n:nat | (I n)). -Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Elim H8; Intros; Assumption. -Assert H4 : (Nbound I). -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 Rle_monotony_contra with (pos del). -Apply (cond_pos del). -Apply Rle_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_trans with t0; Unfold I in H4; Try Assumption; Apply Rle_trans with b; Try Assumption; Elim H8; Intros; Assumption. -Elim (Nzorn H1 H4); Intros N [H5 H6]; Assert H7 : (lt N (S (max_N del H))). -Unfold max_N; Case (maxN del H); Intros; Apply INR_lt; Apply Rlt_monotony_contra with (pos del). -Apply (cond_pos del). -Apply Rlt_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_lt_trans with t0; Unfold I in H5; Try Assumption; Elim a0; Intros; Apply Rlt_le_trans with b; Try Assumption; Elim H8; Intros. -Elim H11; Intro. -Assumption. -Elim H0; Assumption. -Exists N; Split. -Rewrite SubEqui_P5; Simpl; Assumption. -Unfold co_interval; Split. -Rewrite SubEqui_P6. -Apply H5. -Assumption. -Inversion H7. -Replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))). -Rewrite (SubEqui_P2 del H); Elim H8; Intros. -Elim H11; Intro. -Assumption. -Elim H0; Assumption. -Rewrite SubEqui_P5; Reflexivity. -Rewrite SubEqui_P6. -Case (total_order_Rle ``a+(INR (S N))*del`` t0); Intro. -Assert H11 := (H6 (S N) r); Elim (le_Sn_n ? H11). -Auto with real. -Apply le_lt_n_Sm; Assumption. +Lemma RiemannInt_P6 : + forall (f:R -> R) (a b:R), + a < b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. +intros; unfold Riemann_integrable in |- *; intro; + assert (H1 : 0 < eps / (2 * (b - a))). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rlt_Rminus; assumption ] ]. +assert (H2 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ]. +assert (H3 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ]. +elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4; + elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi; + split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); + split. +2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +2: rewrite Rmult_1_r; rewrite Rabs_right. +2: apply Rmult_lt_reg_l with 2. +2: prove_sup0. +2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). +2: discrR. +2: apply Rle_ge; left; apply Rmult_lt_0_compat. +2: apply (cond_pos eps). +2: apply Rinv_0_lt_compat; prove_sup0. +2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; + elim (Rlt_irrefl _ H). +2: discrR. +2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; + elim (Rlt_irrefl _ H). +intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *; + unfold fct_cte in |- *; + cut + (forall t:R, + a <= t <= b -> + t = b \/ + ( exists i : nat + | (i < pred (Rlength (SubEqui del H)))%nat /\ + co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) + t)). +intro; elim (H8 _ H7); intro. +rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; left; assumption. +elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10); + rewrite H11; left; apply H4. +assumption. +apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))). +assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9; + elim (lt_n_O _ H9). +unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right. +rewrite SubEqui_P5 in H9; simpl in H9; inversion H9. +apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)). +replace + (pos_Rl (SubEqui del H) (max_N del H) + + (t - pos_Rl (SubEqui del H) (max_N del H))) with t; + [ idtac | ring ]; apply Rlt_le_trans with b. +rewrite H14 in H12; + assert (H13 : S (max_N del H) = pred (Rlength (SubEqui del H))). +rewrite SubEqui_P5; reflexivity. +rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12. +rewrite SubEqui_P6. +2: apply lt_n_Sn. +unfold max_N in |- *; case (maxN del H); intros; elim a0; clear a0; + intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del); + [ assumption | rewrite S_INR; ring ]. +apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I); + replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t; + [ idtac | ring ]; + replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)). +assumption. +repeat rewrite SubEqui_P6. +rewrite S_INR; ring. +assumption. +apply le_lt_n_Sm; assumption. +apply Rge_minus; apply Rle_ge; assumption. +intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro. +left; assumption. +right; pose (I := fun j:nat => a + INR j * del <= t0); + assert (H1 : exists n : nat | I n). +exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8; + intros; assumption. +assert (H4 : Nbound I). +unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *; + case (maxN del H); intros; elim a0; clear a0; intros _ H5; + apply INR_le; apply Rmult_le_reg_l with (pos del). +apply (cond_pos del). +apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del); + apply Rle_trans with t0; unfold I in H4; try assumption; + apply Rle_trans with b; try assumption; elim H8; intros; + assumption. +elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat). +unfold max_N in |- *; case (maxN del H); intros; apply INR_lt; + apply Rmult_lt_reg_l with (pos del). +apply (cond_pos del). +apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del); + apply Rle_lt_trans with t0; unfold I in H5; try assumption; + elim a0; intros; apply Rlt_le_trans with b; try assumption; + elim H8; intros. +elim H11; intro. +assumption. +elim H0; assumption. +exists N; split. +rewrite SubEqui_P5; simpl in |- *; assumption. +unfold co_interval in |- *; split. +rewrite SubEqui_P6. +apply H5. +assumption. +inversion H7. +replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))). +rewrite (SubEqui_P2 del H); elim H8; intros. +elim H11; intro. +assumption. +elim H0; assumption. +rewrite SubEqui_P5; reflexivity. +rewrite SubEqui_P6. +case (Rle_dec (a + INR (S N) * del) t0); intro. +assert (H11 := H6 (S N) r); elim (le_Sn_n _ H11). +auto with real. +apply le_lt_n_Sm; assumption. Qed. -Lemma RiemannInt_P7 : (f:R->R;a:R) (Riemann_integrable f a a). -Unfold Riemann_integrable; Intro f; Intros; Split with (mkStepFun (StepFun_P4 a a (f a))); Split with (mkStepFun (StepFun_P4 a a R0)); Split. -Intros; Simpl; Unfold fct_cte; Replace t with a. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity. -Generalize H; Unfold Rmin Rmax; Case (total_order_Rle a a); Intros; Elim H0; Intros; Apply Rle_antisym; Assumption. -Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps). +Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a. +unfold Riemann_integrable in |- *; intro f; intros; + split with (mkStepFun (StepFun_P4 a a (f a))); + split with (mkStepFun (StepFun_P4 a a 0)); split. +intros; simpl in |- *; unfold fct_cte in |- *; replace t with a. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right; + reflexivity. +generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0; + intros; apply Rle_antisym; assumption. +rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps). Qed. -Lemma continuity_implies_RiemannInt : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b). -Intros; Case (total_order_T a b); Intro; [Elim s; Intro; [Apply RiemannInt_P6; Assumption | Rewrite b0; Apply RiemannInt_P7] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r))]. +Lemma continuity_implies_RiemannInt : + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. +intros; case (total_order_T a b); intro; + [ elim s; intro; + [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ] + | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ]. Qed. -Lemma RiemannInt_P8 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b a)) ``(RiemannInt pr1)==-(RiemannInt pr2)``. -Intro f; Intros; EApply UL_sequence. -Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; Apply u. -Unfold RiemannInt; Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; Cut (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``). -Cut (EXT psi2:nat->(StepFun b a) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (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; Intros; Assert H3 : ``0<eps/3``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Unfold Un_cv in H1; Elim (H1 ? H3); Clear H1; Intros N0 H1; Unfold R_dist in H1; Simpl in H1; Assert H4 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``. -Intros; Assert H5 := (H1 ? H4); Replace (pos (RinvN n)) with ``(Rabsolu (/((INR n)+1)-0))``; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_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; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``. -Rewrite <- (Rabsolu_Ropp ``(RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x``); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])- -x`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))+ -((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)``; [Apply Rabsolu_triang | Ring]. -Replace eps with ``2*eps/3+eps/3``. -Apply Rplus_lt. -Rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+ -(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(-1)*(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))``; [Idtac | Ring]; Rewrite <- StepFun_P30. -Case (total_order_Rle a b); Intro. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))). -Apply StepFun_P34; Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``. -Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring]. -Assert H7 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Assert H8 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Apply Rplus_le. -Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8. -Elim H6; Intros; Split; Left; Assumption. -Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8. -Elim H6; Intros; Split; Left; Assumption. -Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt. -Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]]. -Elim (H n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]]. -Assert Hyp : ``b<=a``. -Auto with real. -Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))). -Apply StepFun_P34; Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``. -Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring]. -Assert H7 : (Rmin a b)==b. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity]. -Assert H8 : (Rmax a b)==a. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity]. -Apply Rplus_le. -Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8. -Elim H6; Intros; Split; Left; Assumption. -Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8; Elim H6; Intros; Split; Left; Assumption. -Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt. -Elim (H0 n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | 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 (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | 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; Apply le_trans with (max N0 N1); [Apply le_max_r | Assumption]. -Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Rewrite Rmin_sym; Rewrite RmaxSym; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). +Lemma RiemannInt_P8 : + forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2. +intro f; intros; eapply UL_sequence. +unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); + intros; apply u. +unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv); + intros; + cut + ( exists psi1 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +cut + ( exists psi2 : nat -> StepFun b a + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0; + assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros; + assert (H3 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1; + unfold R_dist in H1; simpl in H1; + assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). +intros; assert (H5 := H1 _ H4); + replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0)); + [ assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. +clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1; + exists (max N0 N1); intros; unfold R_dist in |- *; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n)) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). +rewrite <- (Rabs_Ropp (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - - x) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) + + - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + [ apply Rabs_triang | ring ]. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); + replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))) + with + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + -1 * + RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))); + [ idtac | ring ]; rewrite <- StepFun_P30. +case (Rle_dec a b); intro. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) + (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). +replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with + (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); + [ apply Rabs_triang | ring ]. +assert (H7 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H8 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +apply Rplus_le_compat. +elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; + rewrite H7; rewrite H8. +elim H6; intros; split; left; assumption. +elim (H n); intros; apply H9; rewrite H7; rewrite H8. +elim H6; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +elim (H n); intros; + rewrite <- + (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))) + ; rewrite <- StepFun_P39; + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +assert (Hyp : b <= a). +auto with real. +rewrite StepFun_P39; rewrite Rabs_Ropp; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P6 + (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) + (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). +replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with + (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); + [ apply Rabs_triang | ring ]. +assert (H7 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +assert (H8 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. +apply Rplus_le_compat. +elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; + rewrite H7; rewrite H8. +elim H6; intros; split; left; assumption. +elim (H n); intros; apply H9; rewrite H7; rewrite H8; elim H6; intros; split; + left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +elim (H0 n); intros; + rewrite <- + (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))) + ; rewrite <- StepFun_P39; + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. +unfold R_dist in H1; apply H1; unfold ge in |- *; + apply le_trans with (max N0 N1); [ apply le_max_r | assumption ]. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + rewrite Rmin_comm; rewrite RmaxSym; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). Qed. -Lemma RiemannInt_P9 : (f:R->R;a:R;pr:(Riemann_integrable f a a)) ``(RiemannInt pr)==0``. -Intros; Assert H := (RiemannInt_P8 pr pr); Apply r_Rmult_mult with ``2``; [Rewrite Rmult_Or; Rewrite double; Pattern 2 (RiemannInt pr); Rewrite H; Apply Rplus_Ropp_r | DiscrR]. +Lemma RiemannInt_P9 : + forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0. +intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2; + [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *; + rewrite H; apply Rplus_opp_r + | discrR ]. Qed. -Lemma Req_EM_T :(r1,r2:R) (sumboolT (r1==r2) ``r1<>r2``). -Intros; Elim (total_order_T r1 r2);Intros; [Elim a;Intro; [Right; Red; Intro; Rewrite H in a0; Elim (Rlt_antirefl ``r2`` a0) | Left;Assumption] | Right; Red; Intro; Rewrite H in b; Elim (Rlt_antirefl ``r2`` b)]. +Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}. +intros; elim (total_order_T r1 r2); intros; + [ elim a; intro; + [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0) + | left; assumption ] + | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ]. Qed. (* L1([a,b]) is a vectorial space *) -Lemma RiemannInt_P10 : (f,g:R->R;a,b,l:R) (Riemann_integrable f a b) -> (Riemann_integrable g a b) -> (Riemann_integrable [x:R]``(f x)+l*(g x)`` a b). -Unfold Riemann_integrable; Intros f g; Intros; Case (Req_EM_T l R0); 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_Ol; Rewrite Rplus_Or; Apply H; Assumption. -Assert H : ``0<eps/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0]. -Assert H0 : ``0<eps/(2*(Rabsolu l))``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]]. -Elim (X (mkposreal ? H)); Intros; Elim (X0 (mkposreal ? H0)); Intros; Split with (mkStepFun (StepFun_P28 l x x0)); Elim p0; Elim p; Intros; Split with (mkStepFun (StepFun_P28 (Rabsolu l) x1 x2)); Elim p1; Elim p2; Clear p1 p2 p0 p X X0; Intros; Split. -Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-(x t)))+(Rabsolu (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 Rabsolu_triang | Ring]. -Apply Rplus_le; [Apply H3; Assumption | Rewrite Rabsolu_mult; Apply Rle_monotony; [Apply Rabsolu_pos | Apply H1; Assumption]]. -Rewrite StepFun_P30; Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF x1))+(Rabsolu ((Rabsolu l)*(RiemannInt_SF x2)))``. -Apply Rabsolu_triang. -Rewrite (double_var eps); Apply Rplus_lt. -Apply H4. -Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Apply Rlt_monotony_contra with ``/(Rabsolu l)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/2`` with ``eps/(2*(Rabsolu l))``; [Apply H2 | Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption]] | Apply Rabsolu_no_R0; Assumption]. +Lemma RiemannInt_P10 : + forall (f g:R -> R) (a b l:R), + Riemann_integrable f a b -> + Riemann_integrable g a b -> + Riemann_integrable (fun x:R => f x + l * g x) a b. +unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0); + intro. +elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0; + intros; split; try assumption; rewrite e; intros; + rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption. +assert (H : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +assert (H0 : 0 < eps / (2 * Rabs l)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. +elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros; + split with (mkStepFun (StepFun_P28 l x x0)); elim p0; + elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); + elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split. +intros; simpl in |- *; + apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))). +replace (f t + l * g t - (x t + l * x0 t)) with + (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ]. +apply Rplus_le_compat; + [ apply H3; assumption + | rewrite Rabs_mult; apply Rmult_le_compat_l; + [ apply Rabs_pos | apply H1; assumption ] ]. +rewrite StepFun_P30; + apply Rle_lt_trans with + (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply H4. +rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; + [ rewrite Rmult_1_l; + replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l)); + [ apply H2 + | unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ] ] + | apply Rabs_no_R0; assumption ]. Qed. -Lemma RiemannInt_P11 : (f:R->R;a,b,l:R;un:nat->posreal;phi1,phi2,psi1,psi2:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi1 n t)))<=(psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n)))<(un n)``) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi2 n t)))<=(psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n)))<(un n)``) -> (Un_cv [N:nat](RiemannInt_SF (phi1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi2 N)) l). -Unfold Un_cv; Intro f; Intros; Intros. -Case (total_order_Rle a b); Intro Hyp. -Assert H4 : ``0<eps/3``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H ? H4); Clear H; Intros N0 H. -Elim (H2 ? H4); Clear H2; Intros N1 H2. -Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist. -Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``. -Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring]. -Replace ``eps`` with ``2*eps/3+eps/3``. -Apply Rplus_lt. -Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring]. -Rewrite <- StepFun_P30. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n)))))). -Apply StepFun_P34; Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))). -Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l. -Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((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 Rabsolu_triang | Ring]. -Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7. -Assert H10 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Assert H11 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Assert H11 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption. -Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt. -Apply Rlt_trans with (pos (un n)). -Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))). -Apply Rle_Rabsolu. -Assumption. -Replace (pos (un n)) with (R_dist (un n) R0). -Apply H; Unfold ge; Apply le_trans with N; Try Assumption. -Unfold N; Apply le_max_l. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right. -Apply Rle_sym1; Left; Apply (cond_pos (un n)). -Apply Rlt_trans with (pos (un n)). -Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))). -Apply Rle_Rabsolu; Assumption. -Assumption. -Replace (pos (un n)) with (R_dist (un n) R0). -Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)). -Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r. -Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. -Assert H4 : ``0<eps/3``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H ? H4); Clear H; Intros N0 H. -Elim (H2 ? H4); Clear H2; Intros N1 H2. -Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist. -Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``. -Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring]. -Assert Hyp_b : ``b<=a``. -Auto with real. -Replace ``eps`` with ``2*eps/3+eps/3``. -Apply Rplus_lt. -Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring]. -Rewrite <- StepFun_P30. -Rewrite StepFun_P39. -Rewrite Rabsolu_Ropp. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n))))))))). -Apply StepFun_P34; Try Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n))))))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Rewrite Rmult_1l. -Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((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 Rabsolu_triang | Ring]. -Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7. -Assert H10 : (Rmin a b)==b. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity]. -Assert H11 : (Rmax a b)==a. -Unfold Rmax; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity]. -Assert H11 : (Rmax a b)==a. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity]. -Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption. -Rewrite <- (Ropp_Ropp (RiemannInt_SF - (mkStepFun - (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))))))). -Rewrite <- StepFun_P39. -Rewrite StepFun_P30. -Rewrite Rmult_1l; Rewrite double. -Rewrite Ropp_distr1; Apply Rplus_lt. -Apply Rlt_trans with (pos (un n)). -Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Assumption. -Replace (pos (un n)) with (R_dist (un n) R0). -Apply H; Unfold ge; Apply le_trans with N; Try Assumption. -Unfold N; Apply le_max_l. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right. -Apply Rle_sym1; Left; Apply (cond_pos (un n)). -Apply Rlt_trans with (pos (un n)). -Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption. -Assumption. -Replace (pos (un n)) with (R_dist (un n) R0). -Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)). -Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r. -Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. +Lemma RiemannInt_P11 : + forall (f:R -> R) (a b l:R) (un:nat -> posreal) + (phi1 phi2 psi1 psi2:nat -> StepFun a b), + Un_cv un 0 -> + (forall n:nat, + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < un n) -> + (forall n:nat, + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < un n) -> + Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l -> + Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l. +unfold Un_cv in |- *; intro f; intros; intros. +case (Rle_dec a b); intro Hyp. +assert (H4 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H4); clear H; intros N0 H. +elim (H2 _ H4); clear H2; intros N1 H2. +pose (N := max N0 N1); exists N; intros; unfold R_dist in |- *. +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + + Rabs (RiemannInt_SF (phi1 n) - l)). +replace (RiemannInt_SF (phi2 n) - l) with + (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + [ idtac | ring ]. +rewrite <- StepFun_P30. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n)))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))). +apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l. +apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). +replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); + [ apply Rabs_triang | ring ]. +rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. +assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. +apply Rlt_trans with (pos (un n)). +elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). +apply RRle_abs. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption. +unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right. +apply Rle_ge; left; apply (cond_pos (un n)). +apply Rlt_trans with (pos (un n)). +elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). +apply RRle_abs; assumption. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (un n)). +unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; + try assumption; unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +assert (H4 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H4); clear H; intros N0 H. +elim (H2 _ H4); clear H2; intros N1 H2. +pose (N := max N0 N1); exists N; intros; unfold R_dist in |- *. +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + + Rabs (RiemannInt_SF (phi1 n) - l)). +replace (RiemannInt_SF (phi2 n) - l) with + (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. +assert (Hyp_b : b <= a). +auto with real. +replace eps with (2 * (eps / 3) + eps / 3). +apply Rplus_lt_compat. +replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + [ idtac | ring ]. +rewrite <- StepFun_P30. +rewrite StepFun_P39. +rewrite Rabs_Ropp. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P6 + (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))). +apply StepFun_P34; try assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l. +apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). +replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); + [ apply Rabs_triang | ring ]. +rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. +assert (H10 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +assert (H11 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +assert (H11 : Rmax a b = a). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. +rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. +rewrite <- + (Ropp_involutive + (RiemannInt_SF + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))))))) + . +rewrite <- StepFun_P39. +rewrite StepFun_P30. +rewrite Rmult_1_l; rewrite double. +rewrite Ropp_plus_distr; apply Rplus_lt_compat. +apply Rlt_trans with (pos (un n)). +elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). +rewrite <- Rabs_Ropp; apply RRle_abs. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption. +unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right. +apply Rle_ge; left; apply (cond_pos (un n)). +apply Rlt_trans with (pos (un n)). +elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). +rewrite <- Rabs_Ropp; apply RRle_abs; assumption. +assumption. +replace (pos (un n)) with (R_dist (un n) 0). +apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_l. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (un n)). +unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; + try assumption; unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. -Lemma RiemannInt_P12 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``a<=b`` -> ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``. -Intro f; Intros; Case (Req_EM l R0); Intro. -Pattern 2 l; Rewrite H0; Rewrite Rmult_Ol; Rewrite Rplus_Or; Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Pose psi1 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Pose psi2 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; [Apply RinvN_cv | Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)) | Intro; Assert H1 : ((t:R) ``(Rmin a b) <= t``/\``t <= (Rmax a b)`` -> (Rle (Rabsolu (Rminus ``(f t)+l*(g t)`` (phi_sequence RinvN pr3 n t))) (psi2 n t))) /\ ``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``; [Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)) | Elim H1; Intros; Split; Try Assumption; Intros; Replace (f t) with ``(f t)+l*(g t)``; [Apply H2; Assumption | Rewrite H0; Ring]] | Assumption]]. -EApply UL_sequence. -Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Intros; Apply u. -Unfold Un_cv; Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Unfold Un_cv; Intros; Assert H2 : ``0<eps/5``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; 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*(Rabsolu l))``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]]. -Elim (u ? H5); Clear u; Intros N2 H6; Assert H7 := RinvN_cv; Unfold Un_cv in H7; Elim (H7 ? H5); Clear H7 H5; Intros N3 H5; Unfold R_dist in H3 H4 H5 H6; Pose N := (max (max N0 N1) (max N2 N3)). -Assert H7 : (n:nat) (ge n N1)->``(RinvN n)< eps/5``. -Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H4; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))]. -Clear H4; Assert H4 := H7; Clear H7; Assert H7 : (n:nat) (ge n N3)->``(RinvN n)< eps/(5*(Rabsolu l))``. -Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H5; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))]. -Clear H5; Assert H5 := H7; Clear H7; Exists N; Intros; Unfold R_dist. -Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0))+(Rabsolu l)*(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``. -Apply Rle_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)))``. -Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x0+l*x)`` with ``(((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring]. -Rewrite Rplus_assoc; Apply Rle_compatibility; Rewrite <- Rabsolu_mult; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+(l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring]. -Replace eps with ``3*eps/5+eps/5+eps/5``. -Repeat Apply Rplus_lt. -Assert H7 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n0)). -Assert H8 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n0)). -Assert H9 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu (((f t)+l*(g t))-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n0)). -Elim H7; Clear H7; Intros psi1 H7; Elim H8; Clear H8; Intros psi2 H8; Elim H9; Clear H9; Intros psi3 H9; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])+(-1)*((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))``; [Idtac | Ring]; Do 2 Rewrite <- StepFun_P30; Assert H10 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Assert H11 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Rewrite H10 in H7; Rewrite H10 in H8; Rewrite H10 in H9; Rewrite H11 in H7; Rewrite H11 in H8; Rewrite H11 in H9; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr3 n) (mkStepFun (StepFun_P28 l (phi_sequence RinvN pr1 n) (phi_sequence RinvN pr2 n)))))))). -Apply StepFun_P34; Assumption. -Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi3 n) (mkStepFun (StepFun_P28 (Rabsolu l) (psi1 n) (psi2 n)))))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Rewrite Rmult_1l. -Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1))))+(Rabsolu (((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))``. -Replace ``([(phi_sequence RinvN pr3 n)] x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))`` with ``(([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1)))+(((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1)))``; [Apply Rabsolu_triang | Ring]. -Rewrite Rplus_assoc; Apply Rplus_le. -Elim (H9 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H13. -Elim H12; Intros; Split; Left; Assumption. -Apply Rle_trans with ``(Rabsolu ((f x1)-([(phi_sequence RinvN pr1 n)] x1)))+(Rabsolu l)*(Rabsolu ((g x1)-([(phi_sequence RinvN pr2 n)] x1)))``. -Rewrite <- Rabsolu_mult; Replace ``((f x1)+(l*(g x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))`` with ``((f x1)-([(phi_sequence RinvN pr1 n)] x1))+l*((g x1)-([(phi_sequence RinvN pr2 n)] x1))``; [Apply Rabsolu_triang | Ring]. -Apply Rplus_le. -Elim (H7 n); Intros; Apply H13. -Elim H12; Intros; Split; Left; Assumption. -Apply Rle_monotony; [Apply Rabsolu_pos | Elim (H8 n); Intros; Apply H13; Elim H12; Intros; Split; Left; Assumption]. -Do 2 Rewrite StepFun_P30; Rewrite Rmult_1l; Replace ``3*eps/5`` with ``eps/5+(eps/5+eps/5)``; [Repeat Apply Rplus_lt | Ring]. -Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))); [Apply Rle_Rabsolu | Elim (H9 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]]. -Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Elim (H7 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]]. -Apply Rlt_monotony_contra with ``/(Rabsolu l)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``. -Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Elim (H8 n); Intros; Assumption] | Apply H5; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N2 N3); [Apply le_max_r | Unfold N; Apply le_max_r] | Assumption]]. -Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption]. -Apply Rabsolu_no_R0; Assumption. -Apply H3; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption]]. -Apply Rlt_monotony_contra with ``/(Rabsolu l)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``. -Apply H6; Unfold ge; Apply le_trans with (max N2 N3); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption]]. -Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption]. -Apply Rabsolu_no_R0; Assumption. -Apply r_Rmult_mult with ``5``; [Unfold Rdiv; Do 2 Rewrite Rmult_Rplus_distr; Do 3 Rewrite (Rmult_sym ``5``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. +Lemma RiemannInt_P12 : + forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b) + (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), + a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. +intro f; intros; case (Req_dec l 0); intro. +pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; + unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; + eapply UL_sequence; + [ apply u0 + | pose (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); + pose (psi2 := fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); + apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; + [ apply RinvN_cv + | intro; apply (projT2 (phi_sequence_prop RinvN pr1 n)) + | intro; + assert + (H1 : + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n); + [ apply (projT2 (phi_sequence_prop RinvN pr3 n)) + | elim H1; intros; split; try assumption; intros; + replace (f t) with (f t + l * g t); + [ apply H2; assumption | rewrite H0; ring ] ] + | assumption ] ]. +eapply UL_sequence. +unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + intros; apply u. +unfold Un_cv in |- *; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; + intros; assert (H2 : 0 < eps / 5). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv); + unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4; + assert (H5 : 0 < eps / (5 * Rabs l)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. +elim (u _ H5); clear u; intros N2 H6; assert (H7 := RinvN_cv); + unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5; + unfold R_dist in H3, H4, H5, H6; pose (N := max (max N0 N1) (max N2 N3)). +assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5). +intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); + [ unfold RinvN in |- *; apply H4; assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. +clear H4; assert (H4 := H7); clear H7; + assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)). +intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); + [ unfold RinvN in |- *; apply H5; assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. +clear H5; assert (H5 := H7); clear H7; exists N; intros; + unfold R_dist in |- *. +apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) + + Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). +apply Rle_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))). +replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x0 + l * x)) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n)) + + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))); + [ apply Rabs_triang | ring ]. +rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_mult; + replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + [ apply Rabs_triang | ring ]. +replace eps with (3 * (eps / 5) + eps / 5 + eps / 5). +repeat apply Rplus_lt_compat. +assert + (H7 : + exists psi1 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n0)). +assert + (H8 : + exists psi2 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n0)). +assert + (H9 : + exists psi3 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr3 n0)). +elim H7; clear H7; intros psi1 H7; elim H8; clear H8; intros psi2 H8; elim H9; + clear H9; intros psi3 H9; + replace + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) + + -1 * + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))); + [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +assert (H11 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7; + rewrite H11 in H8; rewrite H11 in H9; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence RinvN pr3 n) + (mkStepFun + (StepFun_P28 l (phi_sequence RinvN pr1 n) + (phi_sequence RinvN pr2 n)))))))). +apply StepFun_P34; assumption. +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (psi3 n) + (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l. +apply Rle_trans with + (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) + + Rabs + (f x1 + l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))). +replace + (phi_sequence RinvN pr3 n x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)) with + (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1) + + (f x1 + l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))); + [ apply Rabs_triang | ring ]. +rewrite Rplus_assoc; apply Rplus_le_compat. +elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; + apply H13. +elim H12; intros; split; left; assumption. +apply Rle_trans with + (Rabs (f x1 - phi_sequence RinvN pr1 n x1) + + Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)). +rewrite <- Rabs_mult; + replace + (f x1 + + (l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))) + with + (f x1 - phi_sequence RinvN pr1 n x1 + + l * (g x1 - phi_sequence RinvN pr2 n x1)); [ apply Rabs_triang | ring ]. +apply Rplus_le_compat. +elim (H7 n); intros; apply H13. +elim H12; intros; split; left; assumption. +apply Rmult_le_compat_l; + [ apply Rabs_pos + | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ]. +do 2 rewrite StepFun_P30; rewrite Rmult_1_l; + replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5)); + [ repeat apply Rplus_lt_compat | ring ]. +apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))); + [ apply RRle_abs | elim (H9 n); intros; assumption ] + | apply H4; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N0 N1); + [ apply le_max_r | unfold N in |- *; apply le_max_l ] + | assumption ] ]. +apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ apply RRle_abs | elim (H7 n); intros; assumption ] + | apply H4; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N0 N1); + [ apply le_max_r | unfold N in |- *; apply le_max_l ] + | assumption ] ]. +apply Rmult_lt_reg_l with (/ Rabs l). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). +apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ apply RRle_abs | elim (H8 n); intros; assumption ] + | apply H5; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N2 N3); + [ apply le_max_r | unfold N in |- *; apply le_max_r ] + | assumption ] ]. +unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ]. +apply Rabs_no_R0; assumption. +apply H3; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l + | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ]. +apply Rmult_lt_reg_l with (/ Rabs l). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). +apply H6; unfold ge in |- *; apply le_trans with (max N2 N3); + [ apply le_max_l + | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ]. +unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ]. +apply Rabs_no_R0; assumption. +apply Rmult_eq_reg_l with 5; + [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l; + do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. -Lemma RiemannInt_P13 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``. -Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P12; Assumption | Assert H : ``b<=a``; [Auto with real | Replace (RiemannInt pr3) with (Ropp (RiemannInt (RiemannInt_P1 pr3))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr2) with (Ropp (RiemannInt (RiemannInt_P1 pr2))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr1) with (Ropp (RiemannInt (RiemannInt_P1 pr1))); [Idtac | Symmetry; Apply RiemannInt_P8]; Rewrite (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) (RiemannInt_P1 pr3) H); Ring]]. +Lemma RiemannInt_P13 : + forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b) + (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), + RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. +intros; case (Rle_dec a b); intro; + [ apply RiemannInt_P12; assumption + | assert (H : b <= a); + [ auto with real + | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + rewrite + (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) + (RiemannInt_P1 pr3) H); ring ] ]. Qed. -Lemma RiemannInt_P14 : (a,b,c:R) (Riemann_integrable (fct_cte c) a b). -Unfold Riemann_integrable; Intros; Split with (mkStepFun (StepFun_P4 a b c)); Split with (mkStepFun (StepFun_P4 a b R0)); Split; [Intros; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity | Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps)]. +Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b. +unfold Riemann_integrable in |- *; intros; + split with (mkStepFun (StepFun_P4 a b c)); + split with (mkStepFun (StepFun_P4 a b 0)); split; + [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; unfold fct_cte in |- *; right; + reflexivity + | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + apply (cond_pos eps) ]. Qed. -Lemma RiemannInt_P15 : (a,b,c:R;pr:(Riemann_integrable (fct_cte c) a b)) ``(RiemannInt pr)==c*(b-a)``. -Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!(fct_cte c) 2!a 3!b pr 5!RinvN RinvN_cv); Intros; EApply UL_sequence. -Apply u. -Pose phi1 := [N:nat](phi_sequence RinvN 2!(fct_cte c) 3!a 4!b pr N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) ``c*(b-a)``); Pose f := (fct_cte c); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr n)). -Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [n:nat](mkStepFun (StepFun_P4 a b c)); Pose psi2 := [n:nat](mkStepFun (StepFun_P4 a b R0)); Apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; Try Assumption. -Apply RinvN_cv. -Intro; Split. -Intros; Unfold f; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity. -Unfold psi2; Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos (RinvN n)). -Unfold Un_cv; Intros; Split with O; Intros; Unfold R_dist; Unfold phi2; Rewrite StepFun_P18; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H. +Lemma RiemannInt_P15 : + forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b), + RiemannInt pr = c * (b - a). +intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv); + intros; eapply UL_sequence. +apply u. +pose (phi1 := fun N:nat => phi_sequence RinvN pr N); + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *; + pose (f := fct_cte c); + assert + (H1 : + exists psi1 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr n)). +elim H1; clear H1; intros psi1 H1; + pose (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c)); + pose (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0)); + apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; + try assumption. +apply RinvN_cv. +intro; split. +intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; + right; reflexivity. +unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + apply (cond_pos (RinvN n)). +unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *; + unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; apply H. Qed. -Lemma RiemannInt_P16 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable [x:R](Rabsolu (f x)) a b). -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; Apply Rle_trans with ``(Rabsolu ((f t)-(phi t)))``; [Apply Rabsolu_triang_inv2 | Apply H; Assumption]. +Lemma RiemannInt_P16 : + forall (f:R -> R) (a b:R), + Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b. +unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X; + intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi)); + split with psi; split; try assumption; intros; simpl in |- *; + apply Rle_trans with (Rabs (f t - phi t)); + [ apply Rabs_triang_inv2 | apply H; assumption ]. Qed. -Lemma Rle_cv_lim : (Un,Vn:nat->R;l1,l2:R) ((n:nat)``(Un n)<=(Vn n)``) -> (Un_cv Un l1) -> (Un_cv Vn l2) -> ``l1<=l2``. -Intros; Case (total_order_Rle l1 l2); Intro. -Assumption. -Assert H2 : ``l2<l1``. -Auto with real. -Clear n; Assert H3 : ``0<(l1-l2)/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rlt_Rminus; Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H1 ? H3); Elim (H0 ? H3); Clear H0 H1; Unfold R_dist; Intros; Pose N := (max x x0); Cut ``(Vn N)<(Un N)``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (H N) H4)). -Apply Rlt_trans with ``(l1+l2)/2``. -Apply Rlt_anti_compatibility with ``-l2``; Replace ``-l2+(l1+l2)/2`` with ``(l1-l2)/2``. -Rewrite Rplus_sym; Apply Rle_lt_trans with ``(Rabsolu ((Vn N)-l2))``. -Apply Rle_Rabsolu. -Apply H1; Unfold ge; Unfold N; Apply le_max_r. -Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``-l2`` ``(l1+l2)*/2`` ``2``); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR]. -Apply Ropp_Rlt; Apply Rlt_anti_compatibility with l1; Replace ``l1+ -((l1+l2)/2)`` with ``(l1-l2)/2``. -Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l1))``. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu. -Apply H0; Unfold ge; Unfold N; Apply le_max_l. -Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``l1`` ``-((l1+l2)*/2)`` ``2``); Rewrite <- Ropp_mul1; Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR]. +Lemma Rle_cv_lim : + forall (Un Vn:nat -> R) (l1 l2:R), + (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2. +intros; case (Rle_dec l1 l2); intro. +assumption. +assert (H2 : l2 < l1). +auto with real. +clear n; assert (H3 : 0 < (l1 - l2) / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros; + pose (N := max x x0); cut (Vn N < Un N). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)). +apply Rlt_trans with ((l1 + l2) / 2). +apply Rplus_lt_reg_r with (- l2); + replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2). +rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)). +apply RRle_abs. +apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r. +apply Rmult_eq_reg_l with 2; + [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ ring | discrR ] + | discrR ]. +apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1; + replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2). +apply Rle_lt_trans with (Rabs (Un N - l1)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l. +apply Rmult_eq_reg_l with 2; + [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2); + rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. -Lemma RiemannInt_P17 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable [x:R](Rabsolu (f x)) a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt pr1))<=(RiemannInt pr2)``. -Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!([x0:R](Rabsolu (f x0))) 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; Pose phi1 := (phi_sequence RinvN pr1); Pose phi2 := [N:nat](mkStepFun (StepFun_P32 (phi1 N))); Apply Rle_cv_lim with [N:nat](Rabsolu (RiemannInt_SF (phi1 N))) [N:nat](RiemannInt_SF (phi2 N)). -Intro; Unfold phi2; Apply StepFun_P34; Assumption. -Fold phi1 in u0; Apply (continuity_seq Rabsolu [N:nat](RiemannInt_SF (phi1 N)) x0); Try Assumption. -Apply continuity_Rabsolu. -Pose phi3 := (phi_sequence RinvN pr2); Assert H0 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi3 n) t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). -Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``). -Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). -Elim H1; Clear H1; Intros psi2 H1; Split with psi2; Intros; Elim (H1 n); Clear H1; Intros; Split; Try Assumption. -Intros; Unfold phi2; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-((phi1 n) t)))``. -Apply Rabsolu_triang_inv2. -Apply H1; Assumption. -Elim H0; Clear H0; Intros psi3 H0; Elim H1; Clear H1; Intros psi2 H1; Apply RiemannInt_P11 with [x:R](Rabsolu (f x)) RinvN phi3 psi3 psi2; Try Assumption; Apply RinvN_cv. +Lemma RiemannInt_P17 : + forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b), + a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2. +intro f; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + pose (phi1 := phi_sequence RinvN pr1); + pose (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N))); + apply Rle_cv_lim with + (fun N:nat => Rabs (RiemannInt_SF (phi1 N))) + (fun N:nat => RiemannInt_SF (phi2 N)). +intro; unfold phi2 in |- *; apply StepFun_P34; assumption. +fold phi1 in u0; + apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0); + try assumption. +apply Rcontinuity_abs. +pose (phi3 := phi_sequence RinvN pr2); + assert + (H0 : + exists psi3 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +assert + (H1 : + exists psi2 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +assert + (H1 : + exists psi2 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n); + clear H1; intros; split; try assumption. +intros; unfold phi2 in |- *; simpl in |- *; + apply Rle_trans with (Rabs (f t - phi1 n t)). +apply Rabs_triang_inv2. +apply H1; assumption. +elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1; + apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2; + try assumption; apply RinvN_cv. Qed. -Lemma RiemannInt_P18 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)==(g x)``) -> ``(RiemannInt pr1)==(RiemannInt pr2)``. -Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!g 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence. -Apply u0. -Pose phi1 := [N:nat](phi_sequence RinvN 2!f 3!a 4!b pr1 N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) x); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). -Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [N:nat](phi_sequence RinvN 2!g 3!a 4!b pr2 N). -Pose phi2_aux := [N:nat][x:R](Cases (Req_EM_T x a) of - | (leftT _) => (f a) - | (rightT _) => (Cases (Req_EM_T x b) of - | (leftT _) => (f b) - | (rightT _) => (phi2 N x) end) end). -Cut (N:nat)(IsStepFun (phi2_aux N) a b). -Intro; Pose phi2_m := [N:nat](mkStepFun (X N)). -Assert H2 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). -Elim H2; Clear H2; Intros psi2 H2; Apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; Try Assumption. -Apply RinvN_cv. -Intro; Elim (H2 n); Intros; Split; Try Assumption. -Intros; Unfold phi2_m; Simpl; Unfold phi2_aux; Case (Req_EM_T t a); Case (Req_EM_T t b); Intros. -Rewrite e0; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``. -Apply Rabsolu_pos. -Pattern 3 a; Rewrite <- e0; Apply H3; Assumption. -Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``. -Apply Rabsolu_pos. -Pattern 3 a; Rewrite <- e; Apply H3; Assumption. -Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``. -Apply Rabsolu_pos. -Pattern 3 b; Rewrite <- e; Apply H3; Assumption. -Replace (f t) with (g t). -Apply H3; Assumption. -Symmetry; Apply H0; Elim H5; Clear H5; Intros. -Assert H7 : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption]. -Assert H8 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption]. -Rewrite H7 in H5; Rewrite H8 in H6; Split. -Elim H5; Intro; [Assumption | Elim n1; Symmetry; Assumption]. -Elim H6; Intro; [Assumption | Elim n0; Assumption]. -Cut (N:nat)(RiemannInt_SF (phi2_m N))==(RiemannInt_SF (phi2 N)). -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; 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_antirefl ? H4). -Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4). -Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5). -Right; Reflexivity. -Apply StepFun_P37; Try Assumption. -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_antirefl ? H4). -Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4). -Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5). -Right; Reflexivity. -Intro; Assert H2 := (pre (phi2 N)); Unfold IsStepFun in H2; Unfold is_subdivision in H2; Elim H2; Clear H2; Intros l [lf H2]; Split with l; Split with lf; Unfold adapted_couple in H2; Decompose [and] H2; Clear H2; Unfold adapted_couple; Repeat Split; Try Assumption. -Intros; Assert H9 := (H8 i H2); Unfold constant_D_eq open_interval in H9; 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. -Assumption. -Apply le_O_n. -Apply lt_trans with (pred (Rlength l)); [Assumption | Apply lt_pred_n_n]. -Apply neq_O_lt; Intro; Rewrite <- H12 in H6; Discriminate. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert H11 : ``(pos_Rl l (S i))<=b``. -Replace b with (Rmax a b). -Rewrite <- H4; Elim (RList_P6 l); Intros; Apply H11. -Assumption. -Apply lt_le_S; Assumption. -Apply lt_pred_n_n; Apply neq_O_lt; Intro; Rewrite <- H13 in H6; Discriminate. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -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_antirefl ? (Rle_lt_trans ? ? ? H11 H12)). -Rewrite e in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H7)). -Rewrite e in H12; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H12)). -Reflexivity. +Lemma RiemannInt_P18 : + forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b), + a <= b -> + (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2. +intro f; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + eapply UL_sequence. +apply u0. +pose (phi1 := fun N:nat => phi_sequence RinvN pr1 N); + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *; + assert + (H1 : + exists psi1 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +elim H1; clear H1; intros psi1 H1; + pose (phi2 := fun N:nat => phi_sequence RinvN pr2 N). +pose + (phi2_aux := + fun (N:nat) (x:R) => + match Req_EM_T x a with + | left _ => f a + | right _ => + match Req_EM_T x b with + | left _ => f b + | right _ => phi2 N x + end + end). +cut (forall N:nat, IsStepFun (phi2_aux N) a b). +intro; pose (phi2_m := fun N:nat => mkStepFun (X N)). +assert + (H2 : + exists psi2 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +elim H2; clear H2; intros psi2 H2; + apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; + try assumption. +apply RinvN_cv. +intro; elim (H2 n); intros; split; try assumption. +intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T t a); case (Req_EM_T t b); intros. +rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). +apply Rabs_pos. +pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption. +rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). +apply Rabs_pos. +pattern a at 3 in |- *; rewrite <- e; apply H3; assumption. +rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). +apply Rabs_pos. +pattern b at 3 in |- *; rewrite <- e; apply H3; assumption. +replace (f t) with (g t). +apply H3; assumption. +symmetry in |- *; apply H0; elim H5; clear H5; intros. +assert (H7 : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n2; assumption ]. +assert (H8 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n2; assumption ]. +rewrite H7 in H5; rewrite H8 in H6; split. +elim H5; intro; [ assumption | elim n1; symmetry in |- *; assumption ]. +elim H6; intro; [ assumption | elim n0; assumption ]. +cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)). +intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros; + rewrite (H3 n); apply H5; assumption. +intro; apply Rle_antisym. +apply StepFun_P37; try assumption. +intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. +elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). +right; reflexivity. +apply StepFun_P37; try assumption. +intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. +elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). +elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). +right; reflexivity. +intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2; + unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2]; + split with l; split with lf; unfold adapted_couple in H2; + decompose [and] H2; clear H2; unfold adapted_couple in |- *; + repeat split; try assumption. +intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9; + unfold constant_D_eq, open_interval in |- *; intros; + rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i). +replace a with (Rmin a b). +rewrite <- H5; elim (RList_P6 l); intros; apply H10. +assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ]. +apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H11 : pos_Rl l (S i) <= b). +replace b with (Rmax a b). +rewrite <- H4; elim (RList_P6 l); intros; apply H11. +assumption. +apply lt_le_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a); + case (Req_EM_T x1 b); intros. +rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). +rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)). +rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). +reflexivity. Qed. -Lemma RiemannInt_P19 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt pr1)<=(RiemannInt pr2)``. -Intro f; Intros; Apply Rle_anti_compatibility with ``-(RiemannInt pr1)``; Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1))). -Apply Rabsolu_pos. -Replace ``(RiemannInt pr2)+ -(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))). -Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` pr2 pr1) (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))); Assumption. -Replace ``(RiemannInt pr2)+-(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1)). -Apply RiemannInt_P18; Try Assumption. -Intros; Apply Rabsolu_right. -Apply Rle_sym1; Apply Rle_anti_compatibility with (f x); Rewrite Rplus_Or; Replace ``(f x)+((g x)+ -1*(f x))`` with (g x); [Apply H0; Assumption | Ring]. -Rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 ``-1`` pr2 pr1)); [Ring | Assumption]. +Lemma RiemannInt_P19 : + forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b), + a <= b -> + (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2. +intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1); + rewrite Rplus_opp_l; rewrite Rplus_comm; + apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))). +apply Rabs_pos. +replace (RiemannInt pr2 + - RiemannInt pr1) with + (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))). +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1) + (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); + assumption. +replace (RiemannInt pr2 + - RiemannInt pr1) with + (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)). +apply RiemannInt_P18; try assumption. +intros; apply Rabs_right. +apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r; + replace (f x + (g x + -1 * f x)) with (g x); [ apply H0; assumption | ring ]. +rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 (-1) pr2 pr1)); + [ ring | assumption ]. Qed. -Lemma FTC_P1 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x)). -Intros; Apply continuity_implies_RiemannInt; [Assumption | Intros; Apply H0; Elim H3; Intros; Split; Assumption Orelse Apply Rle_trans with x; Assumption]. +Lemma FTC_P1 : + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall x:R, a <= x -> x <= b -> Riemann_integrable f a x. +intros; apply continuity_implies_RiemannInt; + [ assumption + | intros; apply H0; elim H3; intros; split; + assumption || apply Rle_trans with x; assumption ]. Qed. -V7only [Notation FTC_P2 := Rle_refl.]. - -Definition primitive [f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x))] : R->R := [x:R] Cases (total_order_Rle a x) of - | (leftT r) => Cases (total_order_Rle x b) of - | (leftT r0) => (RiemannInt (pr x r r0)) - | (rightT _) => ``(f b)*(x-b)+(RiemannInt (pr b h (FTC_P2 b)))`` end - | (rightT _) => ``(f a)*(x-a)`` end. - -Lemma RiemannInt_P20 : (f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x));pr0:(Riemann_integrable f a b)) ``(RiemannInt pr0)==(primitive h pr b)-(primitive h pr a)``. -Intros; Replace (primitive h pr a) with R0. -Replace (RiemannInt pr0) with (primitive h pr b). -Ring. -Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Assumption | Elim n0; Assumption]. -Symmetry; Unfold primitive; Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; [Apply RiemannInt_P9 | Elim n; Assumption | Elim n; Right; Reflexivity | Elim n0; Right; Reflexivity]. + +Definition primitive (f:R -> R) (a b:R) (h:a <= b) + (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) + (x:R) : R := + match Rle_dec a x with + | left r => + match Rle_dec x b with + | left r0 => RiemannInt (pr x r r0) + | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b)) + end + | right _ => f a * (x - a) + end. + +Lemma RiemannInt_P20 : + forall (f:R -> R) (a b:R) (h:a <= b) + (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) + (pr0:Riemann_integrable f a b), + RiemannInt pr0 = primitive h pr b - primitive h pr a. +intros; replace (primitive h pr a) with 0. +replace (RiemannInt pr0) with (primitive h pr b). +ring. +unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros; + [ apply RiemannInt_P5 + | elim n; right; reflexivity + | elim n; assumption + | elim n0; assumption ]. +symmetry in |- *; unfold primitive in |- *; case (Rle_dec a a); + case (Rle_dec a b); intros; + [ apply RiemannInt_P9 + | elim n; assumption + | elim n; right; reflexivity + | elim n0; right; reflexivity ]. Qed. -Lemma RiemannInt_P21 : (f:R->R;a,b,c:R) ``a<=b``-> ``b<=c`` -> (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c). -Unfold Riemann_integrable; Intros f a b c Hyp1 Hyp2 X X0 eps. -Assert H : ``0<eps/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0]. -Elim (X (mkposreal ? H)); Clear X; Intros phi1 [psi1 H1]; Elim (X0 (mkposreal ? H)); Clear X0; Intros phi2 [psi2 H2]. -Pose phi3 := [x:R] Cases (total_order_Rle a x) of - | (leftT _) => Cases (total_order_Rle x b) of - | (leftT _) => (phi1 x) - | (rightT _) => (phi2 x) end - | (rightT _) => R0 end. -Pose psi3 := [x:R] Cases (total_order_Rle a x) of - | (leftT _) => Cases (total_order_Rle x b) of - | (leftT _) => (psi1 x) - | (rightT _) => (psi2 x) end - | (rightT _) => R0 end. -Cut (IsStepFun phi3 a c). -Intro; Cut (IsStepFun psi3 a b). -Intro; Cut (IsStepFun psi3 b c). -Intro; Cut (IsStepFun psi3 a c). -Intro; Split with (mkStepFun X); Split with (mkStepFun X2); Simpl; Split. -Intros; Unfold phi3 psi3; Case (total_order_Rle t b); Case (total_order_Rle a t); Intros. -Elim H1; Intros; Apply H3. -Replace (Rmin a b) with a. -Replace (Rmax a b) with b. -Split; Assumption. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Elim n; Replace a with (Rmin a c). -Elim H0; Intros; Assumption. -Unfold Rmin; Case (total_order_Rle 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; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption]. -Unfold Rmax; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; Try (Elim n0; Assumption Orelse Elim n0; Apply Rle_trans with b; Assumption). -Reflexivity. -Elim n; Replace a with (Rmin a c). -Elim H0; Intros; Assumption. -Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n1; Apply Rle_trans with b; Assumption]. -Rewrite <- (StepFun_P43 X0 X1 X2). -Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun X0)))+(Rabsolu (RiemannInt_SF (mkStepFun X1)))``. -Apply Rabsolu_triang. -Rewrite (double_var eps); Replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1). -Replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2). -Apply Rplus_lt. -Elim H1; Intros; Assumption. -Elim H2; Intros; Assumption. -Apply Rle_antisym. -Apply StepFun_P37; Try Assumption. -Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (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; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H0)) | Right; Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]]. -Apply Rle_antisym. -Apply StepFun_P37; Try Assumption. -Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption]. -Apply StepFun_P37; Try Assumption. -Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption]. -Apply StepFun_P46 with b; Assumption. -Assert H3 := (pre psi2); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption. -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; 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; Intro; Rewrite <- H12 in H6; Discriminate. -Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption]. -Elim H7; Intros; Assumption. -Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]]. -Assert H3 := (pre psi1); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption. -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; 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; Intro; Rewrite <- H12 in H6; Discriminate. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert H11 : ``a<=x``. -Apply Rle_trans with (pos_Rl l1 i). -Replace a with (Rmin a b). -Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H11; Try Assumption. -Apply le_O_n. -Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H6; Discriminate. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Left; Elim H7; Intros; Assumption. -Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse Elim n; Assumption. -Apply StepFun_P46 with b. -Assert H3 := (pre phi1); Unfold IsStepFun in H3; Unfold is_subdivision in H3; Elim H3; Clear H3; Intros l1 [lf1 H3]; Split with l1; Split with lf1; Unfold adapted_couple in H3; Decompose [and] H3; Clear H3; Unfold adapted_couple; Repeat Split; Try Assumption. -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; 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; Intro; Rewrite <- H12 in H6; Discriminate. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert H11 : ``a<=x``. -Apply Rle_trans with (pos_Rl l1 i). -Replace a with (Rmin a b). -Rewrite <- H5; Elim (RList_P6 l1); Intros; Apply H11; Try Assumption. -Apply le_O_n. -Apply lt_trans with (pred (Rlength l1)); Try Assumption; Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H6; Discriminate. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Left; Elim H7; Intros; Assumption. -Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse 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; Repeat Split; Try Assumption. -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; 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; Intro; Rewrite <- H12 in H6; Discriminate. -Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption]. -Elim H7; Intros; Assumption. -Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]]. +Lemma RiemannInt_P21 : + forall (f:R -> R) (a b c:R), + a <= b -> + b <= c -> + Riemann_integrable f a b -> + Riemann_integrable f b c -> Riemann_integrable f a c. +unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps. +assert (H : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1]; + elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2]. +pose + (phi3 := + fun x:R => + match Rle_dec a x with + | left _ => + match Rle_dec x b with + | left _ => phi1 x + | right _ => phi2 x + end + | right _ => 0 + end). +pose + (psi3 := + fun x:R => + match Rle_dec a x with + | left _ => + match Rle_dec x b with + | left _ => psi1 x + | right _ => psi2 x + end + | right _ => 0 + end). +cut (IsStepFun phi3 a c). +intro; cut (IsStepFun psi3 a b). +intro; cut (IsStepFun psi3 b c). +intro; cut (IsStepFun psi3 a c). +intro; split with (mkStepFun X); split with (mkStepFun X2); simpl in |- *; + split. +intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t); + intros. +elim H1; intros; apply H3. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +split; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim n; replace a with (Rmin a c). +elim H0; intros; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +elim H2; intros; apply H3. +replace (Rmax b c) with (Rmax a c). +elim H0; intros; split; try assumption. +replace (Rmin b c) with b. +auto with real. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. +unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros; + try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption). +reflexivity. +elim n; replace a with (Rmin a c). +elim H0; intros; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n1; apply Rle_trans with b; assumption ]. +rewrite <- (StepFun_P43 X0 X1 X2). +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))). +apply Rabs_triang. +rewrite (double_var eps); + replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1). +replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2). +apply Rplus_lt_compat. +elim H1; intros; assumption. +elim H2; intros; assumption. +apply Rle_antisym. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) + | right; reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) + | right; reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +apply Rle_antisym. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ right; reflexivity + | elim n; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +apply StepFun_P37; try assumption. +simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ right; reflexivity + | elim n; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +apply StepFun_P46 with b; assumption. +assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). +apply Rle_lt_trans with (pos_Rl l1 i). +replace b with (Rmin b c). +rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n; assumption ]. +elim H7; intros; assumption. +case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) + | reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. +assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). +apply Rle_trans with (pos_Rl l1 (S i)). +elim H7; intros; left; assumption. +replace b with (Rmax a b). +rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H11 : a <= x). +apply Rle_trans with (pos_Rl l1 i). +replace a with (Rmin a b). +rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +left; elim H7; intros; assumption. +case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n; + assumption. +apply StepFun_P46 with b. +assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). +apply Rle_trans with (pos_Rl l1 (S i)). +elim H7; intros; left; assumption. +replace b with (Rmax a b). +rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H11 : a <= x). +apply Rle_trans with (pos_Rl l1 i). +replace a with (Rmin a b). +rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +left; elim H7; intros; assumption. +unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; + reflexivity || elim n; assumption. +assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. +intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). +apply Rle_lt_trans with (pos_Rl l1 i). +replace b with (Rmin b c). +rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n; assumption ]. +elim H7; intros; assumption. +unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) + | reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. Qed. -Lemma RiemannInt_P22 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f a c). -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. -Apply (pre phi). -Split; Assumption. -Assert H4 : (IsStepFun psi a c). -Apply StepFun_P44 with b. -Apply (pre psi). -Split; Assumption. -Split with (mkStepFun H3); Split with (mkStepFun H4); Split. -Simpl; 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; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption]. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Unfold Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption]. -Rewrite Rabsolu_right. -Assert H5 : (IsStepFun psi c b). -Apply StepFun_P46 with a. -Apply StepFun_P6; Assumption. -Apply (pre psi). -Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``. -Apply Rle_lt_trans with (RiemannInt_SF psi). -Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``. -Apply Rabsolu_pos. -Apply H. -Replace (Rmin a b) with a. -Replace (Rmax a b) with b. -Elim H6; Intros; Split; Left. -Apply Rle_lt_trans with c; Assumption. -Assumption. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Rewrite StepFun_P18; Ring. -Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)). -Apply Rle_Rabsolu. -Assumption. -Assert H6 : (IsStepFun psi a b). -Apply (pre psi). -Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). -Rewrite <- (StepFun_P43 H4 H5 H6); Ring. -Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro. -EApply StepFun_P17. -Apply StepFun_P1. -Simpl; Apply StepFun_P1. -Apply eq_Ropp; EApply StepFun_P17. -Apply StepFun_P1. -Simpl; Apply StepFun_P1. -Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``. -Apply Rabsolu_pos. -Apply H. -Replace (Rmin a b) with a. -Replace (Rmax a b) with b. -Elim H5; Intros; Split; Left. -Assumption. -Apply Rlt_le_trans with c; Assumption. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Rewrite StepFun_P18; Ring. +Lemma RiemannInt_P22 : + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c. +unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; + intros phi [psi H0]; elim H; elim H0; clear H H0; + intros; assert (H3 : IsStepFun phi a c). +apply StepFun_P44 with b. +apply (pre phi). +split; assumption. +assert (H4 : IsStepFun psi a c). +apply StepFun_P44 with b. +apply (pre psi). +split; assumption. +split with (mkStepFun H3); split with (mkStepFun H4); split. +simpl in |- *; intros; apply H. +replace (Rmin a b) with (Rmin a c). +elim H5; intros; split; try assumption. +apply Rle_trans with (Rmax a c); try assumption. +replace (Rmax a b) with b. +replace (Rmax a c) with c. +assumption. +unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros; + [ reflexivity + | elim n; apply Rle_trans with c; assumption + | elim n; assumption + | elim n0; assumption ]. +rewrite Rabs_right. +assert (H5 : IsStepFun psi c b). +apply StepFun_P46 with a. +apply StepFun_P6; assumption. +apply (pre psi). +replace (RiemannInt_SF (mkStepFun H4)) with + (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). +apply Rle_lt_trans with (RiemannInt_SF psi). +unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; + rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; + apply Ropp_ge_le_contravar; apply Rle_ge; + replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H6; intros; split; left. +apply Rle_lt_trans with c; assumption. +assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. +apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). +apply RRle_abs. +assumption. +assert (H6 : IsStepFun psi a b). +apply (pre psi). +replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). +rewrite <- (StepFun_P43 H4 H5 H6); ring. +unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H5; intros; split; left. +assumption. +apply Rlt_le_trans with c; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. Qed. -Lemma RiemannInt_P23 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f c b). -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. -Apply (pre phi). -Split; Assumption. -Assert H4 : (IsStepFun psi c b). -Apply StepFun_P45 with a. -Apply (pre psi). -Split; Assumption. -Split with (mkStepFun H3); Split with (mkStepFun H4); Split. -Simpl; 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; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Unfold Rmax; Case (total_order_Rle c b); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption]. -Rewrite Rabsolu_right. -Assert H5 : (IsStepFun psi a c). -Apply StepFun_P46 with b. -Apply (pre psi). -Apply StepFun_P6; Assumption. -Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``. -Apply Rle_lt_trans with (RiemannInt_SF psi). -Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``. -Apply Rabsolu_pos. -Apply H. -Replace (Rmin a b) with a. -Replace (Rmax a b) with b. -Elim H6; Intros; Split; Left. -Assumption. -Apply Rlt_le_trans with c; Assumption. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Rewrite StepFun_P18; Ring. -Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)). -Apply Rle_Rabsolu. -Assumption. -Assert H6 : (IsStepFun psi a b). -Apply (pre psi). -Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). -Rewrite <- (StepFun_P43 H5 H4 H6); Ring. -Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro. -EApply StepFun_P17. -Apply StepFun_P1. -Simpl; Apply StepFun_P1. -Apply eq_Ropp; EApply StepFun_P17. -Apply StepFun_P1. -Simpl; Apply StepFun_P1. -Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))). -Apply StepFun_P37; Try Assumption. -Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``. -Apply Rabsolu_pos. -Apply H. -Replace (Rmin a b) with a. -Replace (Rmax a b) with b. -Elim H5; Intros; Split; Left. -Apply Rle_lt_trans with c; Assumption. -Assumption. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption]. -Rewrite StepFun_P18; Ring. +Lemma RiemannInt_P23 : + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b. +unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; + intros phi [psi H0]; elim H; elim H0; clear H H0; + intros; assert (H3 : IsStepFun phi c b). +apply StepFun_P45 with a. +apply (pre phi). +split; assumption. +assert (H4 : IsStepFun psi c b). +apply StepFun_P45 with a. +apply (pre psi). +split; assumption. +split with (mkStepFun H3); split with (mkStepFun H4); split. +simpl in |- *; intros; apply H. +replace (Rmax a b) with (Rmax c b). +elim H5; intros; split; try assumption. +apply Rle_trans with (Rmin c b); try assumption. +replace (Rmin a b) with a. +replace (Rmin c b) with c. +assumption. +unfold Rmin in |- *; case (Rle_dec c b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros; + [ reflexivity + | elim n; apply Rle_trans with c; assumption + | elim n; assumption + | elim n0; assumption ]. +rewrite Rabs_right. +assert (H5 : IsStepFun psi a c). +apply StepFun_P46 with b. +apply (pre psi). +apply StepFun_P6; assumption. +replace (RiemannInt_SF (mkStepFun H4)) with + (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). +apply Rle_lt_trans with (RiemannInt_SF psi). +unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; + rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; + apply Ropp_ge_le_contravar; apply Rle_ge; + replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H6; intros; split; left. +assumption. +apply Rlt_le_trans with c; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. +apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). +apply RRle_abs. +assumption. +assert (H6 : IsStepFun psi a b). +apply (pre psi). +replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). +rewrite <- (StepFun_P43 H5 H4 H6); ring. +unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply StepFun_P1. +simpl in |- *; apply StepFun_P1. +apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). +apply StepFun_P37; try assumption. +intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). +apply Rabs_pos. +apply H. +replace (Rmin a b) with a. +replace (Rmax a b) with b. +elim H5; intros; split; left. +apply Rle_lt_trans with c; assumption. +assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. +rewrite StepFun_P18; ring. Qed. -Lemma RiemannInt_P24 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c). -Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros. -Apply RiemannInt_P21 with b; Assumption. -Case (total_order_Rle a c); Intro. -Apply RiemannInt_P22 with b; Try Assumption. -Split; [Assumption | Auto with real]. -Apply RiemannInt_P1; Apply RiemannInt_P22 with b. -Apply RiemannInt_P1; Assumption. -Split; Auto with real. -Case (total_order_Rle a c); Intro. -Apply RiemannInt_P23 with b; Try Assumption. -Split; Auto with real. -Apply RiemannInt_P1; Apply RiemannInt_P23 with b. -Apply RiemannInt_P1; Assumption. -Split; [Assumption | Auto with real]. -Apply RiemannInt_P1; Apply RiemannInt_P21 with b; Auto with real Orelse Apply RiemannInt_P1; Assumption. +Lemma RiemannInt_P24 : + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> + Riemann_integrable f b c -> Riemann_integrable f a c. +intros; case (Rle_dec a b); case (Rle_dec b c); intros. +apply RiemannInt_P21 with b; assumption. +case (Rle_dec a c); intro. +apply RiemannInt_P22 with b; try assumption. +split; [ assumption | auto with real ]. +apply RiemannInt_P1; apply RiemannInt_P22 with b. +apply RiemannInt_P1; assumption. +split; auto with real. +case (Rle_dec a c); intro. +apply RiemannInt_P23 with b; try assumption. +split; auto with real. +apply RiemannInt_P1; apply RiemannInt_P23 with b. +apply RiemannInt_P1; assumption. +split; [ assumption | auto with real ]. +apply RiemannInt_P1; apply RiemannInt_P21 with b; + auto with real || apply RiemannInt_P1; assumption. Qed. -Lemma RiemannInt_P25 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``a<=b``->``b<=c``->``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``. -Intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!b 3!c pr2 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!a 3!c pr3 5!RinvN RinvN_cv); Intros; Symmetry; EApply UL_sequence. -Apply u. -Unfold Un_cv; Intros; Assert H0 : ``0<eps/3``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (u1 ? H0); Clear u1; Intros N1 H1; Elim (u0 ? H0); Clear u0; Intros N2 H2; Cut (Un_cv [n:nat]``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` R0). -Intro; Elim (H3 ? H0); Clear H3; Intros N3 H3; Pose N0 := (max (max N1 N2) N3); Exists N0; Intros; Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)))``. -Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0))``; [Apply Rabsolu_triang | Ring]. -Replace eps with ``eps/3+eps/3+eps/3``. -Rewrite Rplus_assoc; Apply Rplus_lt. -Unfold R_dist in H3; Cut (ge n N3). -Intro; Assert H6 := (H3 ? H5); Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite Rplus_Or in H6; Apply H6. -Unfold ge; Apply le_trans with N0; [Unfold N0; Apply le_max_r | Assumption]. -Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0))``. -Replace ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1)+((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0)``; [Apply Rabsolu_triang | Ring]. -Apply Rplus_lt. -Unfold R_dist in H1; Apply H1. -Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_l | Unfold N0; Apply le_max_l] | Assumption]. -Unfold R_dist in H2; Apply H2. -Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_r | Unfold N0; Apply le_max_l] | Assumption]. -Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. -Clear x u x0 x1 eps H H0 N1 H1 N2 H2; Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). -Assert H2 : (EXT psi2:nat->(StepFun b c) | (n:nat) ((t:R)``(Rmin b c) <= t``/\``t <= (Rmax b c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). -Assert H3 : (EXT psi3:nat->(StepFun a c) | (n:nat) ((t:R)``(Rmin a c) <= t``/\``t <= (Rmax a c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``). -Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)). -Elim H1; Clear H1; Intros psi1 H1; Elim H2; Clear H2; Intros psi2 H2; Elim H3; Clear H3; Intros psi3 H3; Assert H := RinvN_cv; Unfold Un_cv; Intros; Assert H4 : ``0<eps/3``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H ? H4); Clear H; Intros N0 H; Assert H5 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``. -Intros; Replace (pos (RinvN n)) with ``(R_dist (mkposreal (/((INR n)+1)) (RinvN_pos n)) 0)``. -Apply H; Assumption. -Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; 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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Pose phi1 := (phi_sequence RinvN pr1 n); Fold phi1 in H8; Pose phi2 := (phi_sequence RinvN pr2 n); Fold phi2 in H3; Pose phi3 := (phi_sequence RinvN pr3 n); Fold phi2 in H1; Assert H10 : (IsStepFun phi3 a b). -Apply StepFun_P44 with c. -Apply (pre phi3). -Split; Assumption. -Assert H11 : (IsStepFun (psi3 n) a b). -Apply StepFun_P44 with c. -Apply (pre (psi3 n)). -Split; Assumption. -Assert H12 : (IsStepFun phi3 b c). -Apply StepFun_P45 with a. -Apply (pre phi3). -Split; Assumption. -Assert H13 : (IsStepFun (psi3 n) b c). -Apply StepFun_P45 with a. -Apply (pre (psi3 n)). -Split; Assumption. -Replace (RiemannInt_SF phi3) with ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))``. -Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)))+(Rabsolu ((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)))``. -Replace ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))+ -((RiemannInt_SF phi1)+(RiemannInt_SF phi2))`` with ``((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1))+((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2))``; [Apply Rabsolu_triang | Ring]. -Replace ``(RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H10) phi1))). -Replace ``(RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2))). -Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``. -Apply Rle_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``. -Apply Rle_compatibility. -Apply StepFun_P34; Try Assumption. -Do 2 Rewrite <- (Rplus_sym (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2)))))); Apply Rle_compatibility; Apply StepFun_P34; Try Assumption. -Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H11) (psi1 n))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``. -Apply Rle_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``. -Apply Rle_compatibility; Apply StepFun_P37; Try Assumption. -Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi2 x)))``. -Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi2 x)`` with ``((phi3 x)-(f x))+((f x)-(phi2 x))``; [Apply Rabsolu_triang | Ring]. -Apply Rplus_le. -Fold phi3 in H1; Apply H1. -Elim H14; Intros; Split. -Replace (Rmin a c) with a. -Apply Rle_trans with b; Try Assumption. -Left; Assumption. -Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption]. -Replace (Rmax a c) with c. -Left; Assumption. -Unfold Rmax; Case (total_order_Rle 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; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption]. -Replace (Rmax b c) with c. -Left; Assumption. -Unfold Rmax; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption]. -Do 2 Rewrite <- (Rplus_sym ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``); Apply Rle_compatibility; Apply StepFun_P37; Try Assumption. -Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi1 x)))``. -Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi1 x)`` with ``((phi3 x)-(f x))+((f x)-(phi1 x))``; [Apply Rabsolu_triang | Ring]. -Apply Rplus_le. -Apply H1. -Elim H14; Intros; Split. -Replace (Rmin a c) with a. -Left; Assumption. -Unfold Rmin; Case (total_order_Rle 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; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Replace (Rmax a b) with b. -Left; Assumption. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption]. -Do 2 Rewrite StepFun_P30. -Do 2 Rewrite Rmult_1l; Replace ``(RiemannInt_SF (mkStepFun H11))+(RiemannInt_SF (psi1 n))+((RiemannInt_SF (mkStepFun H13))+(RiemannInt_SF (psi2 n)))`` with ``(RiemannInt_SF (psi3 n))+(RiemannInt_SF (psi1 n))+(RiemannInt_SF (psi2 n))``. -Replace eps with ``eps/3+eps/3+eps/3``. -Repeat Rewrite Rplus_assoc; Repeat Apply Rplus_lt. -Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))). -Apply Rle_Rabsolu. -Apply Rlt_trans with (pos (RinvN n)). -Assumption. -Apply H5; Assumption. -Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))). -Apply Rle_Rabsolu. -Apply Rlt_trans with (pos (RinvN n)). -Assumption. -Apply H5; Assumption. -Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))). -Apply Rle_Rabsolu. -Apply Rlt_trans with (pos (RinvN n)). -Assumption. -Apply H5; Assumption. -Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. -Replace (RiemannInt_SF (psi3 n)) with (RiemannInt_SF (mkStepFun (pre (psi3 n)))). -Rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); Ring. -Reflexivity. -Rewrite StepFun_P30; Ring. -Rewrite StepFun_P30; Ring. -Apply (StepFun_P43 H10 H12 (pre phi3)). +Lemma RiemannInt_P25 : + forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), + a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. +intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); + case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; + symmetry in |- *; eapply UL_sequence. +apply u. +unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0; + intros N2 H2; + cut + (Un_cv + (fun n:nat => + RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n))) 0). +intro; elim (H3 _ H0); clear H3; intros N3 H3; + pose (N0 := max (max N1 N2) N3); exists N0; intros; + unfold R_dist in |- *; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))). +replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x1 + x0)) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n)) + + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))); + [ apply Rabs_triang | ring ]. +replace eps with (eps / 3 + eps / 3 + eps / 3). +rewrite Rplus_assoc; apply Rplus_lt_compat. +unfold R_dist in H3; cut (n >= N3)%nat. +intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6; + rewrite Rplus_0_r in H6; apply H6. +unfold ge in |- *; apply le_trans with N0; + [ unfold N0 in |- *; apply le_max_r | assumption ]. +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)). +replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1 + + (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)); + [ apply Rabs_triang | ring ]. +apply Rplus_lt_compat. +unfold R_dist in H1; apply H1. +unfold ge in |- *; apply le_trans with N0; + [ apply le_trans with (max N1 N2); + [ apply le_max_l | unfold N0 in |- *; apply le_max_l ] + | assumption ]. +unfold R_dist in H2; apply H2. +unfold ge in |- *; apply le_trans with N0; + [ apply le_trans with (max N1 N2); + [ apply le_max_r | unfold N0 in |- *; apply le_max_l ] + | assumption ]. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +clear x u x0 x1 eps H H0 N1 H1 N2 H2; + assert + (H1 : + exists psi1 : nat -> StepFun a b + | (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). +assert + (H2 : + exists psi2 : nat -> StepFun b c + | (forall n:nat, + (forall t:R, + Rmin b c <= t /\ t <= Rmax b c -> + Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). +assert + (H3 : + exists psi3 : nat -> StepFun a c + | (forall n:nat, + (forall t:R, + Rmin a c <= t /\ t <= Rmax a c -> + Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). +split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr3 n)). +elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3; + clear H3; intros psi3 H3; assert (H := RinvN_cv); + unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H _ H4); clear H; intros N0 H; + assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). +intros; + replace (pos (RinvN n)) with + (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0). +apply H; assumption. +unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (RinvN n)). +exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3; + intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; pose (phi1 := phi_sequence RinvN pr1 n); + fold phi1 in H8; pose (phi2 := phi_sequence RinvN pr2 n); + fold phi2 in H3; pose (phi3 := phi_sequence RinvN pr3 n); + fold phi2 in H1; assert (H10 : IsStepFun phi3 a b). +apply StepFun_P44 with c. +apply (pre phi3). +split; assumption. +assert (H11 : IsStepFun (psi3 n) a b). +apply StepFun_P44 with c. +apply (pre (psi3 n)). +split; assumption. +assert (H12 : IsStepFun phi3 b c). +apply StepFun_P45 with a. +apply (pre phi3). +split; assumption. +assert (H13 : IsStepFun (psi3 n) b c). +apply StepFun_P45 with a. +apply (pre (psi3 n)). +split; assumption. +replace (RiemannInt_SF phi3) with + (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12)). +apply Rle_lt_trans with + (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) + + Rabs (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)). +replace + (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12) + + - (RiemannInt_SF phi1 + RiemannInt_SF phi2)) with + (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1 + + (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)); + [ apply Rabs_triang | ring ]. +replace (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) with + (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))). +replace (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2) with + (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))). +apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + + RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). +apply Rle_trans with + (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) + + RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). +apply Rplus_le_compat_l. +apply StepFun_P34; try assumption. +do 2 + rewrite <- + (Rplus_comm + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))) + ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption. +apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) + + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). +apply Rle_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). +apply Rplus_le_compat_l; apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)). +rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; + replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x)); + [ apply Rabs_triang | ring ]. +apply Rplus_le_compat. +fold phi3 in H1; apply H1. +elim H14; intros; split. +replace (Rmin a c) with a. +apply Rle_trans with b; try assumption. +left; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +replace (Rmax a c) with c. +left; assumption. +unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +apply H3. +elim H14; intros; split. +replace (Rmin b c) with b. +left; assumption. +unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. +replace (Rmax b c) with c. +left; assumption. +unfold Rmax in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. +do 2 + rewrite <- + (Rplus_comm + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n))))) + ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption. +intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)). +rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; + replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x)); + [ apply Rabs_triang | ring ]. +apply Rplus_le_compat. +apply H1. +elim H14; intros; split. +replace (Rmin a c) with a. +left; assumption. +unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +replace (Rmax a c) with c. +apply Rle_trans with b. +left; assumption. +assumption. +unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. +apply H8. +elim H14; intros; split. +replace (Rmin a b) with a. +left; assumption. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +replace (Rmax a b) with b. +left; assumption. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. +do 2 rewrite StepFun_P30. +do 2 rewrite Rmult_1_l; + replace + (RiemannInt_SF (mkStepFun H11) + RiemannInt_SF (psi1 n) + + (RiemannInt_SF (mkStepFun H13) + RiemannInt_SF (psi2 n))) with + (RiemannInt_SF (psi3 n) + RiemannInt_SF (psi1 n) + RiemannInt_SF (psi2 n)). +replace eps with (eps / 3 + eps / 3 + eps / 3). +repeat rewrite Rplus_assoc; repeat apply Rplus_lt_compat. +apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))). +apply RRle_abs. +apply Rlt_trans with (pos (RinvN n)). +assumption. +apply H5; assumption. +apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). +apply RRle_abs. +apply Rlt_trans with (pos (RinvN n)). +assumption. +apply H5; assumption. +apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). +apply RRle_abs. +apply Rlt_trans with (pos (RinvN n)). +assumption. +apply H5; assumption. +apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. +replace (RiemannInt_SF (psi3 n)) with + (RiemannInt_SF (mkStepFun (pre (psi3 n)))). +rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); ring. +reflexivity. +rewrite StepFun_P30; ring. +rewrite StepFun_P30; ring. +apply (StepFun_P43 H10 H12 (pre phi3)). Qed. -Lemma RiemannInt_P26 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``. -Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros. -Apply RiemannInt_P25; Assumption. -Case (total_order_Rle a c); Intro. -Assert H : ``c<=b``. -Auto with real. -Rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Ring. -Assert H : ``c<=a``. -Auto with real. -Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring. -Assert H : ``b<=a``. -Auto with real. -Case (total_order_Rle a c); Intro. -Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Ring. -Assert H0 : ``c<=a``. -Auto with real. -Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring. -Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)); [Ring | Auto with real | Auto with real]. +Lemma RiemannInt_P26 : + forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), + RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. +intros; case (Rle_dec a b); case (Rle_dec b c); intros. +apply RiemannInt_P25; assumption. +case (Rle_dec a c); intro. +assert (H : c <= b). +auto with real. +rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring. +assert (H : c <= a). +auto with real. +rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); + rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. +assert (H : b <= a). +auto with real. +case (Rle_dec a c); intro. +rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); + rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring. +assert (H0 : c <= a). +auto with real. +rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); + rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. +rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); + rewrite <- + (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)) + ; [ ring | auto with real | auto with real ]. Qed. -Lemma RiemannInt_P27 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<x<b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)). -Intro f; Intros; Elim H; Clear H; Intros; Assert H1 : (continuity_pt f x). -Apply C0; Split; Left; Assumption. -Unfold derivable_pt_lim; Intros; Assert Hyp : ``0<eps/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H1 ? Hyp); Unfold dist D_x no_cond; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin ``b-x`` ``x-a``)); Assert H4 : ``0<del``. -Unfold del; Unfold Rmin; Case (total_order_Rle ``b-x`` ``x-a``); Intro. -Case (total_order_Rle x0 ``b-x``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption]. -Case (total_order_Rle x0 ``x-a``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption]. -Split with (mkposreal ? H4); Intros; Assert H7 : (Riemann_integrable f x ``x+h0``). -Case (total_order_Rle x ``x+h0``); Intro. -Apply continuity_implies_RiemannInt; Try Assumption. -Intros; Apply C0; Elim H7; Intros; Split. -Apply Rle_trans with x; [Left; Assumption | Assumption]. -Apply Rle_trans with ``x+h0``. -Assumption. -Left; Apply Rlt_le_trans with ``x+del``. -Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Apply H6]. -Unfold del; Apply Rle_trans with ``x+(Rmin (b-x) (x-a))``. -Apply Rle_compatibility; Apply Rmin_r. -Pattern 2 b; Replace b with ``x+(b-x)``; [Apply Rle_compatibility; 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; Apply Rle_trans with ``x-(Rmin (b-x) (x-a))``. -Pattern 1 a; Replace a with ``x+(a-x)``; [Idtac | Ring]. -Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle. -Rewrite Ropp_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Rewrite (Rplus_sym x); Apply Rmin_r. -Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle. -Do 2 Rewrite Ropp_Ropp; Apply Rmin_r. -Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt. -Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply H6]. -Assumption. -Apply Rle_trans with x; [Assumption | Left; Assumption]. -Replace ``(primitive h (FTC_P1 h C0) (x+h0))-(primitive h (FTC_P1 h C0) x)`` with (RiemannInt H7). -Replace (f x) with ``(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0``. -Replace ``(RiemannInt H7)/h0-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0`` with ``((RiemannInt H7)-(RiemannInt (RiemannInt_P14 x (x+h0) (f x))))/h0``. -Replace ``(RiemannInt H7)-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))). -Unfold Rdiv; Rewrite Rabsolu_mult; Case (total_order_Rle x ``x+h0``); Intro. -Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))))); Assumption. -Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 x (x+h0) (eps/2)))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply RiemannInt_P19; Try Assumption. -Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``. -Unfold fct_cte; Case (Req_EM x x1); Intro. -Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption. -Elim H3; Intros; Left; Apply H11. -Repeat Split. -Assumption. -Rewrite Rabsolu_right. -Apply Rlt_anti_compatibility with x; Replace ``x+(x1-x)`` with x1; [Idtac | Ring]. -Apply Rlt_le_trans with ``x+h0``. -Elim H8; Intros; Assumption. -Apply Rle_compatibility; Apply Rle_trans with del. -Left; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Assumption]. -Unfold del; Apply Rmin_l. -Apply Rge_minus; Apply Rle_sym1; Left; Elim H8; Intros; Assumption. -Unfold fct_cte; Ring. -Rewrite RiemannInt_P15. -Rewrite Rmult_assoc; Replace ``(x+h0-x)*(Rabsolu (/h0))`` with R1. -Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite Rabsolu_right. -Replace ``x+h0-x`` with h0; [Idtac | Ring]. -Apply Rinv_r_sym. -Assumption. -Apply Rle_sym1; Left; Apply Rlt_Rinv. -Elim r; Intro. -Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption. -Elim H5; Symmetry; Apply r_Rplus_plus with x; Rewrite Rplus_Or; Assumption. -Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x))))))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Replace (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) with ``-(RiemannInt (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))``. -Rewrite Rabsolu_Ropp; Apply (RiemannInt_P17 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))))); Auto with real. -Symmetry; Apply RiemannInt_P8. -Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (x+h0) x (eps/2)))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply RiemannInt_P19. -Auto with real. -Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``. -Unfold fct_cte; Case (Req_EM x x1); Intro. -Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption. -Elim H3; Intros; Left; Apply H11. -Repeat Split. -Assumption. -Rewrite Rabsolu_left. -Apply Rlt_anti_compatibility with ``x1-x0``; Replace ``x1-x0+x0`` with x1; [Idtac | Ring]. -Replace ``x1-x0+ -(x1-x)`` with ``x-x0``; [Idtac | Ring]. -Apply Rle_lt_trans with ``x+h0``. -Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle. -Rewrite Ropp_Ropp; Apply Rle_trans with (Rabsolu h0). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rmin_l]. -Elim H8; Intros; Assumption. -Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(x1-x)`` with x1; [Elim H8; Intros; Assumption | Ring]. -Unfold fct_cte; Ring. -Rewrite RiemannInt_P15. -Rewrite Rmult_assoc; Replace ``(x-(x+h0))*(Rabsolu (/h0))`` with R1. -Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite Rabsolu_left. -Replace ``x-(x+h0)`` with ``-h0``; [Idtac | Ring]. -Rewrite Ropp_mul1; Rewrite Ropp_mul3; Rewrite Ropp_Ropp; Apply Rinv_r_sym. -Assumption. -Apply Rlt_Rinv2. -Assert H8 : ``x+h0<x``. -Auto with real. -Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption. -Rewrite (RiemannInt_P13 H7 (RiemannInt_P14 x ``x+h0`` (f x)) (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))). -Ring. -Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring. -Rewrite RiemannInt_P15; Apply r_Rmult_mult with h0; [Unfold Rdiv; Rewrite -> (Rmult_sym h0); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | Assumption] | Assumption]. -Cut ``a<=x+h0``. -Cut ``x+h0<=b``. -Intros; Unfold primitive. -Case (total_order_Rle a ``x+h0``); Case (total_order_Rle ``x+h0`` b); Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Try (Elim n; Assumption Orelse Left; Assumption). -Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); Ring. -Apply Rle_anti_compatibility with ``-x``; Replace ``-x+(x+h0)`` with h0; [Idtac | Ring]. -Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu h0). -Apply Rle_Rabsolu. -Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; [Apply Rmin_r | Apply Rmin_l]]. -Apply Ropp_Rle; Apply Rle_anti_compatibility with ``x``; Replace ``x+-(x+h0)`` with ``-h0``; [Idtac | Ring]. -Apply Rle_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; Apply Rmin_r]]. +Lemma RiemannInt_P27 : + forall (f:R -> R) (a b x:R) (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). +intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x). +apply C0; split; left; assumption. +unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *; + unfold R_dist in |- *; intros; pose (del := Rmin x0 (Rmin (b - x) (x - a))); + assert (H4 : 0 < del). +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a)); + intro. +case (Rle_dec x0 (b - x)); intro; + [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. +case (Rle_dec x0 (x - a)); intro; + [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. +split with (mkposreal _ H4); intros; + assert (H7 : Riemann_integrable f x (x + h0)). +case (Rle_dec x (x + h0)); intro. +apply continuity_implies_RiemannInt; try assumption. +intros; apply C0; elim H7; intros; split. +apply Rle_trans with x; [ left; assumption | assumption ]. +apply Rle_trans with (x + h0). +assumption. +left; apply Rlt_le_trans with (x + del). +apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0); + [ apply RRle_abs | apply H6 ]. +unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)). +apply Rplus_le_compat_l; apply Rmin_r. +pattern b at 2 in |- *; replace b with (x + (b - x)); + [ apply Rplus_le_compat_l; apply Rmin_l | ring ]. +apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real. +intros; apply C0; elim H7; intros; split. +apply Rle_trans with (x + h0). +left; apply Rle_lt_trans with (x - del). +unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)). +pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ]. +unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. +rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + rewrite (Rplus_comm x); apply Rmin_r. +unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. +do 2 rewrite Ropp_involutive; apply Rmin_r. +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel. +rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0); + [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ]. +assumption. +apply Rle_trans with x; [ assumption | left; assumption ]. +replace (primitive h (FTC_P1 h C0) (x + h0) - primitive h (FTC_P1 h C0) x) + with (RiemannInt H7). +replace (f x) with (RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0). +replace + (RiemannInt H7 / h0 - RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0) + with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0). +replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with + (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))). +unfold Rdiv in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro. +apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))); + assumption. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 x (x + h0) (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19; try assumption. +intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). +unfold fct_cte in |- *; case (Req_dec x x1); intro. +rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; + assumption. +elim H3; intros; left; apply H11. +repeat split. +assumption. +rewrite Rabs_right. +apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ]. +apply Rlt_le_trans with (x + h0). +elim H8; intros; assumption. +apply Rplus_le_compat_l; apply Rle_trans with del. +left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ]. +unfold del in |- *; apply Rmin_l. +apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_right. +replace (x + h0 - x) with h0; [ idtac | ring ]. +apply Rinv_r_sym. +assumption. +apply Rle_ge; left; apply Rinv_0_lt_compat. +elim r; intro. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. +elim H5; symmetry in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r; + assumption. +apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +replace + (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with + (- + RiemannInt + (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))). +rewrite Rabs_Ropp; + apply + (RiemannInt_P17 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) + (RiemannInt_P16 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))))); + auto with real. +symmetry in |- *; apply RiemannInt_P8. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19. +auto with real. +intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). +unfold fct_cte in |- *; case (Req_dec x x1); intro. +rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; + assumption. +elim H3; intros; left; apply H11. +repeat split. +assumption. +rewrite Rabs_left. +apply Rplus_lt_reg_r with (x1 - x0); replace (x1 - x0 + x0) with x1; + [ idtac | ring ]. +replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ]. +apply Rle_lt_trans with (x + h0). +unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. +rewrite Ropp_involutive; apply Rle_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +apply Rle_trans with del; + [ left; assumption | unfold del in |- *; apply Rmin_l ]. +elim H8; intros; assumption. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ]. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_left. +replace (x - (x + h0)) with (- h0); [ idtac | ring ]. +rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse; + rewrite Ropp_involutive; apply Rinv_r_sym. +assumption. +apply Rinv_lt_0_compat. +assert (H8 : x + h0 < x). +auto with real. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. +rewrite + (RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x)) + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) + . +ring. +unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. +rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0; + [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | assumption ] + | assumption ]. +cut (a <= x + h0). +cut (x + h0 <= b). +intros; unfold primitive in |- *. +case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x); + case (Rle_dec x b); intros; try (elim n; assumption || left; assumption). +rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring. +apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0; + [ idtac | ring ]. +rewrite Rplus_comm; apply Rle_trans with (Rabs h0). +apply RRle_abs. +apply Rle_trans with del; + [ left; assumption + | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + [ apply Rmin_r | apply Rmin_l ] ]. +apply Ropp_le_cancel; apply Rplus_le_reg_l with x; + replace (x + - (x + h0)) with (- h0); [ idtac | ring ]. +apply Rle_trans with (Rabs h0); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rle_trans with del; + [ left; assumption + | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + apply Rmin_r ] ]. Qed. -Lemma RiemannInt_P28 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<=x<=b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)). -Intro f; Intros; Elim h; Intro. -Elim H; Clear H; Intros; Elim H; Intro. -Elim H1; Intro. -Apply RiemannInt_P27; Split; Assumption. -Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt [(FTC_P1 h C0 h (FTC_P2 b))])``; Rewrite H3. -Assert H4 : (derivable_pt_lim f_b b (f b)). -Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``. -Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``). -Apply derivable_pt_lim_plus. -Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_const. -Replace R1 with ``1-0``; [Idtac | Ring]. -Apply derivable_pt_lim_minus. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -Unfold fct_cte; Ring. -Apply derivable_pt_lim_const. -Ring. -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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H7 ? H8); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin x1 ``b-a``)); Assert H10 : ``0<del``. -Unfold del; Unfold Rmin; Case (total_order_Rle x1 ``b-a``); Intros. -Case (total_order_Rle x0 x1); Intro; [Apply (cond_pos x0) | Elim H9; Intros; Assumption]. -Case (total_order_Rle x0 ``b-a``); Intro; [Apply (cond_pos x0) | Apply Rlt_Rminus; Assumption]. -Split with (mkposreal ? H10); Intros; Case (case_Rabsolu h0); Intro. -Assert H14 : ``b+h0<b``. -Pattern 2 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption. -Assert H13 : (Riemann_integrable f ``b+h0`` b). -Apply continuity_implies_RiemannInt. -Left; Assumption. -Intros; Apply C0; Elim H13; Intros; Split; Try Assumption. -Apply Rle_trans with ``b+h0``; Try Assumption. -Apply Rle_anti_compatibility with ``-a-h0``. -Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring]. -Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring]. -Apply Rle_trans with del. -Apply Rle_trans with (Rabsolu h0). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Left; Assumption. -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 <- Rabsolu_Ropp; Unfold Rminus; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Ropp_distr1; Repeat Rewrite Ropp_Ropp; Replace ``(RiemannInt H13)*/h0+ -(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))*/h0`` with ``((RiemannInt H13)-(RiemannInt (RiemannInt_P14 (b+h0) b (f b))))/h0``. -Replace ``(RiemannInt H13)-(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b)))). -Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b+h0) b (f b)))))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))))); Left; Assumption. -Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (b+h0) b (eps/2)))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply RiemannInt_P19. -Left; Assumption. -Intros; Replace ``(f x2)+ -1*(fct_cte (f b) x2)`` with ``(f x2)-(f b)``. -Unfold fct_cte; Case (Req_EM b x2); Intro. -Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption. -Elim H9; Intros; Left; Apply H18. -Repeat Split. -Assumption. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right. -Apply Rlt_anti_compatibility with ``x2-x1``; Replace ``x2-x1+(b-x2)`` with ``b-x1``; [Idtac | Ring]. -Replace ``x2-x1+x1`` with x2; [Idtac | Ring]. -Apply Rlt_le_trans with ``b+h0``. -2:Elim H15; Intros; Left; Assumption. -Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]]. -Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H15; Intros; Assumption. -Unfold fct_cte; Ring. -Rewrite RiemannInt_P15. -Rewrite Rmult_assoc; Replace ``(b-(b+h0))*(Rabsolu (/h0))`` with R1. -Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite Rabsolu_left. -Apply r_Rmult_mult with h0; [Do 2 Rewrite (Rmult_sym h0); Rewrite Rmult_assoc; Rewrite Ropp_mul1; Rewrite <- Rinv_l_sym; [ Ring | Assumption ] | Assumption]. -Apply Rlt_Rinv2; Assumption. -Rewrite (RiemannInt_P13 H13 (RiemannInt_P14 ``b+h0`` b (f b)) (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b)))); Ring. -Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring. -Rewrite RiemannInt_P15. -Rewrite <- Ropp_mul1; Apply r_Rmult_mult with h0; [Repeat Rewrite (Rmult_sym 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; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption). -Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); Ring. -Elim n; Assumption. -Left; Assumption. -Apply Rle_anti_compatibility with ``-a-h0``. -Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring]. -Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring]. -Apply Rle_trans with del. -Apply Rle_trans with (Rabsolu h0). -Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu. -Left; Assumption. -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; Apply Rmin_l]. -Assert H14 : ``b<b+h0``. -Pattern 1 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility. -Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro. -Assumption. -Elim H11; Symmetry; Assumption. -Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)) | 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; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Left; Assumption | Elim n; Right; Reflexivity]. +Lemma RiemannInt_P28 : + forall (f:R -> R) (a b x:R) (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). +intro f; intros; elim h; intro. +elim H; clear H; intros; elim H; intro. +elim H1; intro. +apply RiemannInt_P27; split; assumption. +pose + (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))); + rewrite H3. +assert (H4 : derivable_pt_lim f_b b (f b)). +unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). +change + (derivable_pt_lim + ((fct_cte (f b) * (id - fct_cte b))%F + + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( + f b + 0)) in |- *. +apply derivable_pt_lim_plus. +pattern (f b) at 2 in |- *; + replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +apply derivable_pt_lim_const. +ring. +unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros; + assert (H7 : continuity_pt f b). +apply C0; split; [ left; assumption | right; reflexivity ]. +assert (H8 : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros; pose (del := Rmin x0 (Rmin x1 (b - a))); + assert (H10 : 0 < del). +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros. +case (Rle_dec x0 x1); intro; + [ apply (cond_pos x0) | elim H9; intros; assumption ]. +case (Rle_dec x0 (b - a)); intro; + [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ]. +split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro. +assert (H14 : b + h0 < b). +pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +assert (H13 : Riemann_integrable f (b + h0) b). +apply continuity_implies_RiemannInt. +left; assumption. +intros; apply C0; elim H13; intros; split; try assumption. +apply Rle_trans with (b + h0); try assumption. +apply Rplus_le_reg_l with (- a - h0). +replace (- a - h0 + a) with (- h0); [ idtac | ring ]. +replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. +apply Rle_trans with del. +apply Rle_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +left; assumption. +unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. +replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b) + with (- RiemannInt H13). +replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0). +rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr; + repeat rewrite Ropp_involutive; + replace + (RiemannInt H13 * / h0 + + - RiemannInt (RiemannInt_P14 (b + h0) b (f b)) * / h0) with + ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0). +replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with + (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))). +unfold Rdiv in |- *; rewrite Rabs_mult; + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); + left; assumption. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19. +left; assumption. +intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b). +unfold fct_cte in |- *; case (Req_dec b x2); intro. +rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + left; assumption. +elim H9; intros; left; apply H18. +repeat split. +assumption. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. +apply Rplus_lt_reg_r with (x2 - x1); + replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ]. +replace (x2 - x1 + x1) with x2; [ idtac | ring ]. +apply Rlt_le_trans with (b + h0). +2: elim H15; intros; left; assumption. +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; + rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +apply Rlt_le_trans with del; + [ assumption + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + [ apply Rmin_r | apply Rmin_l ] ]. +apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_left. +apply Rmult_eq_reg_l with h0; + [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc; + rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym; + [ ring | assumption ] + | assumption ]. +apply Rinv_lt_0_compat; assumption. +rewrite + (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b)) + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) + ; ring. +unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. +rewrite RiemannInt_P15. +rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0; + [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *; + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ ring | assumption ] + | assumption ]. +cut (a <= b + h0). +cut (b + h0 <= b). +intros; unfold primitive in |- *; case (Rle_dec a (b + h0)); + case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); + intros; try (elim n; right; reflexivity) || (elim n; left; assumption). +rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring. +elim n; assumption. +left; assumption. +apply Rplus_le_reg_l with (- a - h0). +replace (- a - h0 + a) with (- h0); [ idtac | ring ]. +replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. +apply Rle_trans with del. +apply Rle_trans with (Rabs h0). +rewrite <- Rabs_Ropp; apply RRle_abs. +left; assumption. +unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. +cut (primitive h (FTC_P1 h C0) b = f_b b). +intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)). +intro; rewrite H13; rewrite H14; apply H6. +assumption. +apply Rlt_le_trans with del; + [ assumption | unfold del in |- *; apply Rmin_l ]. +assert (H14 : b < b + h0). +pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +assert (H14 := Rge_le _ _ r); elim H14; intro. +assumption. +elim H11; symmetry in |- *; assumption. +unfold primitive in |- *; case (Rle_dec a (b + h0)); + case (Rle_dec (b + h0) b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)) + | unfold f_b in |- *; reflexivity + | elim n; left; apply Rlt_trans with b; assumption + | elim n0; left; apply Rlt_trans with b; assumption ]. +unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *; + case (Rle_dec a b); case (Rle_dec b b); intros; + [ apply RiemannInt_P5 + | elim n; right; reflexivity + | elim n; left; assumption + | elim n; right; reflexivity ]. (*****) -Pose f_a := [x:R]``(f a)*(x-a)``; Rewrite <- H2; Assert H3 : (derivable_pt_lim f_a a (f a)). -Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_const. -Replace R1 with ``1-0``; [Idtac | Ring]. -Apply derivable_pt_lim_minus. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Elim (H6 ? H7); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros. -Pose del := (Rmin x0 (Rmin x1 ``b-a``)). -Assert H9 : ``0<del``. -Unfold del; Unfold Rmin. -Case (total_order_Rle x1 ``b-a``); Intros. -Case (total_order_Rle x0 x1); Intro. -Apply (cond_pos x0). -Elim H8; Intros; Assumption. -Case (total_order_Rle x0 ``b-a``); Intro. -Apply (cond_pos x0). -Apply Rlt_Rminus; Assumption. -Split with (mkposreal ? H9). -Intros; Case (case_Rabsolu h0); Intro. -Assert H12 : ``a+h0<a``. -Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption. -Unfold primitive. -Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Left; Assumption) Orelse (Elim n; Right; Reflexivity). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H12)). -Elim n; Left; Apply Rlt_trans with a; Assumption. -Rewrite RiemannInt_P9; Replace R0 with (f_a a). -Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``). -Apply H5; Try Assumption. -Apply Rlt_le_trans with del; [Assumption | Unfold del; 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 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility. -Assert H12 := (Rle_sym2 ? ? r); Elim H12; Intro. -Assumption. -Elim H10; Symmetry; Assumption. -Assert H13 : (Riemann_integrable f a ``a+h0``). -Apply continuity_implies_RiemannInt. -Left; Assumption. -Intros; Apply C0; Elim H13; Intros; Split; Try Assumption. -Apply Rle_trans with ``a+h0``; Try Assumption. -Apply Rle_anti_compatibility with ``-b-h0``. -Replace ``-b-h0+b`` with ``-h0``; [Idtac | Ring]. -Replace ``-b-h0+(a+h0)`` with ``a-b``; [Idtac | Ring]. -Apply Ropp_Rle; Rewrite Ropp_Ropp; Rewrite Ropp_distr2; Apply Rle_trans with del. -Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption]. -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``. -Replace ``(RiemannInt H13)/h0-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))/h0`` with ``((RiemannInt H13)-(RiemannInt (RiemannInt_P14 a (a+h0) (f a))))/h0``. -Replace ``(RiemannInt H13)-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))`` with (RiemannInt (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a)))). -Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a+h0) (f a)))))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))))); Left; Assumption. -Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 a (a+h0) (eps/2)))*(Rabsolu (/h0))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony. -Apply Rabsolu_pos. -Apply RiemannInt_P19. -Left; Assumption. -Intros; Replace ``(f x2)+ -1*(fct_cte (f a) x2)`` with ``(f x2)-(f a)``. -Unfold fct_cte; Case (Req_EM a x2); Intro. -Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption. -Elim H8; Intros; Left; Apply H17; Repeat Split. -Assumption. -Rewrite Rabsolu_right. -Apply Rlt_anti_compatibility with a; Replace ``a+(x2-a)`` with x2; [Idtac | Ring]. -Apply Rlt_le_trans with ``a+h0``. -Elim H14; Intros; Assumption. -Apply Rle_compatibility; Left; Apply Rle_lt_trans with (Rabsolu h0). -Apply Rle_Rabsolu. -Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]]. -Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H14; Intros; Assumption. -Unfold fct_cte; Ring. -Rewrite RiemannInt_P15. -Rewrite Rmult_assoc; Replace ``((a+h0)-a)*(Rabsolu (/h0))`` with R1. -Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite Rabsolu_right. -Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym; [ Reflexivity | Assumption ]. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro. -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; Rewrite Rmult_Rplus_distrl; Ring. -Rewrite RiemannInt_P15. -Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [ Ring | Assumption ]. -Cut ``a<=a+h0``. -Cut ``a+h0<=b``. -Intros; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption). -Rewrite RiemannInt_P9; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply RiemannInt_P5. -Elim n; Assumption. -Elim n; Assumption. -2:Left; Assumption. -Apply Rle_anti_compatibility with ``-a``; Replace ``-a+(a+h0)`` with h0; [Idtac | Ring]. -Rewrite Rplus_sym; Apply Rle_trans with del; [Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption] | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); Apply Rmin_r]. +pose (f_a := fun x:R => f a * (x - a)); rewrite <- H2; + assert (H3 : derivable_pt_lim f_a a (f a)). +unfold f_a in |- *; + change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) + in |- *; pattern (f a) at 2 in |- *; + replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros. +assert (H6 : continuity_pt f a). +apply C0; split; [ right; reflexivity | left; assumption ]. +assert (H7 : 0 < eps / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros. +pose (del := Rmin x0 (Rmin x1 (b - a))). +assert (H9 : 0 < del). +unfold del in |- *; unfold Rmin in |- *. +case (Rle_dec x1 (b - a)); intros. +case (Rle_dec x0 x1); intro. +apply (cond_pos x0). +elim H8; intros; assumption. +case (Rle_dec x0 (b - a)); intro. +apply (cond_pos x0). +apply Rlt_Rminus; assumption. +split with (mkposreal _ H9). +intros; case (Rcase_abs h0); intro. +assert (H12 : a + h0 < a). +pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +unfold primitive in |- *. +case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a); + case (Rle_dec a b); intros; + try (elim n; left; assumption) || (elim n; right; reflexivity). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)). +elim n; left; apply Rlt_trans with a; assumption. +rewrite RiemannInt_P9; replace 0 with (f_a a). +replace (f a * (a + h0 - a)) with (f_a (a + h0)). +apply H5; try assumption. +apply Rlt_le_trans with del; + [ assumption | unfold del in |- *; apply Rmin_l ]. +unfold f_a in |- *; ring. +unfold f_a in |- *; ring. +elim n; left; apply Rlt_trans with a; assumption. +assert (H12 : a < a + h0). +pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +assert (H12 := Rge_le _ _ r); elim H12; intro. +assumption. +elim H10; symmetry in |- *; assumption. +assert (H13 : Riemann_integrable f a (a + h0)). +apply continuity_implies_RiemannInt. +left; assumption. +intros; apply C0; elim H13; intros; split; try assumption. +apply Rle_trans with (a + h0); try assumption. +apply Rplus_le_reg_l with (- b - h0). +replace (- b - h0 + b) with (- h0); [ idtac | ring ]. +replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ]. +apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr; + apply Rle_trans with del. +apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]. +unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. +replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a) + with (RiemannInt H13). +replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0). +replace + (RiemannInt H13 / h0 - RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0) + with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0). +replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with + (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))). +unfold Rdiv in |- *; rewrite Rabs_mult; + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) * + Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); + left; assumption. +apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)). +do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. +apply Rabs_pos. +apply RiemannInt_P19. +left; assumption. +intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a). +unfold fct_cte in |- *; case (Req_dec a x2); intro. +rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + left; assumption. +elim H8; intros; left; apply H17; repeat split. +assumption. +rewrite Rabs_right. +apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ]. +apply Rlt_le_trans with (a + h0). +elim H14; intros; assumption. +apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0). +apply RRle_abs. +apply Rlt_le_trans with del; + [ assumption + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + [ apply Rmin_r | apply Rmin_l ] ]. +apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption. +unfold fct_cte in |- *; ring. +rewrite RiemannInt_P15. +rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1. +rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite Rabs_right. +rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym; + [ reflexivity | assumption ]. +apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r); + elim H14; intro. +assumption. +elim H10; symmetry in |- *; assumption. +rewrite + (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a)) + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) + ; ring. +unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. +rewrite RiemannInt_P15. +rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ]. +cut (a <= a + h0). +cut (a + h0 <= b). +intros; unfold primitive in |- *; case (Rle_dec a (a + h0)); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + intros; try (elim n; right; reflexivity) || (elim n; left; assumption). +rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply RiemannInt_P5. +elim n; assumption. +elim n; assumption. +2: left; assumption. +apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0; + [ idtac | ring ]. +rewrite Rplus_comm; apply Rle_trans with del; + [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ] + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ]. (*****) -Assert H1 : x==a. -Rewrite <- H0 in H; Elim H; Intros; Apply Rle_antisym; Assumption. -Pose f_a := [x:R]``(f a)*(x-a)``. -Assert H2 : (derivable_pt_lim f_a a (f a)). -Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_const. -Replace R1 with ``1-0``; [Idtac | Ring]. -Apply derivable_pt_lim_minus. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -Unfold fct_cte; Ring. -Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt (FTC_P1 h C0 b h (FTC_P2 b)))``. -Assert H3 : (derivable_pt_lim f_b b (f b)). -Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``. -Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``). -Apply derivable_pt_lim_plus. -Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``. -Apply derivable_pt_lim_mult. -Apply derivable_pt_lim_const. -Replace R1 with ``1-0``; [Idtac | Ring]. -Apply derivable_pt_lim_minus. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -Unfold fct_cte; Ring. -Apply derivable_pt_lim_const. -Ring. -Unfold derivable_pt_lim; Intros; Elim (H2 ? H4); Intros; Elim (H3 ? H4); Intros; Pose del := (Rmin x0 x1). -Assert H7 : ``0<del``. -Unfold del; Unfold Rmin; Case (total_order_Rle x0 x1); Intro. -Apply (cond_pos x0). -Apply (cond_pos x1). -Split with (mkposreal ? H7); Intros; Case (case_Rabsolu h0); Intro. -Assert H10 : ``a+h0<a``. -Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption. -Rewrite H1; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Right; Assumption Orelse Reflexivity). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H10)). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r2 H10)). -Rewrite RiemannInt_P9; Replace R0 with (f_a a). -Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``). -Apply H5; Try Assumption. -Apply Rlt_le_trans with del; Try Assumption. -Unfold del; Apply Rmin_l. -Unfold f_a; Ring. -Unfold f_a; Ring. -Elim n; Rewrite <- H0; Left; Assumption. -Assert H10 : ``a<a+h0``. -Pattern 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility. -Assert H10 := (Rle_sym2 ? ? r); Elim H10; Intro. -Assumption. -Elim H8; Symmetry; Assumption. -Rewrite H0 in H1; Rewrite H1; Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; Try (Elim n; Right; Assumption Orelse Reflexivity). -Rewrite H0 in H10; Elim (Rlt_antirefl ? (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``). -Apply H6; Try Assumption. -Apply Rlt_le_trans with del; Try Assumption. -Unfold del; Apply Rmin_r. -Unfold f_b; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Apply RiemannInt_P5. -Elim n; Rewrite <- H0; Left; Assumption. -Elim n0; Rewrite <- H0; Left; Assumption. +assert (H1 : x = a). +rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption. +pose (f_a := fun x:R => f a * (x - a)). +assert (H2 : derivable_pt_lim f_a a (f a)). +unfold f_a in |- *; + change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) + in |- *; pattern (f a) at 2 in |- *; + replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +pose + (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))). +assert (H3 : derivable_pt_lim f_b b (f b)). +unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). +change + (derivable_pt_lim + ((fct_cte (f b) * (id - fct_cte b))%F + + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( + f b + 0)) in |- *. +apply derivable_pt_lim_plus. +pattern (f b) at 2 in |- *; + replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). +apply derivable_pt_lim_mult. +apply derivable_pt_lim_const. +replace 1 with (1 - 0); [ idtac | ring ]. +apply derivable_pt_lim_minus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +unfold fct_cte in |- *; ring. +apply derivable_pt_lim_const. +ring. +unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros; + elim (H3 _ H4); intros; pose (del := Rmin x0 x1). +assert (H7 : 0 < del). +unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro. +apply (cond_pos x0). +apply (cond_pos x1). +split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro. +assert (H10 : a + h0 < a). +pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0)); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + intros; try (elim n; right; assumption || reflexivity). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). +rewrite RiemannInt_P9; replace 0 with (f_a a). +replace (f a * (a + h0 - a)) with (f_a (a + h0)). +apply H5; try assumption. +apply Rlt_le_trans with del; try assumption. +unfold del in |- *; apply Rmin_l. +unfold f_a in |- *; ring. +unfold f_a in |- *; ring. +elim n; rewrite <- H0; left; assumption. +assert (H10 : a < a + h0). +pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +assert (H10 := Rge_le _ _ r); elim H10; intro. +assumption. +elim H8; symmetry in |- *; assumption. +rewrite H0 in H1; rewrite H1; unfold primitive in |- *; + case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); + case (Rle_dec a b); case (Rle_dec b b); intros; + try (elim n; right; assumption || reflexivity). +rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). +repeat rewrite RiemannInt_P9. +replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b). +fold (f_b (b + h0)) in |- *. +apply H6; try assumption. +apply Rlt_le_trans with del; try assumption. +unfold del in |- *; apply Rmin_r. +unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5. +elim n; rewrite <- H0; left; assumption. +elim n0; rewrite <- H0; left; assumption. Qed. -Lemma RiemannInt_P29 : (f:R->R;a,b;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) (antiderivative f (primitive h (FTC_P1 h C0)) a b). -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; Split with (f x); Apply H0 | Split with H1; Symmetry; Apply derive_pt_eq_0; Apply H0]. +Lemma RiemannInt_P29 : + forall (f:R -> R) a b (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + antiderivative f (primitive h (FTC_P1 h C0)) a b. +intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; + assert (H0 := RiemannInt_P28 h C0 H); + assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x); + [ unfold derivable_pt in |- *; split with (f x); apply H0 + | split with H1; symmetry in |- *; apply derive_pt_eq_0; apply H0 ]. Qed. -Lemma RiemannInt_P30 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (sigTT ? [g:R->R](antiderivative f g a b)). -Intros; Split with (primitive H (FTC_P1 H H0)); Apply RiemannInt_P29. +Lemma RiemannInt_P30 : + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + sigT (fun g:R -> R => antiderivative f g a b). +intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29. Qed. -Record C1_fun : Type := mkC1 { -c1 :> R->R; -diff0 : (derivable c1); -cont1 : (continuity (derive c1 diff0)) }. +Record C1_fun : Type := mkC1 + {c1 :> R -> R; diff0 : derivable c1; cont1 : continuity (derive c1 diff0)}. -Lemma RiemannInt_P31 : (f:C1_fun;a,b:R) ``a<=b`` -> (antiderivative (derive f (diff0 f)) f a b). -Intro f; Intros; Unfold antiderivative; Split; Try Assumption; Intros; Split with (diff0 f x); Reflexivity. +Lemma RiemannInt_P31 : + forall (f:C1_fun) (a b:R), + a <= b -> antiderivative (derive f (diff0 f)) f a b. +intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; + split with (diff0 f x); reflexivity. Qed. -Lemma RiemannInt_P32 : (f:C1_fun;a,b:R) (Riemann_integrable (derive f (diff0 f)) a b). -Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f) | Assert H : ``b<=a``; [Auto with real | Apply RiemannInt_P1; Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f)]]. +Lemma RiemannInt_P32 : + forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b. +intro f; intros; case (Rle_dec a b); intro; + [ apply continuity_implies_RiemannInt; try assumption; intros; + apply (cont1 f) + | assert (H : b <= a); + [ auto with real + | apply RiemannInt_P1; apply continuity_implies_RiemannInt; + try assumption; intros; apply (cont1 f) ] ]. Qed. -Lemma RiemannInt_P33 : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) ``a<=b`` -> (RiemannInt pr)==``(f b)-(f a)``. -Intro f; Intros; Assert H0 : (x:R)``a<=x<=b``->(continuity_pt (derive f (diff0 f)) x). -Intros; Apply (cont1 f). -Rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); Assert H1 := (RiemannInt_P29 H H0); Assert H2 := (RiemannInt_P31 f H); Elim (antiderivative_Ucte (derive f (diff0 f)) ? ? ? ? H1 H2); Intros C H3; Repeat Rewrite H3; [Ring | Split; [Right; Reflexivity | Assumption] | Split; [Assumption | Right; Reflexivity]]. +Lemma RiemannInt_P33 : + forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), + a <= b -> RiemannInt pr = f b - f a. +intro f; intros; + assert + (H0 : forall x:R, a <= x <= b -> continuity_pt (derive f (diff0 f)) x). +intros; apply (cont1 f). +rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); + assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H); + elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); + intros C H3; repeat rewrite H3; + [ ring + | split; [ right; reflexivity | assumption ] + | split; [ assumption | right; reflexivity ] ]. Qed. -Lemma FTC_Riemann : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) (RiemannInt pr)==``(f b)-(f a)``. -Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P33; Assumption | Assert H : ``b<=a``; [Auto with real | Assert H0 := (RiemannInt_P1 pr); Rewrite (RiemannInt_P8 pr H0); Rewrite (RiemannInt_P33 H0 H); Ring]]. -Qed. +Lemma FTC_Riemann : + forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), + RiemannInt pr = f b - f a. +intro f; intros; case (Rle_dec a b); intro; + [ apply RiemannInt_P33; assumption + | assert (H : b <= a); + [ auto with real + | assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0); + rewrite (RiemannInt_P33 _ H0 H); ring ] ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v index f81c57997..5f47466ac 100644 --- a/theories/Reals/RiemannInt_SF.v +++ b/theories/Reals/RiemannInt_SF.v @@ -8,1393 +8,2625 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Ranalysis. -Require Classical_Prop. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis. +Require Import Classical_Prop. Open Local Scope R_scope. -Implicit Arguments On. +Set Implicit Arguments. (**************************************************) (* Each bounded subset of N has a maximal element *) (**************************************************) -Definition Nbound [I:nat->Prop] : Prop := (EX n:nat | (i:nat)(I i)->(le i n)). +Definition Nbound (I:nat -> Prop) : Prop := + exists n : nat | (forall i:nat, I i -> (i <= n)%nat). -Lemma IZN_var:(z:Z)(`0<=z`)->{ n:nat | z=(INZ n)}. -Intros; Apply inject_nat_complete_inf; Assumption. +Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z_of_nat n}. +intros; apply Z_of_nat_complete_inf; assumption. Qed. -Lemma Nzorn : (I:nat->Prop) (EX n:nat | (I n)) -> (Nbound I) -> (sigTT ? [n:nat](I n)/\(i:nat)(I i)->(le i n)). -Intros I H H0; Pose E := [x:R](EX i:nat | (I i)/\(INR i)==x); Assert H1 : (bound E). -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 : (EXT x:R | (E x)). -Elim H; Intros; Exists (INR x); Unfold E; Exists x; Split; [Assumption | Reflexivity]. -Assert H3 := (complet 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 O)<=(INR x1)``; Apply le_INR; Apply le_O_n | Apply H4; Assumption]. -Assert H7 := (archimed x); Elim H7; Clear H7; Intros; Assert H9 : ``x<=(IZR (up x))-1``. -Apply H5; Intros; Assert H10 := (H4 ? H9); Unfold E in H9; Elim H9; Intros; Elim H11; Intros; Rewrite <- H13; Apply Rle_anti_compatibility with R1; Replace ``1+((IZR (up x))-1)`` with (IZR (up x)); [Idtac | Ring]; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring]. -Assert H14 : `0<=(up x)`. -Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption]. -Assert H15 := (IZN ? H14); Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- INR_IZR_INZ; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H13; Apply Rle_lt_trans with x; [Assumption | Rewrite INR_IZR_INZ; Rewrite <- H15; Assumption]. -Assert H10 : ``x==(IZR (up x))-1``. -Apply Rle_antisym; [Assumption | Apply Rle_anti_compatibility with ``-x+1``; Replace `` -x+1+((IZR (up x))-1)`` with ``(IZR (up x))-x``; [Idtac | Ring]; Replace ``-x+1+x`` with R1; [Assumption | Ring]]. -Assert H11 : `0<=(up x)`. -Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption]. -Assert H12 := (IZN_var H11); Elim H12; Clear H12; Intros; Assert H13 : (E x). -Elim (classic (E x)); Intro; Try Assumption. -Cut ((y:R)(E y)->``y<=x-1``). -Intro; Assert H14 := (H5 ? H13); Cut ``x-1<x``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H15)). -Apply Rminus_lt; Replace ``x-1-x`` with ``-1``; [Idtac | Ring]; Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply Rlt_R0_R1. -Intros; Assert H14 := (H4 ? H13); Elim H14; Intro; Unfold E in H13; Elim H13; Intros; Elim H16; Intros; Apply Rle_anti_compatibility with R1. -Replace ``1+(x-1)`` with x; [Idtac | Ring]; Rewrite <- H18; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring]. -Cut x==(INR (pred x0)). -Intro; Rewrite H19; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H18; Rewrite <- H19; Assumption. -Rewrite H10; Rewrite p; Rewrite <- INR_IZR_INZ; Replace R1 with (INR (S O)); [Idtac | Reflexivity]; Rewrite <- minus_INR. -Replace (minus x0 (S O)) with (pred x0); [Reflexivity | Case x0; [Reflexivity | Intro; Simpl; Apply minus_n_O]]. -Induction x0; [Rewrite p in H7; Rewrite <- INR_IZR_INZ in H7; Simpl in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7)) | Apply le_n_S; Apply le_O_n]. -Rewrite H15 in H13; Elim H12; Assumption. -Split with (pred x0); Unfold E in H13; Elim H13; Intros; Elim H12; Intros; Rewrite H10 in H15; Rewrite p in H15; Rewrite <- INR_IZR_INZ in H15; Assert H16 : ``(INR x0)==(INR x1)+1``. -Rewrite H15; Ring. -Rewrite <- S_INR in H16; Assert H17 := (INR_eq ? ? H16); Rewrite H17; Simpl; Split. -Assumption. -Intros; Apply INR_le; Rewrite H15; Rewrite <- H15; Elim H12; Intros; Rewrite H20; Apply H4; Unfold E; Exists i; Split; [Assumption | Reflexivity]. +Lemma Nzorn : + forall I:nat -> Prop, + ( exists n : nat | I n) -> + Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)). +intros I H H0; pose (E := fun x:R => exists i : nat | I i /\ INR i = x); + assert (H1 : bound E). +unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *; + exists (INR N); unfold is_upper_bound in |- *; intros; + unfold E in H2; elim H2; intros; elim H3; intros; + rewrite <- H5; apply le_INR; apply H1; assumption. +assert (H2 : exists x : R | E x). +elim H; intros; exists (INR x); unfold E in |- *; exists x; split; + [ assumption | reflexivity ]. +assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p; + elim p; clear p; intros; unfold is_upper_bound in H4, H5; + assert (H6 : 0 <= x). +elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros; + apply Rle_trans with x0; + [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR; + apply le_O_n + | apply H4; assumption ]. +assert (H7 := archimed x); elim H7; clear H7; intros; + assert (H9 : x <= IZR (up x) - 1). +apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros; + elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1; + replace (1 + (IZR (up x) - 1)) with (IZR (up x)); + [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1)); + [ idtac | rewrite S_INR; ring ]. +assert (H14 : (0 <= up x)%Z). +apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. +assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15; + rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S; + apply INR_lt; rewrite H13; apply Rle_lt_trans with x; + [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ]. +assert (H10 : x = IZR (up x) - 1). +apply Rle_antisym; + [ assumption + | apply Rplus_le_reg_l with (- x + 1); + replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x); + [ idtac | ring ]; replace (- x + 1 + x) with 1; + [ assumption | ring ] ]. +assert (H11 : (0 <= up x)%Z). +apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. +assert (H12 := IZN_var H11); elim H12; clear H12; intros; assert (H13 : E x). +elim (classic (E x)); intro; try assumption. +cut (forall y:R, E y -> y <= x - 1). +intro; assert (H14 := H5 _ H13); cut (x - 1 < x). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)). +apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ]; + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1. +intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13; + intros; elim H16; intros; apply Rplus_le_reg_l with 1. +replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18; + replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. +cut (x = INR (pred x0)). +intro; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18; + rewrite <- H19; assumption. +rewrite H10; rewrite p; rewrite <- INR_IZR_INZ; replace 1 with (INR 1); + [ idtac | reflexivity ]; rewrite <- minus_INR. +replace (x0 - 1)%nat with (pred x0); + [ reflexivity + | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ]. +induction x0 as [| x0 Hrecx0]; + [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) + | apply le_n_S; apply le_O_n ]. +rewrite H15 in H13; elim H12; assumption. +split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros; + rewrite H10 in H15; rewrite p in H15; rewrite <- INR_IZR_INZ in H15; + assert (H16 : INR x0 = INR x1 + 1). +rewrite H15; ring. +rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17; + simpl in |- *; split. +assumption. +intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; + rewrite H20; apply H4; unfold E in |- *; exists i; + split; [ assumption | reflexivity ]. Qed. (*******************************************) (* Step functions *) (*******************************************) -Definition open_interval [a,b:R] : R->Prop := [x:R]``a<x<b``. -Definition co_interval [a,b:R] : R->Prop := [x:R]``a<=x<b``. +Definition open_interval (a b x:R) : Prop := a < x < b. +Definition co_interval (a b x:R) : Prop := a <= x < b. -Definition adapted_couple [f:R->R;a,b:R;l,lf:Rlist] : Prop := (ordered_Rlist l)/\``(pos_Rl l O)==(Rmin a b)``/\``(pos_Rl l (pred (Rlength l)))==(Rmax a b)``/\(Rlength l)=(S (Rlength lf))/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) (pos_Rl lf i)). +Definition adapted_couple (f:R -> R) (a b:R) (l lf:Rlist) : Prop := + ordered_Rlist l /\ + pos_Rl l 0 = Rmin a b /\ + pos_Rl l (pred (Rlength l)) = Rmax a b /\ + Rlength l = S (Rlength lf) /\ + (forall i:nat, + (i < pred (Rlength l))%nat -> + constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) + (pos_Rl lf i)). -Definition adapted_couple_opt [f:R->R;a,b:R;l,lf:Rlist] := (adapted_couple f a b l lf)/\((i:nat)(lt i (pred (Rlength lf)))->(``(pos_Rl lf i)<>(pos_Rl lf (S i))``\/``(f (pos_Rl l (S i)))<>(pos_Rl lf i)``))/\((i:nat)(lt i (pred (Rlength l)))->``(pos_Rl l i)<>(pos_Rl l (S i))``). +Definition adapted_couple_opt (f:R -> R) (a b:R) (l lf:Rlist) := + adapted_couple f a b l lf /\ + (forall i:nat, + (i < pred (Rlength lf))%nat -> + pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\ + (forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <> pos_Rl l (S i)). -Definition is_subdivision [f:R->R;a,b:R;l:Rlist] : Type := (sigTT ? [l0:Rlist](adapted_couple f a b l l0)). +Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type := + sigT (fun l0:Rlist => adapted_couple f a b l l0). -Definition IsStepFun [f:R->R;a,b:R] : Type := (SigT ? [l:Rlist](is_subdivision f a b l)). +Definition IsStepFun (f:R -> R) (a b:R) : Type := + sigT (fun l:Rlist => is_subdivision f a b l). (* Class of step functions *) -Record StepFun [a,b:R] : Type := mkStepFun { - fe:> R->R; - pre:(IsStepFun fe a b)}. - -Definition subdivision [a,b:R;f:(StepFun a b)] : Rlist := (projT1 ? ? (pre f)). - -Definition subdivision_val [a,b:R;f:(StepFun a b)] : Rlist := Cases (projT2 ? ? (pre f)) of (existTT a b) => a end. - -Fixpoint Int_SF [l:Rlist] : Rlist -> R := -[k:Rlist] Cases l of -| nil => R0 -| (cons a l') => Cases k of - | nil => R0 - | (cons x nil) => R0 - | (cons x (cons y k')) => ``a*(y-x)+(Int_SF l' (cons y k'))`` - end -end. +Record StepFun (a b:R) : Type := mkStepFun + {fe :> R -> R; pre : IsStepFun fe a b}. + +Definition subdivision (a b:R) (f:StepFun a b) : Rlist := projT1 (pre f). + +Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist := + match projT2 (pre f) with + | existT a b => a + end. + +Fixpoint Int_SF (l k:Rlist) {struct l} : R := + match l with + | nil => 0 + | cons a l' => + match k with + | nil => 0 + | cons x nil => 0 + | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k') + end + end. (* Integral of step functions *) -Definition RiemannInt_SF [a,b:R;f:(StepFun a b)] : R := -Cases (total_order_Rle a b) of - (leftT _) => (Int_SF (subdivision_val f) (subdivision f)) -| (rightT _) => ``-(Int_SF (subdivision_val f) (subdivision f))`` -end. +Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R := + match Rle_dec a b with + | left _ => Int_SF (subdivision_val f) (subdivision f) + | right _ => - Int_SF (subdivision_val f) (subdivision f) + end. (********************************) (* Properties of step functions *) (********************************) -Lemma StepFun_P1 : (a,b:R;f:(StepFun a b)) (adapted_couple f a b (subdivision f) (subdivision_val f)). -Intros a b f; Unfold subdivision_val; Case (projT2 Rlist ([l:Rlist](is_subdivision f a b l)) (pre f)); Intros; Apply a0. +Lemma StepFun_P1 : + forall (a b:R) (f:StepFun a b), + adapted_couple f a b (subdivision f) (subdivision_val f). +intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros; + apply a0. Qed. -Lemma StepFun_P2 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple f b a l lf). -Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption. -Rewrite H2; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity. -Apply Rle_antisym; Assumption. -Apply Rle_antisym; Auto with real. -Rewrite H1; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity. -Apply Rle_antisym; Assumption. -Apply Rle_antisym; Auto with real. +Lemma StepFun_P2 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> adapted_couple f b a l lf. +unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + repeat split; try assumption. +rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. Qed. -Lemma StepFun_P3 : (a,b,c:R) ``a<=b`` -> (adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil)). -Intros; Unfold adapted_couple; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H0; Inversion H0; [Simpl; Assumption | Elim (le_Sn_O ? H2)]. -Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold constant_D_eq open_interval; Intros; Simpl in H0; Inversion H0; [Reflexivity | Elim (le_Sn_O ? H3)]. +Lemma StepFun_P3 : + forall a b c:R, + a <= b -> + adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil). +intros; unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0; + [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ]. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold constant_D_eq, open_interval in |- *; intros; simpl in H0; + inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ]. Qed. -Lemma StepFun_P4 : (a,b,c:R) (IsStepFun (fct_cte c) a b). -Intros; Unfold IsStepFun; Case (total_order_Rle a b); Intro. -Apply Specif.existT with (cons a (cons b nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply (StepFun_P3 c r). -Apply Specif.existT with (cons b (cons a nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply StepFun_P2; Apply StepFun_P3; Auto with real. +Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b. +intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro. +apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *; + apply existT with (cons c nil); apply (StepFun_P3 c r). +apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *; + apply existT with (cons c nil); apply StepFun_P2; + apply StepFun_P3; auto with real. Qed. -Lemma StepFun_P5 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (is_subdivision f b a l). -Unfold is_subdivision; Intros; Elim X; Intros; Exists x; Unfold adapted_couple in p; Decompose [and] p; Clear p; Unfold adapted_couple; Repeat Split; Try Assumption. -Rewrite H1; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity. -Apply Rle_antisym; Assumption. -Apply Rle_antisym; Auto with real. -Rewrite H0; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity. -Apply Rle_antisym; Assumption. -Apply Rle_antisym; Auto with real. +Lemma StepFun_P5 : + forall (a b:R) (f:R -> R) (l:Rlist), + is_subdivision f a b l -> is_subdivision f b a l. +unfold is_subdivision in |- *; intros; elim X; intros; exists x; + unfold adapted_couple in p; decompose [and] p; clear p; + unfold adapted_couple in |- *; repeat split; try assumption. +rewrite H1; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +rewrite H0; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. Qed. -Lemma StepFun_P6 : (f:R->R;a,b:R) (IsStepFun f a b) -> (IsStepFun f b a). -Unfold IsStepFun; Intros; Elim X; Intros; Apply Specif.existT with x; Apply StepFun_P5; Assumption. +Lemma StepFun_P6 : + forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a. +unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x; + apply StepFun_P5; assumption. Qed. -Lemma StepFun_P7 : (a,b,r1,r2,r3:R;f:R->R;l,lf:Rlist) ``a<=b`` -> (adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf)) -> (adapted_couple f r2 b (cons r2 l) lf). -Unfold adapted_couple; Intros; Decompose [and] H0; Clear H0; Assert H5 : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert H7 : ``r2<=b``. -Rewrite H5 in H2; Rewrite <- H2; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity]. -Repeat Split. -Apply RList_P4 with r1; Assumption. -Rewrite H5 in H2; Unfold Rmin; Case (total_order_Rle r2 b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold Rmax; Case (total_order_Rle r2 b); Intro; [Rewrite H5 in H2; Rewrite <- H2; Reflexivity | Elim n; Assumption]. -Simpl in H4; Simpl; Apply INR_eq; Apply r_Rplus_plus with R1; Do 2 Rewrite (Rplus_sym R1); Do 2 Rewrite <- S_INR; Rewrite H4; Reflexivity. -Intros; Unfold constant_D_eq open_interval; Intros; Unfold constant_D_eq open_interval in H6; Assert H9 : (lt (S i) (pred (Rlength (cons r1 (cons r2 l))))). -Simpl; Simpl in H0; Apply lt_n_S; Assumption. -Assert H10 := (H6 ? H9); Apply H10; Assumption. +Lemma StepFun_P7 : + forall (a b r1 r2 r3:R) (f:R -> R) (l lf:Rlist), + a <= b -> + adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) -> + adapted_couple f r2 b (cons r2 l) lf. +unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0; + assert (H5 : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H7 : r2 <= b). +rewrite H5 in H2; rewrite <- H2; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +repeat split. +apply RList_P4 with r1; assumption. +rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmax in |- *; case (Rle_dec r2 b); intro; + [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ]. +simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1; + do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; + rewrite H4; reflexivity. +intros; unfold constant_D_eq, open_interval in |- *; intros; + unfold constant_D_eq, open_interval in H6; + assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat). +simpl in |- *; simpl in H0; apply lt_n_S; assumption. +assert (H10 := H6 _ H9); apply H10; assumption. Qed. -Lemma StepFun_P8 : (f:R->R;l1,lf1:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> a==b -> (Int_SF lf1 l1)==R0. -Induction l1. -Intros; Induction lf1; Reflexivity. -Induction r0. -Intros; Induction lf1. -Reflexivity. -Unfold adapted_couple in H0; Decompose [and] H0; Clear H0; Simpl in H5; Discriminate. -Intros; Induction lf1. -Reflexivity. -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; Case (total_order_Rle a b); Intro; [Assumption | Reflexivity]. -Unfold adapted_couple in H1; Decompose [and] H1; Intros; Apply Rle_antisym. -Apply (H3 O); 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; Right; Left; Reflexivity] | Unfold Rmin Rmax; Case (total_order_Rle b b); Case (total_order_Rle a b); Intros; Try Assumption Orelse Reflexivity]. +Lemma StepFun_P8 : + forall (f:R -> R) (l1 lf1:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0. +simple induction l1. +intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity. +simple induction r0. +intros; induction lf1 as [| r1 lf1 Hreclf1]. +reflexivity. +unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5; + discriminate. +intros; induction lf1 as [| r3 lf1 Hreclf1]. +reflexivity. +simpl in |- *; cut (r = r1). +intro; rewrite H3; rewrite (H0 lf1 r b). +ring. +rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ]. +clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1; + intros; simpl in H4; rewrite H4; unfold Rmin in |- *; + case (Rle_dec a b); intro; [ assumption | reflexivity ]. +unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym. +apply (H3 0%nat); simpl in |- *; apply lt_O_Sn. +simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b); + [ rewrite <- H4; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ] + | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros; + try assumption || reflexivity ]. Qed. -Lemma StepFun_P9 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> ``a<>b`` -> (le (2) (Rlength l)). -Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Induction l; [Simpl in H4; Discriminate | Induction l; [Simpl in H3; Simpl in H2; Generalize H3; Generalize H2; Unfold Rmin Rmax; Case (total_order_Rle a b); Intros; Elim H0; Rewrite <- H5; Rewrite <- H7; Reflexivity | Simpl; Do 2 Apply le_n_S; Apply le_O_n]]. +Lemma StepFun_P9 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat. +intros; unfold adapted_couple in H; decompose [and] H; clear H; + induction l as [| r l Hrecl]; + [ simpl in H4; discriminate + | induction l as [| r0 l Hrecl0]; + [ simpl in H3; simpl in H2; generalize H3; generalize H2; + unfold Rmin, Rmax in |- *; case (Rle_dec a b); + intros; elim H0; rewrite <- H5; rewrite <- H7; + reflexivity + | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ]. Qed. -Lemma StepFun_P10 : (f:R->R;l,lf:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))). -Induction l. -Intros; Unfold adapted_couple in H0; Decompose [and] H0; Simpl in H4; Discriminate. -Intros; Case (Req_EM a b); Intro. -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; Rewrite <- H2; Unfold Rmin; Case (total_order_Rle a a); Intro; Reflexivity. -Simpl; Rewrite <- H2; Unfold Rmax; Case (total_order_Rle a a); Intro; Reflexivity. -Elim (RList_P20 ? (StepFun_P9 H1 H2)); Intros t1 [t2 [t3 H3]]; Induction lf. -Unfold adapted_couple in H1; Decompose [and] H1; Rewrite H3 in H7; Simpl in H7; Discriminate. -Clear Hreclf; Assert H4 : (adapted_couple f t2 b r0 lf). -Rewrite H3 in H1; Assert H4 := (RList_P21 ? ? H3); Simpl in H4; Rewrite H4; EApply StepFun_P7; [Apply H0 | Apply H1]. -Cut ``t2<=b``. -Intro; Assert H6 := (H ? ? ? H5 H4); Case (Req_EM t1 t2); Intro Hyp_eq. -Replace a with t2. -Apply H6. -Rewrite <- Hyp_eq; Rewrite H3 in H1; Unfold adapted_couple in H1; Decompose [and] H1; Clear H1; Simpl in H9; Rewrite H9; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Elim H6; Clear H6; Intros l' [lf' H6]; Case (Req_EM t2 b); Intro. -Exists (cons a (cons b nil)); Exists (cons r1 nil); Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)]. -Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Intros; Simpl in H8; Inversion H8. -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 O). -Simpl; Apply lt_O_Sn. -Unfold open_interval; Simpl; Rewrite H7; Simpl in H13; Rewrite H13; Unfold Rmin; Case (total_order_Rle 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; Assumption | Elim (le_Sn_O ? H10)]. -Assert Hyp_min : (Rmin t2 b)==t2. -Unfold Rmin; Case (total_order_Rle t2 b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold adapted_couple in H6; Elim H6; Clear H6; Intros; Elim (RList_P20 ? (StepFun_P9 H6 H7)); Intros s1 [s2 [s3 H9]]; Induction lf'. -Unfold adapted_couple in H6; Decompose [and] H6; Rewrite H9 in H13; Simpl in H13; Discriminate. -Clear Hreclf'; Case (Req_EM r1 r2); Intro. -Case (Req_EM (f t2) r1); Intro. -Exists (cons t1 (cons s2 s3)); Exists (cons r1 lf'); Rewrite H3 in H1; Rewrite H9 in H6; Unfold adapted_couple in H6 H1; Decompose [and] H1; Decompose [and] H6; Clear H1 H6; Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H1; Induction i. -Simpl; Apply Rle_trans with s1. -Replace s1 with t2. -Apply (H12 O). -Simpl; Apply lt_O_Sn. -Simpl in H19; Rewrite H19; Symmetry; Apply Hyp_min. -Apply (H16 O); 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 (total_order_Rle a b); Case (total_order_Rle t2 b); Intros; Reflexivity Orelse Elim n; Assumption. -Simpl; Simpl in H20; Apply H20. -Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i. -Simpl; Simpl in H6; Case (total_order_T x t2); Intro. -Elim s; Intro. -Apply (H17 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Elim H6; Intros; Split; Assumption]. -Rewrite b0; Assumption. -Rewrite H10; Apply (H22 O); [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; 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)``; Rewrite <- H9; Elim H8; Intros; Apply H6; Simpl; Apply H1. -Intros; Induction i. -Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym. -Apply (H12 O); Simpl; Apply lt_O_Sn. -Rewrite <- Hyp_min; Rewrite H6; Simpl in H19; Rewrite <- H19; Apply (H16 O); 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; Unfold adapted_couple; Repeat Split. -Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i. -Simpl; Replace s1 with t2. -Apply (H16 O); 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))``; Apply (H12 i); Simpl; Apply lt_S_n; Assumption. -Simpl; Simpl in H19; Apply H19. -Rewrite H9; Simpl; Simpl in H13; Rewrite H13; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption. -Rewrite H9; Simpl; Simpl in H15; Rewrite H15; Reflexivity. -Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i. -Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H22 O). -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); 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. -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; Apply lt_S_n; Apply H1. -Intros; Rewrite H9; Induction i. -Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym. -Apply (H16 O); 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; 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; Unfold adapted_couple; Repeat Split. -Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i. -Simpl; Replace s1 with t2. -Apply (H15 O); 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))``; Apply (H11 i); Simpl; Apply lt_S_n; Assumption. -Simpl; Simpl in H18; Apply H18. -Rewrite H9; Simpl; Simpl in H12; Rewrite H12; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption. -Rewrite H9; Simpl; Simpl in H14; Rewrite H14; Reflexivity. -Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i. -Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H21 O). -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); 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. -Simpl; Left; Assumption. -Elim H8; Intros; Apply (H6 i). -Simpl; Apply lt_S_n; Apply H1. -Intros; Rewrite H9; Induction i. -Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym. -Apply (H15 O); 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; 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; Right; Left; Reflexivity] | Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]]. +Lemma StepFun_P10 : + forall (f:R -> R) (l lf:Rlist) (a b:R), + a <= b -> + adapted_couple f a b l lf -> + exists l' : Rlist + | ( exists lf' : Rlist | adapted_couple_opt f a b l' lf'). +simple induction l. +intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4; + discriminate. +intros; case (Req_dec a b); intro. +exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *; + unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; + repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)). +simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro; + reflexivity. +simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro; + reflexivity. +elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]]; + induction lf as [| r1 lf Hreclf]. +unfold adapted_couple in H1; decompose [and] H1; rewrite H3 in H7; + simpl in H7; discriminate. +clear Hreclf; assert (H4 : adapted_couple f t2 b r0 lf). +rewrite H3 in H1; assert (H4 := RList_P21 _ _ H3); simpl in H4; rewrite H4; + eapply StepFun_P7; [ apply H0 | apply H1 ]. +cut (t2 <= b). +intro; assert (H6 := H _ _ _ H5 H4); case (Req_dec t1 t2); intro Hyp_eq. +replace a with t2. +apply H6. +rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1; + decompose [and] H1; clear H1; simpl in H9; rewrite H9; + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro. +exists (cons a (cons b nil)); exists (cons r1 nil); + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +intros; simpl in H8; inversion H8. +unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1; + decompose [and] H1; apply (H16 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13; + rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); + intro; [ assumption | elim n; assumption ]. +elim (le_Sn_O _ H10). +intros; simpl in H8; elim (lt_n_O _ H8). +intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. +assert (Hyp_min : Rmin t2 b = t2). +unfold Rmin in |- *; case (Rle_dec t2 b); intro; + [ reflexivity | elim n; assumption ]. +unfold adapted_couple in H6; elim H6; clear H6; intros; + elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]]; + induction lf' as [| r2 lf' Hreclf']. +unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13; + simpl in H13; discriminate. +clear Hreclf'; case (Req_dec r1 r2); intro. +case (Req_dec (f t2) r1); intro. +exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1; + rewrite H9 in H6; unfold adapted_couple in H6, H1; + decompose [and] H1; decompose [and] H6; clear H1 H6; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. +simpl in |- *; apply Rle_trans with s1. +replace s1 with t2. +apply (H12 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H19; rewrite H19; symmetry in |- *; apply Hyp_min. +apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; + apply (H16 (S i)); simpl in |- *; assumption. +simpl in |- *; simpl in H14; rewrite H14; reflexivity. +simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *; + case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n; + assumption. +simpl in |- *; simpl in H20; apply H20. +intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; simpl in H6; case (total_order_T x t2); intro. +elim s; intro. +apply (H17 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split; + assumption ]. +rewrite b0; assumption. +rewrite H10; apply (H22 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; replace s1 with t2; + [ elim H6; intros; split; assumption + | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ]. +simpl in |- *; simpl in H6; apply (H22 (S i)); + [ simpl in |- *; assumption + | unfold open_interval in |- *; simpl in |- *; apply H6 ]. +intros; simpl in H1; rewrite H10; + change + (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/ + f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i) + in |- *; rewrite <- H9; elim H8; intros; apply H6; + simpl in |- *; apply H1. +intros; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. +apply (H12 0%nat); simpl in |- *; apply lt_O_Sn. +rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19; + apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *; + simpl in H1; apply H1. +exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; + decompose [and] H6; decompose [and] H1; clear H6 H1; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. +simpl in |- *; replace s1 with t2. +apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. +change + (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) + in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; + assumption. +simpl in |- *; simpl in H19; apply H19. +rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *; + case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; + assumption. +rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity. +intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *. +replace t2 with s1. +assumption. +simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. +change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i). +simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. +rewrite H9 in H6; unfold open_interval in |- *; apply H6. +intros; simpl in H1; induction i as [| i Hreci]. +simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2. +assumption. +simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. +elim H8; intros; apply (H6 i). +simpl in |- *; apply lt_S_n; apply H1. +intros; rewrite H9; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. +apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. +rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right; + reflexivity. +elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1; + simpl in |- *; simpl in H1; apply lt_S_n; apply H1. +exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; + decompose [and] H6; decompose [and] H1; clear H6 H1; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. +rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. +simpl in |- *; replace s1 with t2. +apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. +simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. +change + (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) + in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; + assumption. +simpl in |- *; simpl in H18; apply H18. +rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *; + case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; + assumption. +rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity. +intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; replace t2 with s1. +assumption. +simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. +change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i). +simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. +rewrite H9 in H6; unfold open_interval in |- *; apply H6. +intros; simpl in H1; induction i as [| i Hreci]. +simpl in |- *; left; assumption. +elim H8; intros; apply (H6 i). +simpl in |- *; apply lt_S_n; apply H1. +intros; rewrite H9; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. +apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. +rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right; + reflexivity. +elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1; + simpl in |- *; simpl in H1; apply lt_S_n; apply H1. +rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1; + clear H1; clear H H7 H9; cut (Rmax a b = b); + [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ] + | unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] ]. Qed. -Lemma StepFun_P11 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``. -Intros; Unfold adapted_couple_opt in H1; Elim H1; Clear H1; Intros; Unfold adapted_couple in H0 H1; Decompose [and] H0; Decompose [and] H1; Clear H0 H1; Assert H12 : r==s1. -Simpl in H10; Simpl in H5; Rewrite H10; Rewrite H5; Reflexivity. -Assert H14 := (H3 O (lt_O_Sn ?)); Simpl in H14; Elim H14; Intro. -Assert H15 := (H7 O (lt_O_Sn ?)); Simpl in H15; Elim H15; Intro. -Rewrite <- H12 in H1; Case (total_order_Rle r1 s2); Intro; Try Assumption. -Assert H16 : ``s2<r1``; Auto with real. -Induction s3. -Simpl in H9; Rewrite H9 in H16; Cut ``r1<=(Rmax a b)``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H17 H16)). -Rewrite <- H4; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity]. -Clear Hrecs3; Induction lf2. -Simpl in H11; Discriminate. -Clear Hreclf2; Assert H17 : r3==r4. -Pose x := ``(r+s2)/2``; Assert H17 := (H8 O (lt_O_Sn ?)); Assert H18 := (H13 O (lt_O_Sn ?)); Unfold constant_D_eq open_interval in H17 H18; Simpl in H17; Simpl in H18; Rewrite <- (H17 x). -Rewrite <- (H18 x). -Reflexivity. -Rewrite <- H12; Unfold x; Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Unfold x; Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Apply Rlt_trans with s2; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]] | Assumption]. -Assert H18 : (f s2)==r3. -Apply (H8 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Split; Assumption]. -Assert H19 : r3 == r5. -Assert H19 := (H7 (S O)); Simpl in H19; Assert H20 := (H19 (lt_n_S ? ? (lt_O_Sn ?))); Elim H20; Intro. -Pose x := ``(s2+(Rmin r1 r0))/2``; Assert H22 := (H8 O); Assert H23 := (H13 (S O)); Simpl in H22; Simpl in H23; Rewrite <- (H22 (lt_O_Sn ?) x). -Rewrite <- (H23 (lt_n_S ? ? (lt_O_Sn ?)) x). -Reflexivity. -Unfold open_interval; Simpl; Unfold x; Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r0+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_r] | DiscrR]]. -Unfold open_interval; Simpl; Unfold x; Split. -Apply Rlt_trans with s2; [Assumption | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r1+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_l] | DiscrR]]. -Elim H2; Clear H2; Intros; Assert H23 := (H22 (S O)); Simpl in H23; Assert H24 := (H23 (lt_n_S ? ? (lt_O_Sn ?))); Elim H24; Assumption. -Elim H2; Intros; Assert H22 := (H20 O); Simpl in H22; Assert H23 := (H22 (lt_O_Sn ?)); Elim H23; Intro; [Elim H24; Rewrite <- H17; Rewrite <- H19; Reflexivity | Elim H24; Rewrite <- H17; Assumption]. -Elim H2; Clear H2; Intros; Assert H17 := (H16 O); Simpl in H17; Elim (H17 (lt_O_Sn ?)); Assumption. -Rewrite <- H0; Rewrite H12; Apply (H7 O); Simpl; Apply lt_O_Sn. +Lemma StepFun_P11 : + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + (f:R -> R), + a < b -> + adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> + adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. +intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros; + unfold adapted_couple in H0, H1; decompose [and] H0; + decompose [and] H1; clear H0 H1; assert (H12 : r = s1). +simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity. +assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro. +assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro. +rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption. +assert (H16 : s2 < r1); auto with real. +induction s3 as [| r0 s3 Hrecs3]. +simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)). +rewrite <- H4; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2]. +simpl in H11; discriminate. +clear Hreclf2; assert (H17 : r3 = r4). +pose (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _)); + assert (H18 := H13 0%nat (lt_O_Sn _)); + unfold constant_D_eq, open_interval in H17, H18; simpl in H17; + simpl in H18; rewrite <- (H17 x). +rewrite <- (H18 x). +reflexivity. +rewrite <- H12; unfold x in |- *; split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +unfold x in |- *; split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rlt_trans with s2; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ] + | assumption ]. +assert (H18 : f s2 = r3). +apply (H8 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; split; assumption ]. +assert (H19 : r3 = r5). +assert (H19 := H7 1%nat); simpl in H19; + assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; + intro. +pose (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat); + assert (H23 := H13 1%nat); simpl in H22; simpl in H23; + rewrite <- (H22 (lt_O_Sn _) x). +rewrite <- (H23 (lt_n_S _ _ (lt_O_Sn _)) x). +reflexivity. +unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + unfold Rmin in |- *; case (Rle_dec r1 r0); intro; + assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + apply Rlt_le_trans with (r0 + Rmin r1 r0); + [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; + assumption + | apply Rplus_le_compat_l; apply Rmin_r ] + | discrR ] ]. +unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. +apply Rlt_trans with s2; + [ assumption + | apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + unfold Rmin in |- *; case (Rle_dec r1 r0); + intro; assumption + | discrR ] ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + apply Rlt_le_trans with (r1 + Rmin r1 r0); + [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; + assumption + | apply Rplus_le_compat_l; apply Rmin_l ] + | discrR ] ]. +elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23; + assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; + assumption. +elim H2; intros; assert (H22 := H20 0%nat); simpl in H22; + assert (H23 := H22 (lt_O_Sn _)); elim H23; intro; + [ elim H24; rewrite <- H17; rewrite <- H19; reflexivity + | elim H24; rewrite <- H17; assumption ]. +elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17; + elim (H17 (lt_O_Sn _)); assumption. +rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn. Qed. -Lemma StepFun_P12 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple_opt f a b l lf) -> (adapted_couple_opt f b a l lf). -Unfold adapted_couple_opt; Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption. -Rewrite H0; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity. -Apply Rle_antisym; Assumption. -Apply Rle_antisym; Auto with real. -Rewrite H3; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity. -Apply Rle_antisym; Assumption. -Apply Rle_antisym; Auto with real. +Lemma StepFun_P12 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf. +unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros; + decompose [and] H; clear H; repeat split; try assumption. +rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. +rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. +apply Rle_antisym; assumption. +apply Rle_antisym; auto with real. Qed. -Lemma StepFun_P13 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<>b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``. -Intros; Case (total_order_T a b); Intro. -Elim s; Intro. -EApply StepFun_P11; [Apply a0 | Apply H0 | Apply H1]. -Elim H; Assumption. -EApply StepFun_P11; [Apply r0 | Apply StepFun_P2; Apply H0 | Apply StepFun_P12; Apply H1]. +Lemma StepFun_P13 : + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + (f:R -> R), + a <> b -> + adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> + adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. +intros; case (total_order_T a b); intro. +elim s; intro. +eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ]. +elim H; assumption. +eapply StepFun_P11; + [ apply r0 | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ]. Qed. -Lemma StepFun_P14 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2). -Induction l1. -Intros l2 lf1 lf2 a b Hyp H H0; Unfold adapted_couple in H; Decompose [and] H; Clear H H0 H2 H3 H1 H6; Simpl in H4; Discriminate. -Induction r0. -Intros; Case (Req_EM a b); Intro. -Unfold adapted_couple_opt in H2; Elim H2; Intros; Rewrite (StepFun_P8 H4 H3); Rewrite (StepFun_P8 H1 H3); Reflexivity. -Assert H4 := (StepFun_P9 H1 H3); Simpl in H4; Elim (le_Sn_O ? (le_S_n ? ? H4)). -Intros; Clear H; Unfold adapted_couple_opt in H3; Elim H3; Clear H3; Intros; Case (Req_EM a b); Intro. -Rewrite (StepFun_P8 H2 H4); Rewrite (StepFun_P8 H H4); Reflexivity. -Assert Hyp_min : (Rmin a b)==a. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert Hyp_max : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle 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. -Unfold adapted_couple in H2; Decompose [and] H2; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate. -Clear Hreclf1; Induction lf2. -Unfold adapted_couple in H; Decompose [and] H; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate. -Clear Hreclf2; Assert H6 : r==s1. -Unfold adapted_couple in H H2; Decompose [and] H; Decompose [and] H2; Clear H H2; Simpl in H13; Simpl in H8; Rewrite H13; Rewrite H8; Reflexivity. -Assert H7 : r3==r4\/r==r1. -Case (Req_EM r r1); Intro. -Right; Assumption. -Left; Cut ``r1<=s2``. -Intro; Unfold adapted_couple in H2 H; Decompose [and] H; Decompose [and] H2; Clear H H2; Pose x := ``(r+r1)/2``; Assert H18 := (H14 O); Assert H20 := (H19 O); Unfold constant_D_eq open_interval in H18 H20; Simpl in H18; Simpl in H20; Rewrite <- (H18 (lt_O_Sn ?) x). -Rewrite <- (H20 (lt_O_Sn ?) x). -Reflexivity. -Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]]. -Rewrite <- H6; Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]]. -Apply Rlt_le_trans with r1; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]] | Assumption]. -EApply StepFun_P13. -Apply H4. -Apply H2. -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; Split. -Apply H. -Rewrite H5 in H3; Apply H3. -Elim H7; 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_plus_r; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))); 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; Right; Left; Reflexivity]. -EApply StepFun_P7. -Apply H1. -Apply H2. -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; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H; Induction i. -Simpl; Rewrite <- H20; Apply (H11 O). -Simpl; Apply lt_O_Sn. -Induction i. -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; Rewrite H19; Reflexivity. -Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i. -Simpl; Apply (H16 O). -Simpl; Apply lt_O_Sn. -Simpl in H2; Rewrite <- H20 in H2; Unfold open_interval; Simpl; Apply H2. -Clear Hreci; Induction i. -Simpl; Simpl in H2; Rewrite H9; Apply (H21 O). -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 O); Simpl; Apply lt_O_Sn. -Assumption. -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 (i:nat) (lt i (pred (Rlength (cons r4 lf2)))) ->``(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)``; Rewrite <- H5; Apply H3. -Rewrite H5 in H11; Intros; Simpl in H12; Induction i. -Simpl; Red; Intro; Rewrite H13 in H10; Elim (Rlt_antirefl ? H10). -Clear Hreci; Apply (H11 (S i)); Simpl; Apply H12. -Rewrite H9; Rewrite H10; Rewrite H6; Apply Rplus_plus_r; 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; Right; Left; Reflexivity]. -EApply StepFun_P7. -Apply H1. -Apply H2. -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; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H; Induction i. -Simpl; Rewrite <- H20; Apply (H11 O); Simpl; Apply lt_O_Sn. -Rewrite H10; Apply (H15 (S i)); Simpl; Assumption. -Simpl; Symmetry; Apply Hyp_min. -Rewrite <- H17; Rewrite H10; Reflexivity. -Simpl in H19; Simpl; Apply H19. -Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i. -Simpl; Apply (H16 O). -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; Replace (Rlength lf2) with (S (pred (Rlength lf2))). -Apply lt_n_S; Apply H12. -Symmetry; Apply S_pred with O; 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; Apply lt_n_S; Apply H12. -Simpl; Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))); EApply H0. -Apply H1. -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 2 a; Rewrite <- H10; Pattern 2 r; Rewrite H9; Apply H2]. +Lemma StepFun_P14 : + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + a <= b -> + adapted_couple f a b l1 lf1 -> + adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +simple induction l1. +intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H; + clear H H0 H2 H3 H1 H6; simpl in H4; discriminate. +simple induction r0. +intros; case (Req_dec a b); intro. +unfold adapted_couple_opt in H2; elim H2; intros; rewrite (StepFun_P8 H4 H3); + rewrite (StepFun_P8 H1 H3); reflexivity. +assert (H4 := StepFun_P9 H1 H3); simpl in H4; + elim (le_Sn_O _ (le_S_n _ _ H4)). +intros; clear H; unfold adapted_couple_opt in H3; elim H3; clear H3; intros; + case (Req_dec a b); intro. +rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity. +assert (Hyp_min : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (Hyp_max : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H; + rewrite H5; induction lf1 as [| r3 lf1 Hreclf1]. +unfold adapted_couple in H2; decompose [and] H2; + clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. +clear Hreclf1; induction lf2 as [| r4 lf2 Hreclf2]. +unfold adapted_couple in H; decompose [and] H; + clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. +clear Hreclf2; assert (H6 : r = s1). +unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2; + clear H H2; simpl in H13; simpl in H8; rewrite H13; + rewrite H8; reflexivity. +assert (H7 : r3 = r4 \/ r = r1). +case (Req_dec r r1); intro. +right; assumption. +left; cut (r1 <= s2). +intro; unfold adapted_couple in H2, H; decompose [and] H; decompose [and] H2; + clear H H2; pose (x := (r + r1) / 2); assert (H18 := H14 0%nat); + assert (H20 := H19 0%nat); unfold constant_D_eq, open_interval in H18, H20; + simpl in H18; simpl in H20; rewrite <- (H18 (lt_O_Sn _) x). +rewrite <- (H20 (lt_O_Sn _) x). +reflexivity. +assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro; + [ idtac | elim H7; assumption ]; unfold x in |- *; + split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; apply H + | discrR ] ]. +rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; + intro; [ idtac | elim H7; assumption ]; unfold x in |- *; + split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H + | discrR ] ]. +apply Rlt_le_trans with r1; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; apply H + | discrR ] ] + | assumption ]. +eapply StepFun_P13. +apply H4. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply H. +rewrite H5 in H3; apply H3. +assert (H8 : r1 <= s2). +eapply StepFun_P13. +apply H4. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply H. +rewrite H5 in H3; apply H3. +elim H7; intro. +simpl in |- *; elim H8; intro. +replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1)); + [ idtac | rewrite H9; rewrite H6; ring ]. +rewrite Rplus_assoc; apply Rplus_eq_compat_l; + change + (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))) + in |- *; apply H0 with r1 b. +unfold adapted_couple in H2; decompose [and] H2; clear H2; + replace b with (Rmax a b). +rewrite <- H12; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +eapply StepFun_P7. +apply H1. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply StepFun_P7 with a a r3. +apply H1. +unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; + clear H H2; assert (H20 : r = a). +simpl in H13; rewrite H13; apply Hyp_min. +unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; rewrite <- H20; apply (H11 0%nat). +simpl in |- *; apply lt_O_Sn. +induction i as [| i Hreci0]. +simpl in |- *; assumption. +change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; + apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption. +simpl in |- *; symmetry in |- *; apply Hyp_min. +rewrite <- H17; reflexivity. +simpl in H19; simpl in |- *; rewrite H19; reflexivity. +intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; apply (H16 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; + simpl in |- *; apply H2. +clear Hreci; induction i as [| i Hreci]. +simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; elim H2; intros; split. +apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat); + simpl in |- *; apply lt_O_Sn. +assumption. +clear Hreci; simpl in |- *; apply (H21 (S i)). +simpl in |- *; apply lt_S_n; assumption. +unfold open_interval in |- *; apply H2. +elim H3; clear H3; intros; split. +rewrite H9; + change + (forall i:nat, + (i < pred (Rlength (cons r4 lf2)))%nat -> + pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/ + f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i) + in |- *; rewrite <- H5; apply H3. +rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci]. +simpl in |- *; red in |- *; intro; rewrite H13 in H10; + elim (Rlt_irrefl _ H10). +clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12. +rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10; + apply H0 with r1 b. +unfold adapted_couple in H2; decompose [and] H2; clear H2; + replace b with (Rmax a b). +rewrite <- H12; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. +eapply StepFun_P7. +apply H1. +apply H2. +unfold adapted_couple_opt in |- *; split. +apply StepFun_P7 with a a r3. +apply H1. +unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; + clear H H2; assert (H20 : r = a). +simpl in H13; rewrite H13; apply Hyp_min. +unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *; + apply lt_O_Sn. +rewrite H10; apply (H15 (S i)); simpl in |- *; assumption. +simpl in |- *; symmetry in |- *; apply Hyp_min. +rewrite <- H17; rewrite H10; reflexivity. +simpl in H19; simpl in |- *; apply H19. +intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; apply (H16 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; + simpl in |- *; apply H2. +clear Hreci; simpl in |- *; apply (H21 (S i)). +simpl in |- *; assumption. +rewrite <- H10; unfold open_interval in |- *; apply H2. +elim H3; clear H3; intros; split. +rewrite H5 in H3; intros; apply (H3 (S i)). +simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))). +apply lt_n_S; apply H12. +symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H13 in H12; elim (lt_n_O _ H12). +intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i)); + simpl in |- *; apply lt_n_S; apply H12. +simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; + change + (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))) + in |- *; eapply H0. +apply H1. +2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption. +assert (H10 : r = a). +unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12; + rewrite H12; apply Hyp_min. +rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3; + [ apply H1 + | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9; + apply H2 ]. Qed. -Lemma StepFun_P15 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2). -Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P14 r H H0) | Assert H1 : ``b<=a``; [Auto with real | EApply StepFun_P14; [Apply H1 | Apply StepFun_P2; Apply H | Apply StepFun_P12; Apply H0]]]. +Lemma StepFun_P15 : + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> + adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +intros; case (Rle_dec a b); intro; + [ apply (StepFun_P14 r H H0) + | assert (H1 : b <= a); + [ auto with real + | eapply StepFun_P14; + [ apply H1 | apply StepFun_P2; apply H | apply StepFun_P12; apply H0 ] ] ]. Qed. -Lemma StepFun_P16 : (f:R->R;l,lf:Rlist;a,b:R) (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))). -Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P10 r H) | Assert H1 : ``b<=a``; [Auto with real | Assert H2 := (StepFun_P10 H1 (StepFun_P2 H)); Elim H2; Intros l' [lf' H3]; Exists l'; Exists lf'; Apply StepFun_P12; Assumption]]. +Lemma StepFun_P16 : + forall (f:R -> R) (l lf:Rlist) (a b:R), + adapted_couple f a b l lf -> + exists l' : Rlist + | ( exists lf' : Rlist | adapted_couple_opt f a b l' lf'). +intros; case (Rle_dec a b); intro; + [ apply (StepFun_P10 r H) + | assert (H1 : b <= a); + [ auto with real + | assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2; + intros l' [lf' H3]; exists l'; exists lf'; apply StepFun_P12; + assumption ] ]. Qed. -Lemma StepFun_P17 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2). -Intros; Elim (StepFun_P16 H); Intros l' [lf' H1]; Rewrite (StepFun_P15 H H1); Rewrite (StepFun_P15 H0 H1); Reflexivity. +Lemma StepFun_P17 : + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> + adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1); + rewrite (StepFun_P15 H0 H1); reflexivity. Qed. -Lemma StepFun_P18 : (a,b,c:R) (RiemannInt_SF (mkStepFun (StepFun_P4 a b c)))==``c*(b-a)``. -Intros; Unfold RiemannInt_SF; Case (total_order_Rle 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; Ring | Apply StepFun_P17 with (fct_cte c) a b; [Apply StepFun_P3; Assumption | Apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c)))]]. -Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons b (cons a nil))); [Simpl; 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)))]]. +Lemma StepFun_P18 : + forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a). +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) + (subdivision (mkStepFun (StepFun_P4 a b c)))) with + (Int_SF (cons c nil) (cons a (cons b nil))); + [ simpl in |- *; ring + | apply StepFun_P17 with (fct_cte c) a b; + [ apply StepFun_P3; assumption + | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. +replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) + (subdivision (mkStepFun (StepFun_P4 a b c)))) with + (Int_SF (cons c nil) (cons b (cons a nil))); + [ simpl in |- *; ring + | apply StepFun_P17 with (fct_cte c) a b; + [ apply StepFun_P2; apply StepFun_P3; auto with real + | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. Qed. -Lemma StepFun_P19 : (l1:Rlist;f,g:R->R;l:R) (Int_SF (FF l1 [x:R]``(f x)+l*(g x)``) l1)==``(Int_SF (FF l1 f) l1)+l*(Int_SF (FF l1 g) l1)``. -Intros; Induction l1; [Simpl; Ring | Induction l1; Simpl; [Ring | Simpl in Hrecl1; Rewrite Hrecl1; Ring]]. +Lemma StepFun_P19 : + forall (l1:Rlist) (f g:R -> R) (l:R), + Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 = + Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1. +intros; induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; ring + | induction l1 as [| r0 l1 Hrecl0]; simpl in |- *; + [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ]. Qed. -Lemma StepFun_P20 : (l:Rlist;f:R->R) (lt O (Rlength l)) -> (Rlength l)=(S (Rlength (FF l f))). -Intros l f H; NewInduction l; [Elim (lt_n_n ? H) | Simpl; Rewrite RList_P18; Rewrite RList_P14; Reflexivity]. +Lemma StepFun_P20 : + forall (l:Rlist) (f:R -> R), + (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)). +intros l f H; induction l; + [ elim (lt_irrefl _ H) + | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ]. Qed. -Lemma StepFun_P21 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (adapted_couple f a b l (FF l f)). -Intros; Unfold adapted_couple; 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; Intros; Induction l. -Discriminate. -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 Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons r l) i)); Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]]. -Rewrite RList_P14; Simpl in H3; Apply H3. +Lemma StepFun_P21 : + forall (a b:R) (f:R -> R) (l:Rlist), + is_subdivision f a b l -> adapted_couple f a b l (FF l f). +intros; unfold adapted_couple in |- *; unfold is_subdivision in X; + unfold adapted_couple in X; elim X; clear X; intros; + decompose [and] p; clear p; repeat split; try assumption. +apply StepFun_P20; rewrite H2; apply lt_O_Sn. +intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5; + unfold constant_D_eq, open_interval in |- *; intros; + induction l as [| r l Hrecl]. +discriminate. +unfold FF in |- *; rewrite RList_P12. +simpl in |- *; + change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *; + rewrite RList_P13; try assumption; rewrite (H5 x0 H6); + rewrite H5. +reflexivity. +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6; + intros; apply Rlt_trans with x0; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons r l) i)); + apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0; + assumption + | discrR ] ]. +rewrite RList_P14; simpl in H3; apply H3. Qed. -Lemma StepFun_P22 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)). -Unfold is_subdivision; 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert Hyp_max : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Apply existTT 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; Repeat Split. -Apply RList_P2; Assumption. -Rewrite Hyp_min; Symmetry; Apply Rle_antisym. -Induction lf. -Simpl; Right; Symmetry; Assumption. -Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)). -Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [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))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption]. -Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption]. -Induction lf. -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 O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn]. -Apply RList_P5; [Apply RList_P2; Assumption | Assumption]. -Rewrite Hyp_max; Apply Rle_antisym. -Induction lf. -Simpl; Right; Assumption. -Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)). -Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros _ H10; Apply H10; Exists (pred (Rlength (cons_ORlist (cons r lf) lg))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn]. -Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _. -Assert H11 := (H10 H8); Elim H11; Intro. -Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Simpl; 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) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros. -Rewrite H15; Assert H17 : (Rlength lg)=(S (pred (Rlength lg))). -Apply S_pred with O; 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. -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; 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; Apply lt_O_Sn. -Intros; Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq f (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)). -Intros; Elim H11; Clear H11; Intros; Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))). -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; 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); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``. -Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite (H11 ? H15); Reflexivity. -Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)). -Apply H8. -Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8. -Assert H11 : ``a<b``. -Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). -Rewrite <- H6; Rewrite <- (RList_P15 lf lg). -Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11. -Apply RList_P2; Assumption. -Apply le_O_n. -Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)]. -Assumption. -Assumption. -Rewrite H1; Assumption. -Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -Elim H10; Intros; Apply Rlt_trans with x; Assumption. -Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption. -Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11. -Apply RList_P2; Assumption. -Apply lt_n_Sm_le; Apply lt_n_S; Assumption. -Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8). -Rewrite H0; Assumption. -Pose I := [j:nat]``(pos_Rl lf j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lf)); Assert H12 : (Nbound I). -Unfold Nbound; Exists (Rlength lf); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption. -Assert H13 : (EX n:nat | (I n)). -Exists O; Unfold I; Split. -Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O). -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; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8). -Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H5; Rewrite <- H6 in H11; Rewrite <- H5 in H11; Elim (Rlt_antirefl ? H11). -Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lf0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H9 x0); Assert H17 : (lt x0 (pred (Rlength lf))). -Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Apply lt_S_n; Replace (S (pred (Rlength lf))) with (Rlength lf). -Inversion H18. -2:Apply lt_n_S; Assumption. -Cut x0=(pred (Rlength lf)). -Intro; Rewrite H19 in H14; Rewrite H5 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)). -Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -Elim H10; Intros; Apply Rlt_trans with x; Assumption. -Rewrite <- H5; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). -Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H21. -Apply RList_P2; Assumption. -Apply lt_n_Sm_le; Apply lt_n_S; Assumption. -Apply lt_pred_n_n; Apply neq_O_lt; Red; 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 O; 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). -Reflexivity. -Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split. -Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption. -Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption. -Assert H22 : (lt (S x0) (Rlength lf)). -Replace (Rlength lf) with (S (pred (Rlength lf))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21)]. -Elim (total_order_Rle (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro. -Assert H23 : (le (S x0) x0). -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. -Clear b0; Apply RList_P17; Try Assumption. -Apply RList_P2; Assumption. -Elim (RList_P9 lf lg (pos_Rl lf (S x0))); Intros; Apply H25; Left; Elim (RList_P3 lf (pos_Rl lf (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22]. +Lemma StepFun_P22 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + a <= b -> + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). +unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; + clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (Hyp_max : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; + repeat split. +apply RList_P2; assumption. +rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert + (H10 : + In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + apply H10; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. +elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H12 _; assert (H13 := H12 H10); elim H13; intro. +elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H11 _; assert (H14 := H11 H8); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H6; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption | apply le_O_n | assumption ]. +elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + intros; apply H17; [ assumption | apply le_O_n | assumption ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert (H8 : In a (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; + elim (RList_P3 (cons r lf) a); intros; apply H12; + exists 0%nat; split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. +apply RList_P5; [ apply RList_P2; assumption | assumption ]. +rewrite Hyp_max; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert + (H8 : + In + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg)))) + (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros _ H10; apply H10; + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P9 (cons r lf) lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H10 _. +assert (H11 := H10 H8); elim H11; intro. +elim + (RList_P3 (cons r lf) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H5; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption + | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption + | simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P3 lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros. +rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))). +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H17 in H16; elim (lt_n_O _ H16). +rewrite <- H0; elim (RList_P6 lg); intros; apply H18; + [ assumption + | rewrite H17 in H16; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert (H8 : In b (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; + elim (RList_P3 (cons r lf) b); intros; apply H12; + exists (pred (Rlength (cons r lf))); split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. +apply RList_P7; [ apply RList_P2; assumption | assumption ]. +apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *; + apply lt_O_Sn. +intros; unfold constant_D_eq, open_interval in |- *; intros; + cut + ( exists l : R + | constant_D_eq f + (open_interval (pos_Rl (cons_ORlist lf lg) i) + (pos_Rl (cons_ORlist lf lg) (S i))) l). +intros; elim H11; clear H11; intros; assert (H12 := H11); + assert + (Hyp_cons : + exists r : R | ( exists r0 : Rlist | cons_ORlist lf lg = cons r r0)). +apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). +elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; + unfold FF in |- *; rewrite RList_P12. +change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; + rewrite <- Hyp_cons; rewrite RList_P13. +assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. +unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); + assert + (H15 : + pos_Rl (cons_ORlist lf lg) i < + (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < + pos_Rl (cons_ORlist lf lg) (S i)). +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite (H11 _ H15); reflexivity. +elim H10; intros; rewrite H14 in H15; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). +apply H8. +rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. +assert (H11 : a < b). +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). +rewrite <- H6; rewrite <- (RList_P15 lf lg). +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. +assumption. +assumption. +rewrite H1; assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; + elim (lt_n_O _ H8). +rewrite H0; assumption. +pose + (I := + fun j:nat => + pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat); + assert (H12 : Nbound I). +unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12; + intros; apply lt_le_weak; assumption. +assert (H13 : exists n : nat | I n). +exists 0%nat; unfold I in |- *; split. +apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). +right; symmetry in |- *. +apply RList_P15; try assumption; rewrite H1; assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13. +apply RList_P2; assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength (cons_ORlist lf lg))). +assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8; + elim (lt_n_O _ H8). +apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5; + rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11). +assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; + exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; + intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat). +elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; + apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf). +inversion H18. +2: apply lt_n_S; assumption. +cut (x0 = pred (Rlength lf)). +intro; rewrite H19 in H14; rewrite H5 in H14; + cut (pos_Rl (cons_ORlist lf lg) i < b). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H5; + apply Rle_trans with + (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; + elim (lt_n_O _ H8). +right; apply RList_P16; try assumption; rewrite H0; assumption. +rewrite <- H20; reflexivity. +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H19 in H18; elim (lt_n_O _ H18). +assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + rewrite (H18 x1). +reflexivity. +elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; + elim H14; clear H14; intros; split. +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. +assert (H22 : (S x0 < Rlength lf)%nat). +replace (Rlength lf) with (S (pred (Rlength lf))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ]. +elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. +assert (H23 : (S x0 <= x0)%nat). +apply H20; unfold I in |- *; split; assumption. +elim (le_Sn_n _ H23). +assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)). +auto with real. +clear b0; apply RList_P17; try assumption. +apply RList_P2; assumption. +elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left; + elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; + exists (S x0); split; [ reflexivity | apply H22 ]. Qed. -Lemma StepFun_P23 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)). -Intros; Case (total_order_Rle a b); Intro; [Apply StepFun_P22 with g; Assumption | Apply StepFun_P5; Apply StepFun_P22 with g; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]]. +Lemma StepFun_P23 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). +intros; case (Rle_dec a b); intro; + [ apply StepFun_P22 with g; assumption + | apply StepFun_P5; apply StepFun_P22 with g; + [ auto with real + | apply StepFun_P5; assumption + | apply StepFun_P5; assumption ] ]. Qed. -Lemma StepFun_P24 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)). -Unfold is_subdivision; 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert Hyp_max : (Rmax a b)==b. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Apply existTT 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; Repeat Split. -Apply RList_P2; Assumption. -Rewrite Hyp_min; Symmetry; Apply Rle_antisym. -Induction lf. -Simpl; Right; Symmetry; Assumption. -Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)). -Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [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))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption]. -Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption]. -Induction lf. -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 O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn]. -Apply RList_P5; [Apply RList_P2; Assumption | Assumption]. -Rewrite Hyp_max; Apply Rle_antisym. -Induction lf. -Simpl; Right; Assumption. -Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)). -Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros _ H10; Apply H10; Exists (pred (Rlength (cons_ORlist (cons r lf) lg))); Split; [Reflexivity | Rewrite RList_P11; Simpl; Apply lt_n_Sn]. -Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _; Assert H11 := (H10 H8); Elim H11; Intro. -Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Simpl; 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) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Assert H17 : (Rlength lg)=(S (pred (Rlength lg))). -Apply S_pred with O; 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. -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; 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; Apply lt_O_Sn. -Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq g (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)). -Intros; Elim H11; Clear H11; Intros; Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))). -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; 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); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``. -Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite (H11 ? H15); Reflexivity. -Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)). -Apply H8. -Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8. -Assert H11 : ``a<b``. -Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). -Rewrite <- H6; Rewrite <- (RList_P15 lf lg); Try Assumption. -Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11. -Apply RList_P2; Assumption. -Apply le_O_n. -Apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [Assumption | Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)]. -Rewrite H1; Assumption. -Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -Elim H10; Intros; Apply Rlt_trans with x; Assumption. -Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption. -Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11. -Apply RList_P2; Assumption. -Apply lt_n_Sm_le; Apply lt_n_S; Assumption. -Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8). -Rewrite H0; Assumption. -Pose I := [j:nat]``(pos_Rl lg j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lg)); Assert H12 : (Nbound I). -Unfold Nbound; Exists (Rlength lg); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption. -Assert H13 : (EX n:nat | (I n)). -Exists O; Unfold I; Split. -Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O). -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; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8)]]. -Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H0; Rewrite <- H1 in H11; Rewrite <- H0 in H11; Elim (Rlt_antirefl ? H11). -Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lg0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H4 x0); Assert H17 : (lt x0 (pred (Rlength lg))). -Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Apply lt_S_n; Replace (S (pred (Rlength lg))) with (Rlength lg). -Inversion H18. -2:Apply lt_n_S; Assumption. -Cut x0=(pred (Rlength lg)). -Intro; Rewrite H19 in H14; Rewrite H0 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)). -Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -Elim H10; Intros; Apply Rlt_trans with x; Assumption. -Rewrite <- H0; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). -Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H21. -Apply RList_P2; Assumption. -Apply lt_n_Sm_le; Apply lt_n_S; Assumption. -Apply lt_pred_n_n; Apply neq_O_lt; Red; 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 O; 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). -Reflexivity. -Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split. -Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption. -Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption. -Assert H22 : (lt (S x0) (Rlength lg)). -Replace (Rlength lg) with (S (pred (Rlength lg))). -Apply lt_n_S; Assumption. -Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21). -Elim (total_order_Rle (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro. -Assert H23 : (le (S x0) x0); [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; [Apply RList_P2; Assumption | Elim (RList_P9 lf lg (pos_Rl lg (S x0))); Intros; Apply H25; Right; Elim (RList_P3 lg (pos_Rl lg (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22]]. +Lemma StepFun_P24 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + a <= b -> + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). +unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; + clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (Hyp_max : Rmax a b = b). +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; + repeat split. +apply RList_P2; assumption. +rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert + (H10 : + In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + apply H10; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. +elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H12 _; assert (H13 := H12 H10); elim H13; intro. +elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H11 _; assert (H14 := H11 H8); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H6; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption | apply le_O_n | assumption ]. +elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + intros; apply H17; [ assumption | apply le_O_n | assumption ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert (H8 : In a (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; + elim (RList_P3 (cons r lf) a); intros; apply H12; + exists 0%nat; split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. +apply RList_P5; [ apply RList_P2; assumption | assumption ]. +rewrite Hyp_max; apply Rle_antisym. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; assumption. +assert + (H8 : + In + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg)))) + (cons_ORlist (cons r lf) lg)). +elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros _ H10; apply H10; + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P9 (cons r lf) lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H10 _; assert (H11 := H10 H8); elim H11; intro. +elim + (RList_P3 (cons r lf) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H5; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption + | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption + | simpl in |- *; apply lt_n_Sn ]. +elim + (RList_P3 lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; + assert (H17 : Rlength lg = S (pred (Rlength lg))). +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H17 in H16; elim (lt_n_O _ H16). +rewrite <- H0; elim (RList_P6 lg); intros; apply H18; + [ assumption + | rewrite H17 in H16; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. +induction lf as [| r lf Hreclf]. +simpl in |- *; right; symmetry in |- *; assumption. +assert (H8 : In b (cons_ORlist (cons r lf) lg)). +elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; + elim (RList_P3 (cons r lf) b); intros; apply H12; + exists (pred (Rlength (cons r lf))); split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. +apply RList_P7; [ apply RList_P2; assumption | assumption ]. +apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *; + apply lt_O_Sn. +unfold constant_D_eq, open_interval in |- *; intros; + cut + ( exists l : R + | constant_D_eq g + (open_interval (pos_Rl (cons_ORlist lf lg) i) + (pos_Rl (cons_ORlist lf lg) (S i))) l). +intros; elim H11; clear H11; intros; assert (H12 := H11); + assert + (Hyp_cons : + exists r : R | ( exists r0 : Rlist | cons_ORlist lf lg = cons r r0)). +apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). +elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; + unfold FF in |- *; rewrite RList_P12. +change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; + rewrite <- Hyp_cons; rewrite RList_P13. +assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. +unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); + assert + (H15 : + pos_Rl (cons_ORlist lf lg) i < + (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < + pos_Rl (cons_ORlist lf lg) (S i)). +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite (H11 _ H15); reflexivity. +elim H10; intros; rewrite H14 in H15; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). +apply H8. +rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. +assert (H11 : a < b). +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). +rewrite <- H6; rewrite <- (RList_P15 lf lg); try assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply le_O_n. +apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. +rewrite H1; assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; + elim (lt_n_O _ H8). +rewrite H0; assumption. +pose + (I := + fun j:nat => + pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat); + assert (H12 : Nbound I). +unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12; + intros; apply lt_le_weak; assumption. +assert (H13 : exists n : nat | I n). +exists 0%nat; unfold I in |- *; split. +apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). +right; symmetry in |- *; rewrite H1; rewrite <- H6; apply RList_P15; + try assumption; rewrite H1; assumption. +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13; + [ apply RList_P2; assumption + | apply le_O_n + | apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ]. +apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0; + rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11). +assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; + exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; + intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat). +elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; + apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg). +inversion H18. +2: apply lt_n_S; assumption. +cut (x0 = pred (Rlength lg)). +intro; rewrite H19 in H14; rewrite H0 in H14; + cut (pos_Rl (cons_ORlist lf lg) i < b). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). +elim H10; intros; apply Rlt_trans with x; assumption. +rewrite <- H0; + apply Rle_trans with + (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). +elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. +apply RList_P2; assumption. +apply lt_n_Sm_le; apply lt_n_S; assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; + elim (lt_n_O _ H8). +right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption. +rewrite H0; assumption. +rewrite <- H20; reflexivity. +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H19 in H18; elim (lt_n_O _ H18). +assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + rewrite (H18 x1). +reflexivity. +elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; + elim H14; clear H14; intros; split. +apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. +apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. +assert (H22 : (S x0 < Rlength lg)%nat). +replace (Rlength lg) with (S (pred (Rlength lg))). +apply lt_n_S; assumption. +symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H22 in H21; elim (lt_n_O _ H21). +elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. +assert (H23 : (S x0 <= x0)%nat); + [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ]. +assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)). +auto with real. +clear b0; apply RList_P17; try assumption; + [ apply RList_P2; assumption + | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right; + elim (RList_P3 lg (pos_Rl lg (S x0))); intros; + apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ]. Qed. -Lemma StepFun_P25 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)). -Intros a b f g lf lg H H0; Case (total_order_Rle a b); Intro; [Apply StepFun_P24 with f; Assumption | Apply StepFun_P5; Apply StepFun_P24 with f; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]]. +Lemma StepFun_P25 : + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). +intros a b f g lf lg H H0; case (Rle_dec a b); intro; + [ apply StepFun_P24 with f; assumption + | apply StepFun_P5; apply StepFun_P24 with f; + [ auto with real + | apply StepFun_P5; assumption + | apply StepFun_P5; assumption ] ]. Qed. -Lemma StepFun_P26 : (a,b,l:R;f,g:R->R;l1:Rlist) (is_subdivision f a b l1) -> (is_subdivision g a b l1) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b l1). -Intros a b l f g l1; Unfold is_subdivision; Intros; Elim X; Elim X0; Intros; Clear X X0; Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Apply existTT with (FF l1 [x:R]``(f x)+l*(g x)``); Unfold adapted_couple; Repeat Split; Try Assumption. -Apply StepFun_P20; Apply neq_O_lt; Red; Intro; Rewrite <- H8 in H7; Discriminate. -Intros; Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9 H4; Intros; Rewrite (H9 ? H8 ? H10); Rewrite (H4 ? H8 ? H10); Assert H11 : ~l1==nil. -Red; Intro; Rewrite H11 in H8; Elim (lt_n_O ? H8). -Assert H12 := (RList_P19 ? H11); Elim H12; Clear H12; Intros r [r0 H12]; Rewrite H12; Unfold FF; Change ``(pos_Rl x0 i)+l*(pos_Rl x i)`` == (pos_Rl (app_Rlist (mid_Rlist (cons r r0) r) [x2:R]``(f x2)+l*(g x2)``) (S i)); Rewrite RList_P12. -Rewrite RList_P13. -Rewrite <- H12; Rewrite (H9 ? H8); Try Rewrite (H4 ? H8); Reflexivity Orelse (Elim H10; Clear H10; Intros; Split; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]] | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl l1 i)); Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]]]). -Rewrite <- H12; Assumption. -Rewrite RList_P14; Simpl; Rewrite H12 in H8; Simpl in H8; Apply lt_n_S; Apply H8. +Lemma StepFun_P26 : + forall (a b l:R) (f g:R -> R) (l1:Rlist), + is_subdivision f a b l1 -> + is_subdivision g a b l1 -> + is_subdivision (fun x:R => f x + l * g x) a b l1. +intros a b l f g l1; unfold is_subdivision in |- *; intros; elim X; elim X0; + intros; clear X X0; unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + apply existT with (FF l1 (fun x:R => f x + l * g x)); + unfold adapted_couple in |- *; repeat split; try assumption. +apply StepFun_P20; apply neq_O_lt; red in |- *; intro; rewrite <- H8 in H7; + discriminate. +intros; unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9, H4; intros; + rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); + assert (H11 : l1 <> nil). +red in |- *; intro; rewrite H11 in H8; elim (lt_n_O _ H8). +assert (H12 := RList_P19 _ H11); elim H12; clear H12; intros r [r0 H12]; + rewrite H12; unfold FF in |- *; + change + (pos_Rl x0 i + l * pos_Rl x i = + pos_Rl + (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2)) + (S i)) in |- *; rewrite RList_P12. +rewrite RList_P13. +rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8); + reflexivity || + (elim H10; clear H10; intros; split; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + apply Rlt_trans with x1; assumption + | discrR ] ] + | apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l; + apply Rlt_trans with x1; assumption + | discrR ] ] ]). +rewrite <- H12; assumption. +rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8; + apply lt_n_S; apply H8. Qed. -Lemma StepFun_P27 : (a,b,l:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b (cons_ORlist lf lg)). -Intros a b l f g lf lg H H0; Apply StepFun_P26; [Apply StepFun_P23 with g; Assumption | Apply StepFun_P25 with f; Assumption]. +Lemma StepFun_P27 : + forall (a b l:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> + is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg). +intros a b l f g lf lg H H0; apply StepFun_P26; + [ apply StepFun_P23 with g; assumption + | apply StepFun_P25 with f; assumption ]. Qed. (* The set of step functions on [a,b] is a vectorial space *) -Lemma StepFun_P28 : (a,b,l:R;f,g:(StepFun a b)) (IsStepFun [x:R]``(f x)+l*(g x)`` a b). -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 Specif.existT with (cons_ORlist x0 x); Apply StepFun_P27; Assumption. +Lemma StepFun_P28 : + forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b. +intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f); + assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; + elim H0; intros; apply existT with (cons_ORlist x0 x); + apply StepFun_P27; assumption. Qed. -Lemma StepFun_P29 : (a,b:R;f:(StepFun a b)) (is_subdivision f a b (subdivision f)). -Intros a b f; Unfold is_subdivision; Apply existTT with (subdivision_val f); Apply StepFun_P1. +Lemma StepFun_P29 : + forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). +intros a b f; unfold is_subdivision in |- *; + apply existT with (subdivision_val f); apply StepFun_P1. Qed. -Lemma StepFun_P30 : (a,b,l:R;f,g:(StepFun a b)) ``(RiemannInt_SF (mkStepFun (StepFun_P28 l f g)))==(RiemannInt_SF f)+l*(RiemannInt_SF g)``. -Intros a b l f g; Unfold RiemannInt_SF; Case (total_order_Rle a b); (Intro; Replace ``(Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) (subdivision (mkStepFun (StepFun_P28 l f g))))`` with (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) [x:R]``(f x)+l*(g x)``) (cons_ORlist (subdivision f) (subdivision g))); [Rewrite StepFun_P19; Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val f) (subdivision f)); [Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val g) (subdivision g)); [Ring | Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P25 with (fe f); Apply StepFun_P29]] | Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P23 with (fe g); Apply StepFun_P29]] | Apply StepFun_P17 with [x:R]``(f x)+l*(g x)`` a b; [Apply StepFun_P21; Apply StepFun_P27; Apply StepFun_P29 | Apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g)))]]). +Lemma StepFun_P30 : + forall (a b l:R) (f g:StepFun a b), + RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) = + RiemannInt_SF f + l * RiemannInt_SF g. +intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + (intro; + replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) + (subdivision (mkStepFun (StepFun_P28 l f g)))) with + (Int_SF + (FF (cons_ORlist (subdivision f) (subdivision g)) + (fun x:R => f x + l * g x)) + (cons_ORlist (subdivision f) (subdivision g))); + [ rewrite StepFun_P19; + replace + (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) + (cons_ORlist (subdivision f) (subdivision g))) with + (Int_SF (subdivision_val f) (subdivision f)); + [ replace + (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) + (cons_ORlist (subdivision f) (subdivision g))) with + (Int_SF (subdivision_val g) (subdivision g)); + [ ring + | apply StepFun_P17 with (fe g) a b; + [ apply StepFun_P1 + | apply StepFun_P21; apply StepFun_P25 with (fe f); + apply StepFun_P29 ] ] + | apply StepFun_P17 with (fe f) a b; + [ apply StepFun_P1 + | apply StepFun_P21; apply StepFun_P23 with (fe g); + apply StepFun_P29 ] ] + | apply StepFun_P17 with (fun x:R => f x + l * g x) a b; + [ apply StepFun_P21; apply StepFun_P27; apply StepFun_P29 + | apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g))) ] ]). Qed. -Lemma StepFun_P31 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple [x:R](Rabsolu (f x)) a b l (app_Rlist lf Rabsolu)). -Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption. -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]. +Lemma StepFun_P31 : + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> + adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs). +unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + repeat split; try assumption. +symmetry in |- *; rewrite H3; rewrite RList_P18; reflexivity. +intros; unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H5; intros; + rewrite (H5 _ H _ H4); rewrite RList_P12; + [ reflexivity | rewrite H3 in H; simpl in H; apply H ]. Qed. -Lemma StepFun_P32 : (a,b:R;f:(StepFun a b)) (IsStepFun [x:R](Rabsolu (f x)) a b). -Intros a b f; Unfold IsStepFun; Apply Specif.existT with (subdivision f); Unfold is_subdivision; Apply existTT with (app_Rlist (subdivision_val f) Rabsolu); Apply StepFun_P31; Apply StepFun_P1. +Lemma StepFun_P32 : + forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b. +intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f); + unfold is_subdivision in |- *; + apply existT with (app_Rlist (subdivision_val f) Rabs); + apply StepFun_P31; apply StepFun_P1. Qed. -Lemma StepFun_P33 : (l2,l1:Rlist) (ordered_Rlist l1) -> ``(Rabsolu (Int_SF l2 l1))<=(Int_SF (app_Rlist l2 Rabsolu) l1)``. -Induction l2; Intros. -Simpl; Rewrite Rabsolu_R0; Right; Reflexivity. -Simpl; Induction l1. -Rewrite Rabsolu_R0; Right; Reflexivity. -Induction l1. -Rewrite Rabsolu_R0; Right; Reflexivity. -Apply Rle_trans with ``(Rabsolu (r*(r2-r1)))+(Rabsolu (Int_SF r0 (cons r2 l1)))``. -Apply Rabsolu_triang. -Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``r2-r1``); [Apply Rle_compatibility; Apply H; Apply RList_P4 with r1; Assumption | Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn]. +Lemma StepFun_P33 : + forall l2 l1:Rlist, + ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1. +simple induction l2; intros. +simpl in |- *; rewrite Rabs_R0; right; reflexivity. +simpl in |- *; induction l1 as [| r1 l1 Hrecl1]. +rewrite Rabs_R0; right; reflexivity. +induction l1 as [| r2 l1 Hrecl0]. +rewrite Rabs_R0; right; reflexivity. +apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))). +apply Rabs_triang. +rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1)); + [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption + | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; + apply lt_O_Sn ]. Qed. -Lemma StepFun_P34 : (a,b:R;f:(StepFun a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt_SF f))<=(RiemannInt_SF (mkStepFun (StepFun_P32 f)))``. -Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro. -Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with (Int_SF (app_Rlist (subdivision_val f) Rabsolu) (subdivision f)). -Apply StepFun_P33; Assert H0 := (StepFun_P29 f); Unfold is_subdivision in H0; Elim H0; Intros; Unfold adapted_couple in p; Decompose [and] p; Assumption. -Apply StepFun_P17 with [x:R](Rabsolu (f x)) a b; [Apply StepFun_P31; Apply StepFun_P1 | Apply (StepFun_P1 (mkStepFun (StepFun_P32 f)))]. -Elim n; Assumption. +Lemma StepFun_P34 : + forall (a b:R) (f:StepFun a b), + a <= b -> + Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) + (subdivision (mkStepFun (StepFun_P32 f)))) with + (Int_SF (app_Rlist (subdivision_val f) Rabs) (subdivision f)). +apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0; + elim H0; intros; unfold adapted_couple in p; decompose [and] p; + assumption. +apply StepFun_P17 with (fun x:R => Rabs (f x)) a b; + [ apply StepFun_P31; apply StepFun_P1 + | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ]. +elim n; assumption. Qed. -Lemma StepFun_P35 : (l:Rlist;a,b:R;f,g:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(Int_SF (FF l f) l)<=(Int_SF (FF l g) l)``. -Induction l; Intros. -Right; Reflexivity. -Simpl; Induction r0. -Right; Reflexivity. -Simpl; Apply Rplus_le. -Case (Req_EM r r0); Intro. -Rewrite H4; Right; Ring. -Do 2 Rewrite <- (Rmult_sym ``r0-r``); Apply Rle_monotony. -Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn. -Apply H3; Split. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Assert H5 : r==a. -Apply H1. -Rewrite H5; Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility. -Assert H6 := (H0 O (lt_O_Sn ?)). -Simpl in H6. -Elim H6; Intro. -Rewrite H5 in H7; Apply H7. -Elim H4; Assumption. -DiscrR. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite double; Assert H5 : ``r0<=b``. -Replace b with (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))). -Replace r0 with (pos_Rl (cons r (cons r0 r1)) (S O)). -Elim (RList_P6 (cons r (cons r0 r1))); Intros; Apply H5. -Assumption. -Simpl; Apply le_n_S. -Apply le_O_n. -Simpl; Apply lt_n_Sn. -Reflexivity. -Apply Rle_lt_trans with ``r+b``. -Apply Rle_compatibility; Assumption. -Rewrite (Rplus_sym r); Apply Rlt_compatibility. -Apply Rlt_le_trans with r0. -Assert H6 := (H0 O (lt_O_Sn ?)). -Simpl in H6. -Elim H6; Intro. -Apply H7. -Elim H4; Assumption. -Assumption. -DiscrR. -Simpl in H; Apply H with r0 b. -Apply RList_P4 with r; Assumption. -Reflexivity. -Rewrite <- H2; Reflexivity. -Intros; Apply H3; Elim H4; Intros; Split; Try Assumption. -Apply Rle_lt_trans with r0; Try Assumption. -Rewrite <- H1. -Simpl; Apply (H0 O); Simpl; Apply lt_O_Sn. +Lemma StepFun_P35 : + forall (l:Rlist) (a b:R) (f g:R -> R), + ordered_Rlist l -> + pos_Rl l 0 = a -> + pos_Rl l (pred (Rlength l)) = b -> + (forall x:R, a < x < b -> f x <= g x) -> + Int_SF (FF l f) l <= Int_SF (FF l g) l. +simple induction l; intros. +right; reflexivity. +simpl in |- *; induction r0 as [| r0 r1 Hrecr0]. +right; reflexivity. +simpl in |- *; apply Rplus_le_compat. +case (Req_dec r r0); intro. +rewrite H4; right; ring. +do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l. +apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; + apply lt_O_Sn. +apply H3; split. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +assert (H5 : r = a). +apply H1. +rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l. +assert (H6 := H0 0%nat (lt_O_Sn _)). +simpl in H6. +elim H6; intro. +rewrite H5 in H7; apply H7. +elim H4; assumption. +discrR. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b). +replace b with + (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))). +replace r0 with (pos_Rl (cons r (cons r0 r1)) 1). +elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5. +assumption. +simpl in |- *; apply le_n_S. +apply le_O_n. +simpl in |- *; apply lt_n_Sn. +reflexivity. +apply Rle_lt_trans with (r + b). +apply Rplus_le_compat_l; assumption. +rewrite (Rplus_comm r); apply Rplus_lt_compat_l. +apply Rlt_le_trans with r0. +assert (H6 := H0 0%nat (lt_O_Sn _)). +simpl in H6. +elim H6; intro. +apply H7. +elim H4; assumption. +assumption. +discrR. +simpl in H; apply H with r0 b. +apply RList_P4 with r; assumption. +reflexivity. +rewrite <- H2; reflexivity. +intros; apply H3; elim H4; intros; split; try assumption. +apply Rle_lt_trans with r0; try assumption. +rewrite <- H1. +simpl in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn. Qed. -Lemma StepFun_P36 : (a,b:R;f,g:(StepFun a b);l:Rlist) ``a<=b`` -> (is_subdivision f a b l) -> (is_subdivision g a b l) -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``. -Intros; Unfold RiemannInt_SF; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Assert H7 : (Rmax a b)==b; [Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Rewrite H5 in H3; Rewrite H7 in H2; EApply StepFun_P35 with a b; Assumption]]. -Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1]. -Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1]. -Elim n; Assumption. +Lemma StepFun_P36 : + forall (a b:R) (f g:StepFun a b) (l:Rlist), + a <= b -> + is_subdivision f a b l -> + is_subdivision g a b l -> + (forall x:R, a < x < b -> f x <= g x) -> + RiemannInt_SF f <= RiemannInt_SF g. +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l). +replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l). +unfold is_subdivision in X; elim X; clear X; intros; + unfold adapted_couple in p; decompose [and] p; clear p; + assert (H5 : Rmin a b = a); + [ unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] + | assert (H7 : Rmax a b = b); + [ unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] + | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b; + assumption ] ]. +apply StepFun_P17 with (fe g) a b; + [ apply StepFun_P21; assumption | apply StepFun_P1 ]. +apply StepFun_P17 with (fe f) a b; + [ apply StepFun_P21; assumption | apply StepFun_P1 ]. +elim n; assumption. Qed. -Lemma StepFun_P37 : (a,b:R;f,g:(StepFun a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``. -Intros; EApply StepFun_P36; Try Assumption. -EApply StepFun_P25; Apply StepFun_P29. -EApply StepFun_P23; Apply StepFun_P29. +Lemma StepFun_P37 : + forall (a b:R) (f g:StepFun a b), + a <= b -> + (forall x:R, a < x < b -> f x <= g x) -> + RiemannInt_SF f <= RiemannInt_SF g. +intros; eapply StepFun_P36; try assumption. +eapply StepFun_P25; apply StepFun_P29. +eapply StepFun_P23; apply StepFun_P29. Qed. -Lemma StepFun_P38 : (l:Rlist;a,b:R;f:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) (f (pos_Rl l i)))). -Intros l a b f; Generalize a; Clear a; NewInduction l. -Intros a H H0 H1; Simpl in H0; Simpl in H1; Exists (mkStepFun (StepFun_P4 a b (f b))); Split. -Reflexivity. -Intros; Elim (lt_n_O ? H2). -Intros; NewDestruct l as [|r1 l]. -Simpl in H1; Simpl in H0; Exists (mkStepFun (StepFun_P4 a b (f b))); Split. -Reflexivity. -Intros i H2; Elim (lt_n_O ? H2). -Intros; Assert H2 : (ordered_Rlist (cons r1 l)). -Apply RList_P4 with r; Assumption. -Assert H3 : (pos_Rl (cons r1 l) O)==r1. -Reflexivity. -Assert H4 : (pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))))==b. -Rewrite <- H1; Reflexivity. -Elim (IHl r1 H2 H3 H4); Intros g [H5 H6]. -Pose g' := [x:R]Cases (total_order_Rle r1 x) of - | (leftT _) => (g x) - | (rightT _) => (f a) end. -Assert H7 : ``r1<=b``. -Rewrite <- H4; Apply RList_P7; [Assumption | Left; Reflexivity]. -Assert H8 : (IsStepFun g' a b). -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; Split with (cons (f a) lg2); Unfold adapted_couple in H9; Decompose [and] H9; Clear H9; Unfold adapted_couple; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H9; Induction i. -Simpl; Rewrite H12; Replace (Rmin r1 b) with r1. -Simpl in H0; Rewrite <- H0; Apply (H O); Simpl; Apply lt_O_Sn. -Unfold Rmin; Case (total_order_Rle 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 O; Apply neq_O_lt; Intro; Rewrite <- H14 in H9; Elim (lt_n_O ? H9). -Simpl; Assert H14 : ``a<=b``. -Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Assert H14 : ``a<=b``. -Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity]. -Replace (Rmax a b) with (Rmax r1 b). -Rewrite <- H11; Induction lg. -Simpl in H13; Discriminate. -Reflexivity. -Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle r1 b); Intros; Reflexivity Orelse Elim n; Assumption. -Simpl; Rewrite H13; Reflexivity. -Intros; Simpl in H9; Induction i. -Unfold constant_D_eq open_interval; Simpl; Intros; Assert H16 : (Rmin r1 b)==r1. -Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n; Assumption]. -Rewrite H16 in H12; Rewrite H12 in H14; Elim H14; Clear H14; Intros _ H14; Unfold g'; Case (total_order_Rle r1 x); Intro r3. -Elim (Rlt_antirefl ? (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)); Clear Hreci; Assert H16 := (H15 i); Assert H17 : (lt i (pred (Rlength lg))). -Apply lt_S_n. -Replace (S (pred (Rlength lg))) with (Rlength lg). -Assumption. -Apply S_pred with O; 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; Intros; Assert H19 := (H18 ? H14); Rewrite <- H19; Unfold g'; Case (total_order_Rle r1 x); Intro. -Reflexivity. -Elim n; Replace r1 with (Rmin r1 b). -Rewrite <- H12; Elim H14; Clear H14; Intros H14 _; Left; Apply Rle_lt_trans with (pos_Rl lg i); Try Assumption. -Apply RList_P5. -Assumption. -Elim (RList_P3 lg (pos_Rl lg i)); Intros; Apply H21; Exists i; Split. -Reflexivity. -Apply lt_trans with (pred (Rlength lg)); Try Assumption. -Apply lt_pred_n_n; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H17; Elim (lt_n_O ? H17). -Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n0; Assumption]. -Exists (mkStepFun H8); Split. -Simpl; Unfold g'; Case (total_order_Rle r1 b); Intro. -Assumption. -Elim n; Assumption. -Intros; Simpl in H9; Induction i. -Unfold constant_D_eq co_interval; Simpl; Intros; Simpl in H0; Rewrite H0; Elim H10; Clear H10; Intros; Unfold g'; Case (total_order_Rle r1 x); Intro r3. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H11)). -Reflexivity. -Clear Hreci; Change (constant_D_eq (mkStepFun H8) (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) (f (pos_Rl (cons r1 l) i))); Assert H10 := (H6 i); Assert H11 : (lt i (pred (Rlength (cons r1 l)))). -Simpl; Apply lt_S_n; Assumption. -Assert H12 := (H10 H11); Unfold constant_D_eq co_interval in H12; Unfold constant_D_eq co_interval; Intros; Rewrite <- (H12 ? H13); Simpl; Unfold g'; Case (total_order_Rle 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) O)<=(pos_Rl (cons r1 l) i)``; Elim (RList_P6 (cons r1 l)); Intros; Apply H15; [Assumption | Apply le_O_n | Simpl; Apply lt_trans with (Rlength l); [Apply lt_S_n; Assumption | Apply lt_n_Sn]]. +Lemma StepFun_P38 : + forall (l:Rlist) (a b:R) (f:R -> R), + ordered_Rlist l -> + pos_Rl l 0 = a -> + pos_Rl l (pred (Rlength l)) = b -> + sigT + (fun g:StepFun a b => + g b = f b /\ + (forall i:nat, + (i < pred (Rlength l))%nat -> + constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) + (f (pos_Rl l i)))). +intros l a b f; generalize a; clear a; induction l. +intros a H H0 H1; simpl in H0; simpl in H1; + exists (mkStepFun (StepFun_P4 a b (f b))); split. +reflexivity. +intros; elim (lt_n_O _ H2). +intros; destruct l as [| r1 l]. +simpl in H1; simpl in H0; exists (mkStepFun (StepFun_P4 a b (f b))); split. +reflexivity. +intros i H2; elim (lt_n_O _ H2). +intros; assert (H2 : ordered_Rlist (cons r1 l)). +apply RList_P4 with r; assumption. +assert (H3 : pos_Rl (cons r1 l) 0 = r1). +reflexivity. +assert (H4 : pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))) = b). +rewrite <- H1; reflexivity. +elim (IHl r1 H2 H3 H4); intros g [H5 H6]. +pose + (g' := + fun x:R => match Rle_dec r1 x with + | left _ => g x + | right _ => f a + end). +assert (H7 : r1 <= b). +rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ]. +assert (H8 : IsStepFun g' a b). +unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8; + elim H8; intros lg H9; unfold is_subdivision in H9; + elim H9; clear H9; intros lg2 H9; split with (cons a lg); + unfold is_subdivision in |- *; split with (cons (f a) lg2); + unfold adapted_couple in H9; decompose [and] H9; clear H9; + unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H9; + induction i as [| i Hreci]. +simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1. +simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn. +unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n; assumption ]. +apply (H10 i); apply lt_S_n. +replace (S (pred (Rlength lg))) with (Rlength lg). +apply H9. +apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9; + elim (lt_n_O _ H9). +simpl in |- *; assert (H14 : a <= b). +rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; + [ assumption | left; reflexivity ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +assert (H14 : a <= b). +rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; + [ assumption | left; reflexivity ]. +replace (Rmax a b) with (Rmax r1 b). +rewrite <- H11; induction lg as [| r0 lg Hreclg]. +simpl in H13; discriminate. +reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros; + reflexivity || elim n; assumption. +simpl in |- *; rewrite H13; reflexivity. +intros; simpl in H9; induction i as [| i Hreci]. +unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros; + assert (H16 : Rmin r1 b = r1). +unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n; assumption ]. +rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14; + unfold g' in |- *; case (Rle_dec r1 x); intro r3. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)). +reflexivity. +change + (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) + (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i); + assert (H17 : (i < pred (Rlength lg))%nat). +apply lt_S_n. +replace (S (pred (Rlength lg))) with (Rlength lg). +assumption. +apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H14 in H9; elim (lt_n_O _ H9). +assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + unfold constant_D_eq, open_interval in |- *; intros; + assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *; + case (Rle_dec r1 x); intro. +reflexivity. +elim n; replace r1 with (Rmin r1 b). +rewrite <- H12; elim H14; clear H14; intros H14 _; left; + apply Rle_lt_trans with (pos_Rl lg i); try assumption. +apply RList_P5. +assumption. +elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split. +reflexivity. +apply lt_trans with (pred (Rlength lg)); try assumption. +apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H22 in H17; + elim (lt_n_O _ H17). +unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n0; assumption ]. +exists (mkStepFun H8); split. +simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro. +assumption. +elim n; assumption. +intros; simpl in H9; induction i as [| i Hreci]. +unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0; + rewrite H0; elim H10; clear H10; intros; unfold g' in |- *; + case (Rle_dec r1 x); intro r3. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)). +reflexivity. +clear Hreci; + change + (constant_D_eq (mkStepFun H8) + (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) + (f (pos_Rl (cons r1 l) i))) in |- *; assert (H10 := H6 i); + assert (H11 : (i < pred (Rlength (cons r1 l)))%nat). +simpl in |- *; apply lt_S_n; assumption. +assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12; + unfold constant_D_eq, co_interval in |- *; intros; + rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *; + case (Rle_dec r1 x); intro. +reflexivity. +elim n; elim H13; clear H13; intros; + apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption; + change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *; + elim (RList_P6 (cons r1 l)); intros; apply H15; + [ assumption + | apply le_O_n + | simpl in |- *; apply lt_trans with (Rlength l); + [ apply lt_S_n; assumption | apply lt_n_Sn ] ]. Qed. -Lemma StepFun_P39 : (a,b:R;f:(StepFun a b)) (RiemannInt_SF f)==(Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))))). -Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros. -Assert H : (adapted_couple f a b (subdivision f) (subdivision_val f)); [Apply StepFun_P1 | Assert H0 : (adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a (subdivision (mkStepFun (StepFun_P6 (pre f)))) (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); [Apply StepFun_P1 | Assert H1 : a==b; [Apply Rle_antisym; Assumption | Rewrite (StepFun_P8 H H1); Assert H2 : b==a; [Symmetry; Apply H1 | Rewrite (StepFun_P8 H0 H2); Ring]]]]. -Rewrite Ropp_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Assert H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0]. -Apply eq_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Assert H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0]. -Assert H : ``a<b``; [Auto with real | Assert H0 : ``b<a``; [Auto with real | Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H0))]]. +Lemma StepFun_P39 : + forall (a b:R) (f:StepFun a b), + RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))). +intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a); + intros. +assert (H : adapted_couple f a b (subdivision f) (subdivision_val f)); + [ apply StepFun_P1 + | assert + (H0 : + adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a + (subdivision (mkStepFun (StepFun_P6 (pre f)))) + (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); + [ apply StepFun_P1 + | assert (H1 : a = b); + [ apply Rle_antisym; assumption + | rewrite (StepFun_P8 H H1); assert (H2 : b = a); + [ symmetry in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ]. +rewrite Ropp_involutive; eapply StepFun_P17; + [ apply StepFun_P1 + | apply StepFun_P2; assert (H := StepFun_P6 (pre f)); unfold IsStepFun in H; + elim H; intros; unfold is_subdivision in |- *; + elim p; intros; apply p0 ]. +apply Ropp_eq_compat; eapply StepFun_P17; + [ apply StepFun_P1 + | apply StepFun_P2; assert (H := StepFun_P6 (pre f)); unfold IsStepFun in H; + elim H; intros; unfold is_subdivision in |- *; + elim p; intros; apply p0 ]. +assert (H : a < b); + [ auto with real + | assert (H0 : b < a); + [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ]. Qed. -Lemma StepFun_P40 : (f:R->R;a,b,c:R;l1,l2,lf1,lf2:Rlist) ``a<b`` -> ``b<c`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple f b c l2 lf2) -> (adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f)). -Intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; Unfold adapted_couple in H1 H2; Unfold adapted_couple; Decompose [and] H1; Decompose [and] H2; Clear H1 H2; Repeat Split. -Apply RList_P25; Try Assumption. -Rewrite H10; Rewrite H4; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; (Right; Reflexivity) Orelse (Elim n; Left; Assumption). -Rewrite RList_P22. -Rewrite H5; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption]. -Red; Intro; Rewrite H1 in H6; Discriminate. -Rewrite RList_P24. -Rewrite H9; Unfold Rmin Rmax; Case (total_order_Rle b c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption]. -Red; Intro; Rewrite H1 in H11; Discriminate. -Apply StepFun_P20. -Rewrite RList_P23; Apply neq_O_lt; Red; Intro. -Assert H2 : (plus (Rlength l1) (Rlength l2))=O. -Symmetry; Apply H1. -Elim (plus_is_O ? ? H2); Intros; Rewrite H12 in H6; Discriminate. -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; Apply le_trans with (Rlength l1); [Assumption | Apply le_n_Sn]. -Assert H15 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l1 (S i)). -Apply RList_P26; Apply lt_S_n; Apply le_lt_n_Sm; Assumption. -Rewrite H14 in H2; Rewrite H15 in H2; Assert H16 : (le (2) (Rlength l1)). -Apply le_trans with (S (S i)); [Repeat Apply le_n_S; Apply le_O_n | Assumption]. -Elim (RList_P20 ? H16); Intros r1 [r2 [r3 H17]]; Rewrite H17; Change (f x)==(pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i); Rewrite RList_P12. -Induction i. -Simpl; Assert H18 := (H8 O); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt O (pred (Rlength l1))). -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 O). -Simpl; Apply lt_O_Sn. -Elim H21; Intro. -Split. -Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Elim H2; Intros; Rewrite H17 in H23; Rewrite H17 in H24; Simpl in H24; Simpl in H23; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)). -Assumption. -Clear Hreci; Rewrite RList_P13. -Rewrite H17 in H14; Rewrite H17 in H15; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)== (pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; Rewrite H14; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))==(pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; Rewrite H15; Assert H18 := (H8 (S i)); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt (S i) (pred (Rlength l1))). -Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption. -Assert H20 := (H18 H19); Repeat Rewrite H20. -Reflexivity. -Rewrite <- H17; Assert H21 : ``(pos_Rl l1 (S i))<=(pos_Rl l1 (S (S i)))``. -Apply (H3 (S i)); Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption. -Elim H21; Intro. -Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l1 (S i))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Elim H2; Intros; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)). -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; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Left; Assumption]. -Rewrite H15; Apply le_n. -Induction l1. -Simpl in H15; Discriminate. -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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption] | Rewrite H15; Reflexivity]. -Rewrite H15; Apply lt_n_Sn. -Rewrite H16 in H2; Rewrite H17 in H2; Elim H2; Intros; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H14 H18)). -Assert H16 : (pos_Rl (cons_Rlist l1 l2) i) == (pos_Rl l2 (minus i (Rlength l1))). -Apply RList_P29. -Apply le_S_n; Assumption. -Apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); [Assumption | Apply le_pred_n]. -Assert H17 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (S (minus i (Rlength l1)))). -Replace (S (minus i (Rlength l1))) with (minus (S i) (Rlength l1)). -Apply RList_P29. -Apply le_S_n; Apply le_trans with (S i); [Assumption | Apply le_n_Sn]. -Induction l1. -Simpl in H6; Discriminate. -Clear Hrecl1; Simpl in H1; Simpl; Apply lt_n_S; Assumption. -Symmetry; Apply minus_Sn_m; Apply le_S_n; Assumption. -Assert H18 : (le (2) (Rlength l1)). -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. -Discriminate. -Clear Hrecl1; Induction l1. -Simpl in H5; Simpl in H4; Assert H0 : ``(Rmin a b)<(Rmax a b)``. -Unfold Rmin Rmax; Case (total_order_Rle a b); Intro; [Assumption | Elim n; Left; Assumption]. -Rewrite <- H5 in H0; Rewrite <- H4 in H0; Elim (Rlt_antirefl ? H0). -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); Rewrite RList_P12. -Induction i. -Assert H20 := (le_S_n ? ? H15); Assert H21 := (le_trans ? ? ? H18 H20); Elim (le_Sn_O ? H21). -Clear Hreci; Rewrite RList_P13. -Rewrite H19 in H16; Rewrite H19 in H17; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)== (pos_Rl l2 (minus (S i) (Rlength (cons r1 (cons r2 r3))))) in H16; Rewrite H16; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))== (pos_Rl l2 (S (minus (S i) (Rlength (cons r1 (cons r2 r3)))))) in H17; Rewrite H17; Assert H20 := (H13 (minus (S i) (Rlength l1))); Unfold constant_D_eq open_interval in H20; Assert H21 : (lt (minus (S i) (Rlength l1)) (pred (Rlength l2))). -Apply lt_pred; Rewrite minus_Sn_m. -Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus. -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. -Assert H22 := (H20 H21); Repeat Rewrite H22. -Reflexivity. -Rewrite <- H19; Assert H23 : ``(pos_Rl l2 (minus (S i) (Rlength l1)))<=(pos_Rl l2 (S (minus (S i) (Rlength l1))))``. -Apply H7; Apply lt_pred. -Rewrite minus_Sn_m. -Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus. -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. -Elim H23; Intro. -Split. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l2 (minus (S i) (Rlength l1)))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]]. -Rewrite <- H19 in H16; Rewrite <- H19 in H17; Elim H2; Intros; Rewrite H19 in H25; Rewrite H19 in H26; Simpl in H25; Simpl in H16; Rewrite H16 in H25; Simpl in H26; Simpl in H17; Rewrite H17 in H26; Simpl in H24; Rewrite H24 in H25; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H25 H26)). -Assert H23 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (minus (S i) (Rlength l1))). -Rewrite H19; Simpl; Simpl in H16; Apply H16. -Assert H24 : (pos_Rl (cons_Rlist l1 l2) (S (S i)))==(pos_Rl l2 (S (minus (S i) (Rlength l1)))). -Rewrite H19; Simpl; Simpl in H17; Apply H17. -Rewrite <- H23; Rewrite <- H24; Assumption. -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. +Lemma StepFun_P40 : + forall (f:R -> R) (a b c:R) (l1 l2 lf1 lf2:Rlist), + a < b -> + b < c -> + adapted_couple f a b l1 lf1 -> + adapted_couple f b c l2 lf2 -> + adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f). +intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2; + unfold adapted_couple in |- *; decompose [and] H1; + decompose [and] H2; clear H1 H2; repeat split. +apply RList_P25; try assumption. +rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b); + case (Rle_dec b c); intros; + (right; reflexivity) || (elim n; left; assumption). +rewrite RList_P22. +rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c); + intros; + [ reflexivity + | elim n; apply Rle_trans with b; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +red in |- *; intro; rewrite H1 in H6; discriminate. +rewrite RList_P24. +rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c); + intros; + [ reflexivity + | elim n; apply Rle_trans with b; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +red in |- *; intro; rewrite H1 in H11; discriminate. +apply StepFun_P20. +rewrite RList_P23; apply neq_O_lt; red in |- *; intro. +assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat). +symmetry in |- *; apply H1. +elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate. +unfold constant_D_eq, open_interval in |- *; intros; + elim (le_or_lt (S (S i)) (Rlength l1)); intro. +assert (H14 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i). +apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; apply le_S_n; + apply le_trans with (Rlength l1); [ assumption | apply le_n_Sn ]. +assert (H15 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l1 (S i)). +apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; assumption. +rewrite H14 in H2; rewrite H15 in H2; assert (H16 : (2 <= Rlength l1)%nat). +apply le_trans with (S (S i)); + [ repeat apply le_n_S; apply le_O_n | assumption ]. +elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17; + change + (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) + in |- *; rewrite RList_P12. +induction i as [| i Hreci]. +simpl in |- *; assert (H18 := H8 0%nat); + unfold constant_D_eq, open_interval in H18; + assert (H19 : (0 < pred (Rlength l1))%nat). +rewrite H17; simpl in |- *; apply lt_O_Sn. +assert (H20 := H18 H19); repeat rewrite H20. +reflexivity. +assert (H21 : r1 <= r2). +rewrite H17 in H3; apply (H3 0%nat). +simpl in |- *; apply lt_O_Sn. +elim H21; intro. +split. +rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ]. +elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24; + simpl in H23; rewrite H22 in H23; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). +assumption. +clear Hreci; rewrite RList_P13. +rewrite H17 in H14; rewrite H17 in H15; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) i = + pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = + pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; + rewrite H15; assert (H18 := H8 (S i)); + unfold constant_D_eq, open_interval in H18; + assert (H19 : (S i < pred (Rlength l1))%nat). +apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. +assert (H20 := H18 H19); repeat rewrite H20. +reflexivity. +rewrite <- H17; assert (H21 : pos_Rl l1 (S i) <= pos_Rl l1 (S (S i))). +apply (H3 (S i)); apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. +elim H21; intro. +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i))); + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +elim H2; intros; rewrite H22 in H23; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). +assumption. +simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption. +rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1. +inversion H12. +assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b). +rewrite RList_P29. +rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *; + case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ]. +rewrite H15; apply le_n. +induction l1 as [| r l1 Hrecl1]. +simpl in H15; discriminate. +clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. +assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b). +rewrite RList_P26. +replace i with (pred (Rlength l1)); + [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ] + | rewrite H15; reflexivity ]. +rewrite H15; apply lt_n_Sn. +rewrite H16 in H2; rewrite H17 in H2; elim H2; intros; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)). +assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1)). +apply RList_P29. +apply le_S_n; assumption. +apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); + [ assumption | apply le_pred_n ]. +assert + (H17 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S (i - Rlength l1))). +replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat. +apply RList_P29. +apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ]. +induction l1 as [| r l1 Hrecl1]. +simpl in H6; discriminate. +clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. +symmetry in |- *; apply minus_Sn_m; apply le_S_n; assumption. +assert (H18 : (2 <= Rlength l1)%nat). +clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; + induction l1 as [| r l1 Hrecl1]. +discriminate. +clear Hrecl1; induction l1 as [| r0 l1 Hrecl1]. +simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b). +unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro; + [ assumption | elim n; left; assumption ]. +rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0). +clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n. +elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19; + change + (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) + in |- *; rewrite RList_P12. +induction i as [| i Hreci]. +assert (H20 := le_S_n _ _ H15); assert (H21 := le_trans _ _ _ H18 H20); + elim (le_Sn_O _ H21). +clear Hreci; rewrite RList_P13. +rewrite H19 in H16; rewrite H19 in H17; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) i = + pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3)))) + in H16; rewrite H16; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = + pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3))))) + in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat); + unfold constant_D_eq, open_interval in H20; + assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat). +apply lt_pred; rewrite minus_Sn_m. +apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. +rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; + rewrite RList_P23 in H1; apply lt_n_S; assumption. +apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. +apply le_S_n; assumption. +assert (H22 := H20 H21); repeat rewrite H22. +reflexivity. +rewrite <- H19; + assert + (H23 : pos_Rl l2 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))). +apply H7; apply lt_pred. +rewrite minus_Sn_m. +apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. +rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; + rewrite RList_P23 in H1; apply lt_n_S; assumption. +apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. +apply le_S_n; assumption. +elim H23; intro. +split. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1))); + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. +rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros; + rewrite H19 in H25; rewrite H19 in H26; simpl in H25; + simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17; + rewrite H17 in H26; simpl in H24; rewrite H24 in H25; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)). +assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)). +rewrite H19; simpl in |- *; simpl in H16; apply H16. +assert + (H24 : + pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))). +rewrite H19; simpl in |- *; simpl in H17; apply H17. +rewrite <- H23; rewrite <- H24; assumption. +simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption. +rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1. Qed. -Lemma StepFun_P41 : (f:R->R;a,b,c:R) ``a<=b``->``b<=c``->(IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c). -Unfold IsStepFun; Unfold is_subdivision; Intros; Elim X; Clear X; Intros l1 [lf1 H1]; Elim X0; Clear X0; Intros l2 [lf2 H2]; Case (total_order_T a b); Intro. -Elim s; Intro. -Case (total_order_T b c); Intro. -Elim s0; Intro. -Split with (cons_Rlist l1 l2); Split with (FF (cons_Rlist l1 l2) f); Apply StepFun_P40 with b lf1 lf2; Assumption. -Split with l1; Split with lf1; Rewrite b0 in H1; Assumption. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)). -Split with l2; Split with lf2; Rewrite <- b0 in H2; Assumption. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). +Lemma StepFun_P41 : + forall (f:R -> R) (a b c:R), + a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. +unfold IsStepFun in |- *; unfold is_subdivision in |- *; intros; elim X; + clear X; intros l1 [lf1 H1]; elim X0; clear X0; intros l2 [lf2 H2]; + case (total_order_T a b); intro. +elim s; intro. +case (total_order_T b c); intro. +elim s0; intro. +split with (cons_Rlist l1 l2); split with (FF (cons_Rlist l1 l2) f); + apply StepFun_P40 with b lf1 lf2; assumption. +split with l1; split with lf1; rewrite b0 in H1; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). +split with l2; split with lf2; rewrite <- b0 in H2; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). Qed. -Lemma StepFun_P42 : (l1,l2:Rlist;f:R->R) (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 O) -> ``(Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)) == (Int_SF (FF l1 f) l1) + (Int_SF (FF l2 f) l2)``. -Intros l1 l2 f; NewInduction l1 as [|r l1 IHl1]; Intros H; [ Simpl; Ring | NewDestruct l1; [Simpl in H; Simpl; NewDestruct l2; [Simpl; Ring | Simpl; Simpl in H; Rewrite H; Ring] | Simpl; Rewrite Rplus_assoc; Apply Rplus_plus_r; Apply IHl1; Rewrite <- H; Reflexivity]]. +Lemma StepFun_P42 : + forall (l1 l2:Rlist) (f:R -> R), + pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 -> + Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) = + Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2. +intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H; + [ simpl in |- *; ring + | destruct l1 as [| r0 r1]; + [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1]; + [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ] + | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1; + rewrite <- H; reflexivity ] ]. Qed. -Lemma StepFun_P43 : (f:R->R;a,b,c:R;pr1:(IsStepFun f a b);pr2:(IsStepFun f b c);pr3:(IsStepFun f a c)) ``(RiemannInt_SF (mkStepFun pr1))+(RiemannInt_SF (mkStepFun pr2))==(RiemannInt_SF (mkStepFun pr3))``. -Intros f; Intros; Assert H1 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a b l l0))). -Apply pr1. -Assert H2 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f b c l l0))). -Apply pr2. -Assert H3 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))). -Apply pr3. -Elim H1; Clear H1; Intros l1 [lf1 H1]; Elim H2; Clear H2; Intros l2 [lf2 H2]; Elim H3; Clear H3; Intros l3 [lf3 H3]. -Replace (RiemannInt_SF (mkStepFun pr1)) with (Cases (total_order_Rle a b) of (leftT _) => (Int_SF lf1 l1) | (rightT _) => ``-(Int_SF lf1 l1)`` end). -Replace (RiemannInt_SF (mkStepFun pr2)) with (Cases (total_order_Rle b c) of (leftT _) => (Int_SF lf2 l2) | (rightT _) => ``-(Int_SF lf2 l2)`` end). -Replace (RiemannInt_SF (mkStepFun pr3)) with (Cases (total_order_Rle a c) of (leftT _) => (Int_SF lf3 l3) | (rightT _) => ``-(Int_SF lf3 l3)`` end). -Case (total_order_Rle a b); Case (total_order_Rle b c); Case (total_order_Rle a c); Intros. -Elim r1; Intro. -Elim r0; Intro. -Replace (Int_SF lf3 l3) with (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)). -Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -Symmetry; 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; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; Reflexivity Orelse Elim n; Assumption. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2; Assumption | Assumption]. -EApply StepFun_P17; [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 R0. -Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H3; Apply H3]. -Symmetry; EApply StepFun_P8; [Apply H2 | Assumption]. -Replace (Int_SF lf1 l1) with R0. -Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H2 | Rewrite H in H3; Apply H3]. -Symmetry; EApply StepFun_P8; [Apply H1 | Assumption]. -Elim n; Apply Rle_trans with b; Assumption. -Apply r_Rplus_plus with (Int_SF lf2 l2); Replace ``(Int_SF lf2 l2)+((Int_SF lf1 l1)+ -(Int_SF lf2 l2))`` with (Int_SF lf1 l1); [Idtac | Ring]. -Assert H : ``c<b``. -Auto with real. -Elim r; Intro. -Rewrite Rplus_sym; Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)). -Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -Apply StepFun_P42. -Unfold adapted_couple in H2 H3; Decompose [and] H2; Decompose [and] H3; Clear H3 H2; Rewrite H10; Rewrite H6; Unfold Rmax Rmin; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption]. -EApply StepFun_P17; [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 R0. -Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Apply StepFun_P2; Rewrite <- H0 in H2; Apply H2]. -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. -Replace (Int_SF lf2 l2) with (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)). -Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -Symmetry; 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; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption]. -EApply StepFun_P17. -Assert H0 : ``c<a``. -Auto with real. -Apply (StepFun_P40 H0 H (StepFun_P2 H3) H1). -Apply StepFun_P2; Apply H2. -Replace (Int_SF lf1 l1) with R0. -Rewrite Rplus_Or; EApply StepFun_P17; [Apply H3 | Rewrite <- H in H2; Apply H2]. -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)``. -Ring. -Rewrite Rplus_sym; Elim r; Intro. -Replace (Int_SF lf2 l2) with (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)). -Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -Symmetry; 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; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption]. -EApply StepFun_P17. -Apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). -Apply H2. -Replace (Int_SF lf3 l3) with R0. -Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H2; Apply StepFun_P2; Apply H2]. -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)``. -Ring. -Elim r; Intro. -Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)). -Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -Symmetry; 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; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption]. -EApply StepFun_P17. -Apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). -Apply StepFun_P2; Apply H1. -Replace (Int_SF lf2 l2) with R0. -Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H3 | Rewrite H0 in H1; Apply H1]. -Symmetry; EApply StepFun_P8; [Apply H2 | Assumption]. -Elim n; Apply Rle_trans with a; Try Assumption. -Auto with real. -Assert H : ``c<b``. -Auto with real. -Assert H0 : ``b<a``. -Auto with real. -Replace (Int_SF lf3 l3) with ``(Int_SF lf2 l2)+(Int_SF lf1 l1)``. -Ring. -Replace (Int_SF lf3 l3) with (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)). -Replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -Replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -Symmetry; 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; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; [Elim n1; Assumption | Elim n1; Assumption | Elim n0; Assumption | Reflexivity]. -EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption]. -EApply StepFun_P17; [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; Case (total_order_Rle a c); Intro. -EApply StepFun_P17. -Apply H3. -Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1. -Apply eq_Ropp; EApply StepFun_P17. -Apply H3. -Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1. -Unfold RiemannInt_SF; Case (total_order_Rle b c); Intro. -EApply StepFun_P17. -Apply H2. -Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1. -Apply eq_Ropp; EApply StepFun_P17. -Apply H2. -Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1. -Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro. -EApply StepFun_P17. -Apply H1. -Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1. -Apply eq_Ropp; EApply StepFun_P17. -Apply H1. -Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1. +Lemma StepFun_P43 : + forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) + (pr2:IsStepFun f b c) (pr3:IsStepFun f a c), + RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) = + RiemannInt_SF (mkStepFun pr3). +intros f; intros; + assert + (H1 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))). +apply pr1. +assert + (H2 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))). +apply pr2. +assert + (H3 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). +apply pr3. +elim H1; clear H1; intros l1 [lf1 H1]; elim H2; clear H2; intros l2 [lf2 H2]; + elim H3; clear H3; intros l3 [lf3 H3]. +replace (RiemannInt_SF (mkStepFun pr1)) with + match Rle_dec a b with + | left _ => Int_SF lf1 l1 + | right _ => - Int_SF lf1 l1 + end. +replace (RiemannInt_SF (mkStepFun pr2)) with + match Rle_dec b c with + | left _ => Int_SF lf2 l2 + | right _ => - Int_SF lf2 l2 + end. +replace (RiemannInt_SF (mkStepFun pr3)) with + match Rle_dec a c with + | left _ => Int_SF lf3 l3 + | right _ => - Int_SF lf3 l3 + end. +case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec a c); intros. +elim r1; intro. +elim r0; intro. +replace (Int_SF lf3 l3) with + (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n; + assumption. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2; + assumption + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ]. +replace (Int_SF lf2 l2) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | rewrite <- H0 in H3; apply H3 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. +replace (Int_SF lf1 l1) with 0. +rewrite Rplus_0_l; eapply StepFun_P17; + [ apply H2 | rewrite H in H3; apply H3 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. +elim n; apply Rle_trans with b; assumption. +apply Rplus_eq_reg_l with (Int_SF lf2 l2); + replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with + (Int_SF lf1 l1); [ idtac | ring ]. +assert (H : c < b). +auto with real. +elim r; intro. +rewrite Rplus_comm; + replace (Int_SF lf1 l1) with + (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +apply StepFun_P42. +unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; + clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec b c); intros; + [ elim n; assumption + | reflexivity + | elim n0; assumption + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17; + [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ]. +replace (Int_SF lf3 l3) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. +replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). +ring. +elim r; intro. +replace (Int_SF lf2 l2) with + (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; + clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec a b); intros; + [ elim n; assumption + | elim n1; assumption + | reflexivity + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17. +assert (H0 : c < a). +auto with real. +apply (StepFun_P40 H0 H (StepFun_P2 H3) H1). +apply StepFun_P2; apply H2. +replace (Int_SF lf1 l1) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H3 | rewrite <- H in H2; apply H2 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. +assert (H : b < a). +auto with real. +replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). +ring. +rewrite Rplus_comm; elim r; intro. +replace (Int_SF lf2 l2) with + (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; + clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec a b); intros; + [ elim n; assumption + | reflexivity + | elim n0; assumption + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17. +apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). +apply H2. +replace (Int_SF lf3 l3) with 0. +rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. +assert (H : c < a). +auto with real. +replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3). +ring. +elim r; intro. +replace (Int_SF lf1 l1) with + (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)). +replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; + clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec b c); intros; + [ elim n; assumption + | elim n1; assumption + | reflexivity + | elim n1; assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. +eapply StepFun_P17. +apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). +apply StepFun_P2; apply H1. +replace (Int_SF lf2 l2) with 0. +rewrite Rplus_0_l; eapply StepFun_P17; + [ apply H3 | rewrite H0 in H1; apply H1 ]. +symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. +elim n; apply Rle_trans with a; try assumption. +auto with real. +assert (H : c < b). +auto with real. +assert (H0 : b < a). +auto with real. +replace (Int_SF lf3 l3) with (Int_SF lf2 l2 + Int_SF lf1 l1). +ring. +replace (Int_SF lf3 l3) with + (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)). +replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). +replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). +symmetry in |- *; apply StepFun_P42. +unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a b); case (Rle_dec b c); intros; + [ elim n1; assumption + | elim n1; assumption + | elim n0; assumption + | reflexivity ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. +eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. +eapply StepFun_P17. +apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)). +apply StepFun_P2; apply H3. +unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro. +eapply StepFun_P17. +apply H3. +change + (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) + (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply H3. +change + (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) + (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. +unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro. +eapply StepFun_P17. +apply H2. +change + (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) + (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply H2. +change + (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) + (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. +unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. +eapply StepFun_P17. +apply H1. +change + (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) + (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. +apply Ropp_eq_compat; eapply StepFun_P17. +apply H1. +change + (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) + (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. Qed. -Lemma StepFun_P44 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f a c). -Intros f; Intros; Assert H0 : ``a<=b``. -Elim H; Intros; Apply Rle_trans with c; Assumption. -Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))). -Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X. -Apply H2. -Split; Assumption. -Clear f a b c H0 H H1 H2 l1 lf1; Induction l1. -Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate. -Induction r0. -Intros; Assert H1 : ``a==b``. -Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``. -Elim H0; Intros; Apply Rle_trans with c; Assumption. -Replace a with (Rmin a b). -Pattern 2 b; Replace b with (Rmax a b). -Rewrite <- H2; Rewrite H3; Reflexivity. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Split with (cons r nil); Split with lf1; Assert H2 : ``c==b``. -Rewrite H1 in H0; Elim H0; Intros; Apply Rle_antisym; Assumption. -Rewrite H2; Assumption. -Intros; Clear X; Induction lf1. -Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate. -Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``). -Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real]. -Elim H1; Intro. -Split with (cons r (cons c nil)); Split with (cons r3 nil); Unfold adapted_couple in H; Decompose [and] H; Clear H; Assert H6 : ``r==a``. -Simpl in H4; Rewrite H4; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption]. -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 (total_order_Rle a c); Intro; [Assumption | Elim n; Assumption]. -Simpl; Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption]. -Unfold constant_D_eq open_interval; Intros; Simpl in H8; Inversion H8. -Simpl; Assert H10 := (H7 O); Assert H12 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))). -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. -Elim (le_Sn_O ? H11). -Cut (adapted_couple f r1 b (cons r1 r2) lf1). -Cut ``r1<=c<=b``. -Intros. -Elim (X0 ? ? ? ? ? H3 H2); Intros l1' [lf1' H4]; Split with (cons r l1'); Split with (cons r3 lf1'); Unfold adapted_couple in H H4; Decompose [and] H; Decompose [and] H4; Clear H H4 X0; Assert H14 : ``a<=b``. -Elim H0; Intros; Apply Rle_trans with c; Assumption. -Assert H16 : ``r==a``. -Simpl in H7; Rewrite H7; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Induction l1'. -Simpl in H13; Discriminate. -Clear Hrecl1'; Unfold adapted_couple; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H; Induction i. -Simpl; Replace r4 with r1. -Apply (H5 O). -Simpl; Apply lt_O_Sn. -Simpl in H12; Rewrite H12; Unfold Rmin; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption]. -Apply (H9 i); Simpl; Apply lt_S_n; Assumption. -Simpl; Unfold Rmin; Case (total_order_Rle a c); Intro; [Assumption | Elim n; Elim H0; Intros; Assumption]. -Replace (Rmax a c) with (Rmax r1 c). -Rewrite <- H11; Reflexivity. -Unfold Rmax; Case (total_order_Rle r1 c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Elim H0; Intros; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption]. -Simpl; Simpl in H13; Rewrite H13; Reflexivity. -Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i. -Simpl; Assert H17 := (H10 O); Assert H18 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))). -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; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption]. -Clear Hreci; Simpl; Apply H15. -Simpl; Apply lt_S_n; Assumption. -Unfold open_interval; Apply H4. -Split. -Left; Assumption. -Elim H0; Intros; Assumption. -EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H]. +Lemma StepFun_P44 : + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> a <= c <= b -> IsStepFun f a c. +intros f; intros; assert (H0 : a <= b). +elim H; intros; apply Rle_trans with c; assumption. +elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; + elim X; clear X; intros l1 [lf1 H2]; + cut + (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), + adapted_couple f a b l1 lf1 -> + a <= c <= b -> + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). +intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. +apply H2. +split; assumption. +clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. +intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +simple induction r0. +intros; assert (H1 : a = b). +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; + simpl in H2; assert (H7 : a <= b). +elim H0; intros; apply Rle_trans with c; assumption. +replace a with (Rmin a b). +pattern b at 2 in |- *; replace b with (Rmax a b). +rewrite <- H2; rewrite H3; reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +split with (cons r nil); split with lf1; assert (H2 : c = b). +rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. +rewrite H2; assumption. +intros; clear X; induction lf1 as [| r3 lf1 Hreclf1]. +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). +case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. +elim H1; intro. +split with (cons r (cons c nil)); split with (cons r3 nil); + unfold adapted_couple in H; decompose [and] H; clear H; + assert (H6 : r = a). +simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity + | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. +elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split. +rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; + [ assumption | elim n; assumption ]. +simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n; assumption ]. +unfold constant_D_eq, open_interval in |- *; intros; simpl in H8; + inversion H8. +simpl in |- *; assert (H10 := H7 0%nat); + assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). +simpl in |- *; apply lt_O_Sn. +apply (H10 H12); unfold open_interval in |- *; simpl in |- *; + rewrite H11 in H9; simpl in H9; elim H9; clear H9; + intros; split; try assumption. +apply Rlt_le_trans with c; assumption. +elim (le_Sn_O _ H11). +cut (adapted_couple f r1 b (cons r1 r2) lf1). +cut (r1 <= c <= b). +intros. +elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1'); + split with (cons r3 lf1'); unfold adapted_couple in H, H4; + decompose [and] H; decompose [and] H4; clear H H4 X0; + assert (H14 : a <= b). +elim H0; intros; apply Rle_trans with c; assumption. +assert (H16 : r = a). +simpl in H7; rewrite H7; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +induction l1' as [| r4 l1' Hrecl1']. +simpl in H13; discriminate. +clear Hrecl1'; unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; replace r4 with r1. +apply (H5 0%nat). +simpl in |- *; apply lt_O_Sn. +simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; + [ reflexivity | elim n; left; assumption ]. +apply (H9 i); simpl in |- *; apply lt_S_n; assumption. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; + [ assumption | elim n; elim H0; intros; assumption ]. +replace (Rmax a c) with (Rmax r1 c). +rewrite <- H11; reflexivity. +unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros; + [ reflexivity + | elim n; elim H0; intros; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. +simpl in |- *; simpl in H13; rewrite H13; reflexivity. +intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. +simpl in |- *; assert (H17 := H10 0%nat); + assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). +simpl in |- *; apply lt_O_Sn. +apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4; + elim H4; clear H4; intros; split; try assumption; + replace r1 with r4. +assumption. +simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; + [ reflexivity | elim n; left; assumption ]. +clear Hreci; simpl in |- *; apply H15. +simpl in |- *; apply lt_S_n; assumption. +unfold open_interval in |- *; apply H4. +split. +left; assumption. +elim H0; intros; assumption. +eapply StepFun_P7; + [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] + | apply H ]. Qed. -Lemma StepFun_P45 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f c b). -Intros f; Intros; Assert H0 : ``a<=b``. -Elim H; Intros; Apply Rle_trans with c; Assumption. -Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f c b l l0))). -Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X; [Apply H2 | Split; Assumption]. -Clear f a b c H0 H H1 H2 l1 lf1; Induction l1. -Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate. -Induction r0. -Intros; Assert H1 : ``a==b``. -Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``. -Elim H0; Intros; Apply Rle_trans with c; Assumption. -Replace a with (Rmin a b). -Pattern 2 b; Replace b with (Rmax a b). -Rewrite <- H2; Rewrite H3; Reflexivity. -Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]. -Split with (cons r nil); Split with lf1; Assert H2 : ``c==b``. -Rewrite H1 in H0; Elim H0; Intros; Apply Rle_antisym; Assumption. -Rewrite <- H2 in H1; Rewrite <- H1; Assumption. -Intros; Clear X; Induction lf1. -Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate. -Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``). -Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real]. -Elim H1; Intro. -Split with (cons c (cons r1 r2)); Split with (cons r3 lf1); Unfold adapted_couple in H; Decompose [and] H; Clear H; Unfold adapted_couple; Repeat Split. -Unfold ordered_Rlist; Intros; Simpl in H; Induction i. -Simpl; Assumption. -Clear Hreci; Apply (H2 (S i)); Simpl; Assumption. -Simpl; Unfold Rmin; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Assumption]. -Replace (Rmax c b) with (Rmax a b). -Rewrite <- H3; Reflexivity. -Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle 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; Simpl in H5; Apply H5. -Intros; Simpl in H; Induction i. -Unfold constant_D_eq open_interval; Intros; Simpl; Apply (H7 O). -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; Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; 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'; Split with lf1'; Assumption. -Split; [Left; Assumption | Elim H0; Intros; Assumption]. -EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H]. +Lemma StepFun_P45 : + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> a <= c <= b -> IsStepFun f c b. +intros f; intros; assert (H0 : a <= b). +elim H; intros; apply Rle_trans with c; assumption. +elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; + elim X; clear X; intros l1 [lf1 H2]; + cut + (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), + adapted_couple f a b l1 lf1 -> + a <= c <= b -> + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))). +intros; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; + [ apply H2 | split; assumption ]. +clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. +intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +simple induction r0. +intros; assert (H1 : a = b). +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; + simpl in H2; assert (H7 : a <= b). +elim H0; intros; apply Rle_trans with c; assumption. +replace a with (Rmin a b). +pattern b at 2 in |- *; replace b with (Rmax a b). +rewrite <- H2; rewrite H3; reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. +split with (cons r nil); split with lf1; assert (H2 : c = b). +rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. +rewrite <- H2 in H1; rewrite <- H1; assumption. +intros; clear X; induction lf1 as [| r3 lf1 Hreclf1]. +unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. +clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). +case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. +elim H1; intro. +split with (cons c (cons r1 r2)); split with (cons r3 lf1); + unfold adapted_couple in H; decompose [and] H; clear H; + unfold adapted_couple in |- *; repeat split. +unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. +simpl in |- *; assumption. +clear Hreci; apply (H2 (S i)); simpl in |- *; assumption. +simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro; + [ reflexivity | elim n; elim H0; intros; assumption ]. +replace (Rmax c b) with (Rmax a b). +rewrite <- H3; reflexivity. +unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros; + [ reflexivity + | elim n; elim H0; intros; assumption + | elim n; elim H0; intros; apply Rle_trans with c; assumption + | elim n0; elim H0; intros; apply Rle_trans with c; assumption ]. +simpl in |- *; simpl in H5; apply H5. +intros; simpl in H; induction i as [| i Hreci]. +unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + apply (H7 0%nat). +simpl in |- *; apply lt_O_Sn. +unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6; + intros; split; try assumption; apply Rle_lt_trans with c; + try assumption; replace r with a. +elim H0; intros; assumption. +simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros; + [ reflexivity + | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. +clear Hreci; apply (H7 (S i)); simpl in |- *; assumption. +cut (adapted_couple f r1 b (cons r1 r2) lf1). +cut (r1 <= c <= b). +intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1'; + split with lf1'; assumption. +split; [ left; assumption | elim H0; intros; assumption ]. +eapply StepFun_P7; + [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] + | apply H ]. Qed. -Lemma StepFun_P46 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c). -Intros f; Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros. -Apply StepFun_P41 with b; Assumption. -Case (total_order_Rle a c); Intro. -Apply StepFun_P44 with b; Try Assumption. -Split; [Assumption | Auto with real]. -Apply StepFun_P6; Apply StepFun_P44 with b. -Apply StepFun_P6; Assumption. -Split; Auto with real. -Case (total_order_Rle a c); Intro. -Apply StepFun_P45 with b; Try Assumption. -Split; Auto with real. -Apply StepFun_P6; Apply StepFun_P45 with b. -Apply StepFun_P6; Assumption. -Split; [Assumption | Auto with real]. -Apply StepFun_P6; Apply StepFun_P41 with b; Auto with real Orelse Apply StepFun_P6; Assumption. -Qed. +Lemma StepFun_P46 : + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. +intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros. +apply StepFun_P41 with b; assumption. +case (Rle_dec a c); intro. +apply StepFun_P44 with b; try assumption. +split; [ assumption | auto with real ]. +apply StepFun_P6; apply StepFun_P44 with b. +apply StepFun_P6; assumption. +split; auto with real. +case (Rle_dec a c); intro. +apply StepFun_P45 with b; try assumption. +split; auto with real. +apply StepFun_P6; apply StepFun_P45 with b. +apply StepFun_P6; assumption. +split; [ assumption | auto with real ]. +apply StepFun_P6; apply StepFun_P41 with b; + auto with real || apply StepFun_P6; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v index 6ad02e50c..5fb50822b 100644 --- a/theories/Reals/Rlimit.v +++ b/theories/Reals/Rlimit.v @@ -13,136 +13,124 @@ (* *) (*********************************************************) -Require Rbase. -Require Rfunctions. -Require Classical_Prop. -Require Fourier. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Classical_Prop. +Require Import Fourier. Open Local Scope R_scope. (*******************************) (* Calculus *) (*******************************) (*********) -Lemma eps2_Rgt_R0:(eps:R)(Rgt eps R0)-> - (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0). -Intros;Fourier. +Lemma eps2_Rgt_R0 : forall eps:R, eps > 0 -> eps * / 2 > 0. +intros; fourier. Qed. (*********) -Lemma eps2:(eps:R)(Rplus (Rmult eps (Rinv (Rplus R1 R1))) - (Rmult eps (Rinv (Rplus R1 R1))))==eps. -Intro esp. -Assert H := (double_var esp). -Unfold Rdiv in H. -Symmetry; Exact H. +Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps. +intro esp. +assert (H := double_var esp). +unfold Rdiv in H. +symmetry in |- *; exact H. Qed. (*********) -Lemma eps4:(eps:R) - (Rplus (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) ))) - (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) ))))== - (Rmult eps (Rinv (Rplus R1 R1))). -Intro eps. -Replace ``2+2`` with ``2*2``. -Pattern 3 eps; Rewrite double_var. -Rewrite (Rmult_Rplus_distrl ``eps/2`` ``eps/2`` ``/2``). -Unfold Rdiv. -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_Rmult. -Reflexivity. -DiscrR. -DiscrR. -Ring. +Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2. +intro eps. +replace (2 + 2) with 4. +pattern eps at 3 in |- *; rewrite double_var. +rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)). +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +reflexivity. +discrR. +discrR. +ring. Qed. (*********) -Lemma Rlt_eps2_eps:(eps:R)(Rgt eps R0)-> - (Rlt (Rmult eps (Rinv (Rplus R1 R1))) eps). -Intros. -Pattern 2 eps; Rewrite <- Rmult_1r. -Repeat Rewrite (Rmult_sym eps). -Apply Rlt_monotony_r. -Exact H. -Apply Rlt_monotony_contra with ``2``. -Fourier. -Rewrite Rmult_1r; Rewrite <- Rinv_r_sym. -Fourier. -DiscrR. +Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps. +intros. +pattern eps at 2 in |- *; rewrite <- Rmult_1_r. +repeat rewrite (Rmult_comm eps). +apply Rmult_lt_compat_r. +exact H. +apply Rmult_lt_reg_l with 2. +fourier. +rewrite Rmult_1_r; rewrite <- Rinv_r_sym. +fourier. +discrR. Qed. (*********) -Lemma Rlt_eps4_eps:(eps:R)(Rgt eps R0)-> - (Rlt (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1)))) eps). -Intros. -Replace ``2+2`` with ``4``. -Pattern 2 eps; Rewrite <- Rmult_1r. -Repeat Rewrite (Rmult_sym eps). -Apply Rlt_monotony_r. -Exact H. -Apply Rlt_monotony_contra with ``4``. -Replace ``4`` with ``2*2``. -Apply Rmult_lt_pos; Fourier. -Ring. -Rewrite Rmult_1r; Rewrite <- Rinv_r_sym. -Fourier. -DiscrR. -Ring. +Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps. +intros. +replace (2 + 2) with 4. +pattern eps at 2 in |- *; rewrite <- Rmult_1_r. +repeat rewrite (Rmult_comm eps). +apply Rmult_lt_compat_r. +exact H. +apply Rmult_lt_reg_l with 4. +replace 4 with 4. +apply Rmult_lt_0_compat; fourier. +ring. +rewrite Rmult_1_r; rewrite <- Rinv_r_sym. +fourier. +discrR. +ring. Qed. (*********) -Lemma prop_eps:(r:R)((eps:R)(Rgt eps R0)->(Rlt r eps))->(Rle r R0). -Intros;Elim (total_order r R0); Intro. -Apply Rlt_le; Assumption. -Elim H0; Intro. -Apply eq_Rle; Assumption. -Clear H0;Generalize (H r H1); Intro;Generalize (Rlt_antirefl r); - Intro;ElimType False; Auto. +Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0. +intros; elim (Rtotal_order r 0); intro. +apply Rlt_le; assumption. +elim H0; intro. +apply Req_le; assumption. +clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro; + elimtype False; auto. Qed. (*********) -Definition mul_factor := [l,l':R](Rinv (Rplus R1 (Rplus (Rabsolu l) - (Rabsolu l')))). +Definition mul_factor (l l':R) := / (1 + (Rabs l + Rabs l')). (*********) -Lemma mul_factor_wd : (l,l':R) - ~(Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))==R0. -Intros;Rewrite (Rplus_sym R1 (Rplus (Rabsolu l) (Rabsolu l'))); - Apply tech_Rplus. -Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))). -Cut (Rle R0 (Rabsolu (Rplus l l'))). -Exact (Rle_trans ? ? ?). -Exact (Rabsolu_pos (Rplus l l')). -Exact (Rabsolu_triang ? ?). -Exact Rlt_R0_R1. +Lemma mul_factor_wd : forall l l':R, 1 + (Rabs l + Rabs l') <> 0. +intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus. +cut (Rabs (l + l') <= Rabs l + Rabs l'). +cut (0 <= Rabs (l + l')). +exact (Rle_trans _ _ _). +exact (Rabs_pos (l + l')). +exact (Rabs_triang _ _). +exact Rlt_0_1. Qed. (*********) -Lemma mul_factor_gt:(eps:R)(l,l':R)(Rgt eps R0)-> - (Rgt (Rmult eps (mul_factor l l')) R0). -Intros;Unfold Rgt;Rewrite <- (Rmult_Or eps);Apply Rlt_monotony. -Assumption. -Unfold mul_factor;Apply Rlt_Rinv; - Cut (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))). -Cut (Rlt R0 R1). -Exact (Rlt_le_trans ? ? ?). -Exact Rlt_R0_R1. -Replace (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))) - with (Rle (Rplus R1 R0) (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))). -Apply Rle_compatibility. -Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))). -Cut (Rle R0 (Rabsolu (Rplus l l'))). -Exact (Rle_trans ? ? ?). -Exact (Rabsolu_pos ?). -Exact (Rabsolu_triang ? ?). -Rewrite (proj1 ? ? (Rplus_ne R1));Trivial. +Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0. +intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps); + apply Rmult_lt_compat_l. +assumption. +unfold mul_factor in |- *; apply Rinv_0_lt_compat; + cut (1 <= 1 + (Rabs l + Rabs l')). +cut (0 < 1). +exact (Rlt_le_trans _ _ _). +exact Rlt_0_1. +replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')). +apply Rplus_le_compat_l. +cut (Rabs (l + l') <= Rabs l + Rabs l'). +cut (0 <= Rabs (l + l')). +exact (Rle_trans _ _ _). +exact (Rabs_pos _). +exact (Rabs_triang _ _). +rewrite (proj1 (Rplus_ne 1)); trivial. Qed. (*********) -Lemma mul_factor_gt_f:(eps:R)(l,l':R)(Rgt eps R0)-> - (Rgt (Rmin R1 (Rmult eps (mul_factor l l'))) R0). -Intros;Apply Rmin_Rgt_r;Split. -Exact Rlt_R0_R1. -Exact (mul_factor_gt eps l l' H). +Lemma mul_factor_gt_f : + forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0. +intros; apply Rmin_Rgt_r; split. +exact Rlt_0_1. +exact (mul_factor_gt eps l l' H). Qed. @@ -151,389 +139,419 @@ Qed. (*******************************) (*********) -Record Metric_Space:Type:= { - Base:Type; - dist:Base->Base->R; - dist_pos:(x,y:Base)(Rge (dist x y) R0); - dist_sym:(x,y:Base)(dist x y)==(dist y x); - dist_refl:(x,y:Base)((dist x y)==R0<->x==y); - dist_tri:(x,y,z:Base)(Rle (dist x y) - (Rplus (dist x z) (dist z y))) }. +Record Metric_Space : Type := + {Base : Type; + dist : Base -> Base -> R; + dist_pos : forall x y:Base, dist x y >= 0; + dist_sym : forall x y:Base, dist x y = dist y x; + dist_refl : forall x y:Base, dist x y = 0 <-> x = y; + dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}. (*******************************) (* Limit in Metric space *) (*******************************) (*********) -Definition limit_in:= - [X:Metric_Space; X':Metric_Space; f:(Base X)->(Base X'); - D:(Base X)->Prop; x0:(Base X); l:(Base X')] - (eps:R)(Rgt eps R0)-> - (EXT alp:R | (Rgt alp R0)/\(x:(Base X))(D x)/\ - (Rlt (dist X x x0) alp)-> - (Rlt (dist X' (f x) l) eps)). +Definition limit_in (X X':Metric_Space) (f:Base X -> Base X') + (D:Base X -> Prop) (x0:Base X) (l:Base X') := + forall eps:R, + eps > 0 -> + exists alp : R + | alp > 0 /\ + (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps). (*******************************) (* R is a metric space *) (*******************************) (*********) -Definition R_met:Metric_Space:=(Build_Metric_Space R R_dist - R_dist_pos R_dist_sym R_dist_refl R_dist_tri). +Definition R_met : Metric_Space := + Build_Metric_Space R R_dist R_dist_pos R_dist_sym R_dist_refl R_dist_tri. (*******************************) (* Limit 1 arg *) (*******************************) (*********) -Definition Dgf:=[Df,Dg:R->Prop][f:R->R][x:R](Df x)/\(Dg (f x)). +Definition Dgf (Df Dg:R -> Prop) (f:R -> R) (x:R) := Df x /\ Dg (f x). (*********) -Definition limit1_in:(R->R)->(R->Prop)->R->R->Prop:= - [f:R->R; D:R->Prop; l:R; x0:R](limit_in R_met R_met f D x0 l). +Definition limit1_in (f:R -> R) (D:R -> Prop) (l x0:R) : Prop := + limit_in R_met R_met f D x0 l. (*********) -Lemma tech_limit:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)-> - (limit1_in f D l x0)->l==(f x0). -Intros f D l x0 H H0. -Case (Rabsolu_pos (Rminus (f x0) l)); Intros H1. -Absurd (Rlt (dist R_met (f x0) l) (dist R_met (f x0) l)). -Apply Rlt_antirefl. -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_eqT; Auto. +Lemma tech_limit : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + D x0 -> limit1_in f D l x0 -> l = f x0. +intros f D l x0 H H0. +case (Rabs_pos (f x0 - l)); intros H1. +absurd (dist R_met (f x0) l < dist R_met (f x0) l). +apply Rlt_irrefl. +case (H0 (dist R_met (f x0) l)); auto. +intros alpha1 [H2 H3]; apply H3; auto; split; auto. +case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto. +case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto. Qed. (*********) -Lemma tech_limit_contr:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->~l==(f x0) - ->~(limit1_in f D l x0). -Intros;Generalize (tech_limit f D l x0);Tauto. +Lemma tech_limit_contr : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + D x0 -> l <> f x0 -> ~ limit1_in f D l x0. +intros; generalize (tech_limit f D l x0); tauto. Qed. (*********) -Lemma lim_x:(D:R->Prop)(x0:R)(limit1_in [x:R]x D x0 x0). -Unfold limit1_in; Unfold limit_in; Simpl; Intros;Split with eps; - Split; Auto;Intros;Elim H0; Intros; Auto. +Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim H0; intros; + auto. Qed. (*********) -Lemma limit_plus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R) - (limit1_in f D l x0)->(limit1_in g D l' x0)-> - (limit1_in [x:R](Rplus (f x) (g x)) D (Rplus l l') x0). -Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros; - Elim (H (Rmult eps (Rinv (Rplus R1 R1))) (eps2_Rgt_R0 eps H1)); - Elim (H0 (Rmult eps (Rinv (Rplus R1 R1))) (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 R0 (conj ? ? H H2)). -Intros;Elim H4; Clear H4; Intros; - Cut (Rlt (Rplus (R_dist (f x2) l) (R_dist (g x2) l')) eps). - Cut (Rle (R_dist (Rplus (f x2) (g x2)) (Rplus l l')) - (Rplus (R_dist (f x2) l) (R_dist (g x2) l'))). -Exact (Rle_lt_trans ? ? ?). -Exact (R_dist_plus ? ? ? ?). -Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros. -Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6)); - Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5)); - Intros; - Replace eps - with (Rplus (Rmult eps (Rinv (Rplus R1 R1))) - (Rmult eps (Rinv (Rplus R1 R1)))). -Exact (Rplus_lt ? ? ? ? H7 H8). -Exact (eps2 eps). +Lemma limit_plus : + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0. +intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); + elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; + clear H H0; intros; elim H; elim H0; clear H H0; intros; + split with (Rmin x1 x); split. +exact (Rmin_Rgt_r x1 x 0 (conj H H2)). +intros; elim H4; clear H4; intros; + cut (R_dist (f x2) l + R_dist (g x2) l' < eps). + cut (R_dist (f x2 + g x2) (l + l') <= R_dist (f x2) l + R_dist (g x2) l'). +exact (Rle_lt_trans _ _ _). +exact (R_dist_plus _ _ _ _). +elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros. +generalize (H3 x2 (conj H4 H6)); generalize (H0 x2 (conj H4 H5)); intros; + replace eps with (eps * / 2 + eps * / 2). +exact (Rplus_lt_compat _ _ _ _ H7 H8). +exact (eps2 eps). Qed. (*********) -Lemma limit_Ropp:(f:R->R)(D:R->Prop)(l:R)(x0:R) - (limit1_in f D l x0)->(limit1_in [x:R](Ropp (f x)) D (Ropp l) x0). -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;Unfold Rminus; - Rewrite (Ropp_Ropp l);Rewrite (Rplus_sym (Ropp (f x1)) l); - Fold (Rminus l (f x1));Fold (R_dist l (f x1));Rewrite R_dist_sym; - Assumption. +Lemma limit_Ropp : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + elim (H eps H0); clear H; intros; elim H; clear H; + intros; split with x; split; auto; intros; generalize (H1 x1 H2); + clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); + fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; + rewrite R_dist_sym; assumption. Qed. (*********) -Lemma limit_minus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R) - (limit1_in f D l x0)->(limit1_in g D l' x0)-> - (limit1_in [x:R](Rminus (f x) (g x)) D (Rminus l l') x0). -Intros;Unfold Rminus;Generalize (limit_Ropp g D l' x0 H0);Intro; - Exact (limit_plus f [x:R](Ropp (g x)) D l (Ropp l') x0 H H1). +Lemma limit_minus : + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0. +intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro; + exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1). Qed. (*********) -Lemma limit_free:(f:R->R)(D:R->Prop)(x:R)(x0:R) - (limit1_in [h:R](f x) D (f x) x0). -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_eqT R (f x)));Unfold Rgt in H;Assumption. +Lemma limit_free : + forall (f:R -> R) (D:R -> Prop) (x x0:R), + limit1_in (fun h:R => f x) D (f x) x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x)); + intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; + assumption. Qed. (*********) -Lemma limit_mul:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R) - (limit1_in f D l x0)->(limit1_in g D l' x0)-> - (limit1_in [x:R](Rmult (f x) (g x)) D (Rmult l l') x0). -Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros; - Elim (H (Rmin R1 (Rmult eps (mul_factor l l'))) - (mul_factor_gt_f eps l l' H1)); - Elim (H0 (Rmult eps (mul_factor l l')) (mul_factor_gt eps l l' H1)); - 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 R0 (conj ? ? H H2)). -Intros; Elim H4; Clear H4; Intros;Unfold R_dist; - Replace (Rminus (Rmult (f x2) (g x2)) (Rmult l l')) with - (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus (f x2) l))). -Cut (Rlt (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu (Rmult l' - (Rminus (f x2) l)))) eps). -Cut (Rle (Rabsolu (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus - (f x2) l)))) (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu - (Rmult l' (Rminus (f x2) l))))). -Exact (Rle_lt_trans ? ? ?). -Exact (Rabsolu_triang ? ?). -Rewrite (Rabsolu_mult (f x2) (Rminus (g x2) l')); - Rewrite (Rabsolu_mult l' (Rminus (f x2) l)); - Cut (Rle (Rplus (Rmult (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l'))) - (Rmult (Rabsolu l') (Rmult eps (mul_factor l l')))) eps). -Cut (Rlt (Rplus (Rmult (Rabsolu (f x2)) (Rabsolu (Rminus (g x2) l'))) (Rmult - (Rabsolu l') (Rabsolu (Rminus (f x2) l)))) (Rplus (Rmult (Rplus R1 (Rabsolu - l)) (Rmult eps (mul_factor l l'))) (Rmult (Rabsolu l') (Rmult eps - (mul_factor l l'))))). -Exact (Rlt_le_trans ? ? ?). -Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros; - Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));Intro; - Generalize (Rmin_Rgt_l ? ? ? H7);Intro;Elim H8;Intros;Clear H0 H8; - Apply Rplus_lt_le_lt. -Apply Rmult_lt_0. -Apply Rle_sym1. -Exact (Rabsolu_pos (Rminus (g x2) l')). -Rewrite (Rplus_sym R1 (Rabsolu l));Unfold Rgt;Apply Rlt_r_plus_R1; - Exact (Rabsolu_pos l). -Unfold R_dist in H9; - Apply (Rlt_anti_compatibility (Ropp (Rabsolu l)) (Rabsolu (f x2)) - (Rplus R1 (Rabsolu l))). -Rewrite <- (Rplus_assoc (Ropp (Rabsolu l)) R1 (Rabsolu l)); - Rewrite (Rplus_sym (Ropp (Rabsolu l)) R1); - Rewrite (Rplus_assoc R1 (Ropp (Rabsolu l)) (Rabsolu l)); - Rewrite (Rplus_Ropp_l (Rabsolu l)); - Rewrite (proj1 ? ? (Rplus_ne R1)); - Rewrite (Rplus_sym (Ropp (Rabsolu l)) (Rabsolu (f x2))); - Generalize H9; -Cut (Rle (Rminus (Rabsolu (f x2)) (Rabsolu l)) (Rabsolu (Rminus (f x2) l))). -Exact (Rle_lt_trans ? ? ?). -Exact (Rabsolu_triang_inv ? ?). -Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));Trivial. -Apply Rle_monotony. -Exact (Rabsolu_pos l'). -Unfold Rle;Left;Assumption. -Rewrite (Rmult_sym (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l'))); - Rewrite (Rmult_sym (Rabsolu l') (Rmult eps (mul_factor l l'))); - Rewrite <- (Rmult_Rplus_distr - (Rmult eps (mul_factor l l')) - (Rplus R1 (Rabsolu l)) - (Rabsolu l')); - Rewrite (Rmult_assoc eps (mul_factor l l') (Rplus (Rplus R1 (Rabsolu l)) - (Rabsolu l'))); - Rewrite (Rplus_assoc R1 (Rabsolu l) (Rabsolu l'));Unfold mul_factor; - Rewrite (Rinv_l (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l'))) - (mul_factor_wd l l')); - Rewrite (proj1 ? ? (Rmult_ne eps));Apply eq_Rle;Trivial. -Ring. +Lemma limit_mul : + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0. +intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + intros; + elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1)); + elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); + clear H H0; simpl in |- *; intros; elim H; elim H0; + clear H H0; intros; split with (Rmin x1 x); split. +exact (Rmin_Rgt_r x1 x 0 (conj H H2)). +intros; elim H4; clear H4; intros; unfold R_dist in |- *; + replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)). +cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). +cut + (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <= + Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))). +exact (Rle_lt_trans _ _ _). +exact (Rabs_triang _ _). +rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l)); + cut + ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <= + eps). +cut + (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) < + (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l')). +exact (Rlt_le_trans _ _ _). +elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros; + generalize (H0 x2 (conj H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7); + intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat. +apply Rmult_ge_0_gt_0_lt_compat. +apply Rle_ge. +exact (Rabs_pos (g x2 - l')). +rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1; + exact (Rabs_pos l). +unfold R_dist in H9; + apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)). +rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l)); + rewrite (Rplus_comm (- Rabs l) 1); + rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l)); + rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2))); + generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)). +exact (Rle_lt_trans _ _ _). +exact (Rabs_triang_inv _ _). +generalize (H3 x2 (conj H4 H6)); trivial. +apply Rmult_le_compat_l. +exact (Rabs_pos l'). +unfold Rle in |- *; left; assumption. +rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l')); + rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l')); + rewrite <- + (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l')) + ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l')); + rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *; + rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l')); + rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial. +ring. Qed. (*********) -Definition adhDa:(R->Prop)->R->Prop:=[D:R->Prop][a:R] - (alp:R)(Rgt alp R0)->(EXT x:R | (D x)/\(Rlt (R_dist x a) alp)). +Definition adhDa (D:R -> Prop) (a:R) : Prop := + forall alp:R, alp > 0 -> exists x : R | D x /\ R_dist x a < alp. (*********) -Lemma single_limit:(f:R->R)(D:R->Prop)(l:R)(l':R)(x0:R) - (adhDa D x0)->(limit1_in f D l x0)->(limit1_in f D l' x0)->l==l'. -Unfold limit1_in; Unfold limit_in; Intros. -Cut (eps:R)(Rgt eps R0)->(Rlt (dist R_met l l') - (Rmult (Rplus R1 R1) eps)). -Clear H0 H1;Unfold dist; Unfold R_met; Unfold R_dist; - Unfold Rabsolu;Case (case_Rabsolu (Rminus l l')); Intros. -Cut (eps:R)(Rgt eps R0)->(Rlt (Ropp (Rminus l l')) eps). -Intro;Generalize (prop_eps (Ropp (Rminus l l')) H1);Intro; - Generalize (Rlt_RoppO (Rminus l l') r); Intro;Unfold Rgt in H3; - Generalize (Rle_not (Ropp (Rminus l l')) R0 H3); Intro; - ElimType False; Auto. -Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0). -Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2); - Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1))); - Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps); - Rewrite (Rinv_r (Rplus R1 R1)). -Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial. -Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro; - Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro; - Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b; - Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4). -Unfold Rgt;Unfold Rgt in H1; - Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1))); - Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1))); - Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto. -Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)). -Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2). -Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1); - Intros a b;Rewrite a;Clear a b;Trivial. +Lemma single_limit : + forall (f:R -> R) (D:R -> Prop) (l l' x0:R), + adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'. +unfold limit1_in in |- *; unfold limit_in in |- *; intros. +cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps). +clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *; + unfold Rabs in |- *; case (Rcase_abs (l - l')); intros. +cut (forall eps:R, eps > 0 -> - (l - l') < eps). +intro; generalize (prop_eps (- (l - l')) H1); intro; + generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; + unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); + intro; elimtype False; auto. +intros; cut (eps * / 2 > 0). +intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). +elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. +apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + clear a b; apply (Rlt_trans 0 1 2 H3 H4). +unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + auto. +apply (Rinv_0_lt_compat 2); cut (1 < 2). +intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). +generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; + rewrite a; clear a b; trivial. (**) -Cut (eps:R)(Rgt eps R0)->(Rlt (Rminus l l') eps). -Intro;Generalize (prop_eps (Rminus l l') H1);Intro; - Elim (Rle_le_eq (Rminus l l') R0);Intros a b;Clear b; - Apply (Rminus_eq l l');Apply a;Split. -Assumption. -Apply (Rle_sym2 R0 (Rminus l l') r). -Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0). -Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2); - Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1))); - Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps); - Rewrite (Rinv_r (Rplus R1 R1)). -Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial. -Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro; - Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro; - Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b; - Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4). -Unfold Rgt;Unfold Rgt in H1; - Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1))); - Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1))); - Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto. -Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)). -Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2). -Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1); - Intros a b;Rewrite a;Clear a b;Trivial. +cut (forall eps:R, eps > 0 -> l - l' < eps). +intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0); + intros a b; clear b; apply (Rminus_diag_uniq l l'); + apply a; split. +assumption. +apply (Rge_le (l - l') 0 r). +intros; cut (eps * / 2 > 0). +intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). +elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. +apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + clear a b; apply (Rlt_trans 0 1 2 H3 H4). +unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + auto. +apply (Rinv_0_lt_compat 2); cut (1 < 2). +intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). +generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; + rewrite a; clear a b; trivial. (**) -Intros;Unfold adhDa in H;Elim (H0 eps H2);Intros;Elim (H1 eps H2); - Intros;Clear H0 H1;Elim H3;Elim H4;Clear H3 H4;Intros; - Simpl;Simpl in H1 H4;Generalize (Rmin_Rgt x x1 R0);Intro;Elim H5; - Intros;Clear H5; - Elim (H (Rmin x x1) (H7 (conj (Rgt x R0) (Rgt x1 R0) H3 H0))); - Intros; Elim H5;Intros;Clear H5 H H6 H7; - Generalize (Rmin_Rgt x x1 (R_dist x2 x0));Intro;Elim H; - Intros;Clear H H6;Unfold Rgt in H5;Elim (H5 H9);Intros;Clear H5 H9; - Generalize (H1 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H8 H6)); - Generalize (H4 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H8 H)); - Clear H8 H H6 H1 H4 H0 H3;Intros; - Generalize (Rplus_lt (R_dist (f x2) l) eps (R_dist (f x2) l') eps - H H0); Unfold R_dist;Intros; - Rewrite (Rabsolu_minus_sym (f x2) l) in H1; - Rewrite (Rmult_sym (Rplus R1 R1) eps);Rewrite (Rmult_Rplus_distr eps R1 R1); - Elim (Rmult_ne eps);Intros a b;Rewrite a;Clear a b; - Generalize (R_dist_tri l l' (f x2));Unfold R_dist;Intros; - Apply (Rle_lt_trans (Rabsolu (Rminus l l')) - (Rplus (Rabsolu (Rminus l (f x2))) (Rabsolu (Rminus (f x2) l'))) - (Rplus eps eps) H3 H1). +intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros; + clear H0 H1; elim H3; elim H4; clear H3 H4; intros; + simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); + intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0))); + intros; elim H5; intros; clear H5 H H6 H7; + generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; + elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); + intros; clear H5 H9; generalize (H1 x2 (conj H8 H6)); + generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; + intros; + generalize + (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0); + unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1; + rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1); + elim (Rmult_ne eps); intros a b; rewrite a; clear a b; + generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; + intros; + apply + (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) + (eps + eps) H3 H1). Qed. (*********) -Lemma limit_comp:(f,g:R->R)(Df,Dg:R->Prop)(l,l':R)(x0:R) - (limit1_in f Df l x0)->(limit1_in g Dg l' l)-> - (limit1_in [x:R](g (f x)) (Dgf Df Dg f) l' x0). -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. -Elim (Hf alpg). -2: Tauto. -Intros alpf lf. -Exists alpf. -Intuition. +Lemma limit_comp : + forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R), + limit1_in f Df l x0 -> + limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0. +unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *. +intros f g Df Dg l l' x0 Hf Hg eps eps_pos. +elim (Hg eps eps_pos). +intros alpg lg. +elim (Hf alpg). +2: tauto. +intros alpf lf. +exists alpf. +intuition. Qed. (*********) -Lemma limit_inv : (f:R->R)(D:R->Prop)(l:R)(x0:R) (limit1_in f D l x0)->~(l==R0)->(limit1_in [x:R](Rinv (f x)) D (Rinv l) x0). -Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H ``(Rabsolu 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; Case (total_order_Rle 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)/\``(Rabsolu (x-x0))<delta1``. -Cut (D x)/\``(Rabsolu (x-x0))<delta2``. -Intros; Generalize (H5 H11); Clear H5; Intro H5; Generalize (H7 H12); Clear H7; Intro H7; Generalize (Rabsolu_triang_inv l (f x)); Intro; Rewrite Rabsolu_minus_sym in H7; Generalize (Rle_lt_trans ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu (l-(f x)))`` ``(Rabsolu l)/2`` H13 H7); Intro; Generalize (Rlt_compatibility ``(Rabsolu (f x))-(Rabsolu l)/2`` ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu l)/2`` H14); Replace ``(Rabsolu (f x))-(Rabsolu l)/2+((Rabsolu l)-(Rabsolu (f x)))`` with ``(Rabsolu l)/2``. -Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Cut ~``(f x)==0``. -Intro; Replace ``/(f x)+ -/l`` with ``(l-(f x))*/(l*(f x))``. -Rewrite Rabsolu_mult; Rewrite Rabsolu_Rinv. -Cut ``/(Rabsolu (l*(f x)))<2/(Rsqr l)``. -Intro; Rewrite Rabsolu_minus_sym in H5; Cut ``0<=/(Rabsolu (l*(f x)))``. -Intro; Generalize (Rmult_lt2 ``(Rabsolu (l-(f x)))`` ``eps*(Rsqr l)/2`` ``/(Rabsolu (l*(f x)))`` ``2/(Rsqr l)`` (Rabsolu_pos ``l-(f x)``) H18 H5 H17); Replace ``eps*(Rsqr l)/2*2/(Rsqr l)`` with ``eps``. -Intro; Assumption. -Unfold Rdiv; Unfold Rsqr; Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym l). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_sym l). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Reflexivity. -DiscrR. -Exact H0. -Exact H0. -Exact H0. -Exact H0. -Left; Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply prod_neq_R0; Assumption. -Rewrite Rmult_sym; Rewrite Rabsolu_mult; Rewrite Rinv_Rmult. -Rewrite (Rsqr_abs l); Unfold Rsqr; Unfold Rdiv; Rewrite Rinv_Rmult. -Repeat Rewrite <- Rmult_assoc; Apply Rlt_monotony_r. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Apply Rlt_monotony_contra with ``(Rabsolu (f x))*(Rabsolu l)*/2``. -Repeat Apply Rmult_lt_pos. -Apply Rabsolu_pos_lt; Assumption. -Apply Rabsolu_pos_lt; Assumption. -Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro H18; Assumption | Discriminate]. -Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*/(Rabsolu (f x))`` with ``(Rabsolu l)/2``. -Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*(2*/(Rabsolu l))`` with ``(Rabsolu (f x))``. -Assumption. -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym (Rabsolu l)). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Reflexivity. -DiscrR. -Apply Rabsolu_no_R0. -Assumption. -Unfold Rdiv. -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym (Rabsolu (f x))). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Reflexivity. -Apply Rabsolu_no_R0; Assumption. -Apply Rabsolu_no_R0; Assumption. -Apply Rabsolu_no_R0; Assumption. -Apply Rabsolu_no_R0; Assumption. -Apply Rabsolu_no_R0; Assumption. -Apply prod_neq_R0; Assumption. -Rewrite (Rinv_Rmult ? ? H0 H16). -Unfold Rminus; Rewrite Rmult_Rplus_distrl. -Rewrite <- Rmult_assoc. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l. -Rewrite Ropp_mul1. -Rewrite (Rmult_sym (f x)). -Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Reflexivity. -Assumption. -Assumption. -Red; Intro; Rewrite H16 in H15; Rewrite Rabsolu_R0 in H15; Cut ``0<(Rabsolu l)/2``. -Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rabsolu l)/2`` ``0`` H17 H15)). -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rabsolu_pos_lt; Assumption. -Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro; Assumption | Discriminate]. -Pattern 3 (Rabsolu l); Rewrite double_var. -Ring. -Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_r]]. -Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_l]]. -Change ``0<eps*(Rsqr l)/2``; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Repeat Apply Rmult_lt_pos. -Assumption. -Apply Rsqr_pos_lt; Assumption. -Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate]. -Change ``0<(Rabsolu l)/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate]]. -Qed. +Lemma limit_inv : + forall (f:R -> R) (D:R -> Prop) (l x0:R), + limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0. +unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + unfold R_dist in |- *; intros; elim (H (Rabs l / 2)). +intros delta1 H2; elim (H (eps * (Rsqr l / 2))). +intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2); + split. +unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption. +intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7; + intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1). +cut (D x /\ Rabs (x - x0) < delta2). +intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12); + clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); + intro; rewrite Rabs_minus_sym in H7; + generalize + (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7); + intro; + generalize + (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x)) + (Rabs l / 2) H14); + replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2). +unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; intro; cut (f x <> 0). +intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)). +rewrite Rabs_mult; rewrite Rabs_Rinv. +cut (/ Rabs (l * f x) < 2 / Rsqr l). +intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)). +intro; + generalize + (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2)) + (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17); + replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps. +intro; assumption. +unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm l). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm l). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; reflexivity. +discrR. +exact H0. +exact H0. +exact H0. +exact H0. +left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0; + assumption. +rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr. +rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *; + rewrite Rinv_mult_distr. +repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2). +repeat apply Rmult_lt_0_compat. +apply Rabs_pos_lt; assumption. +apply Rabs_pos_lt; assumption. +apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; + intro H18; assumption + | discriminate ]. +replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2). +replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)). +assumption. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (Rabs l)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; reflexivity. +discrR. +apply Rabs_no_R0. +assumption. +unfold Rdiv in |- *. +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (Rabs (f x))). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +reflexivity. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +apply prod_neq_R0; assumption. +rewrite (Rinv_mult_distr _ _ H0 H16). +unfold Rminus in |- *; rewrite Rmult_plus_distr_r. +rewrite <- Rmult_assoc. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +rewrite Ropp_mult_distr_l_reverse. +rewrite (Rmult_comm (f x)). +rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +reflexivity. +assumption. +assumption. +red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15; + cut (0 < Rabs l / 2). +intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)). +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rabs_pos_lt; assumption. +apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; + intro; assumption + | discriminate ]. +pattern (Rabs l) at 3 in |- *; rewrite double_var. +ring. +split; + [ assumption + | apply Rlt_le_trans with (Rmin delta1 delta2); + [ assumption | apply Rmin_r ] ]. +split; + [ assumption + | apply Rlt_le_trans with (Rmin delta1 delta2); + [ assumption | apply Rmin_l ] ]. +change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *; + repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat. +assumption. +apply Rsqr_pos_lt; assumption. +apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; + intro; assumption + | discriminate ]. +change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption + | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; + intro; assumption + | discriminate ] ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v index c4cb1a8eb..7c31bbe61 100644 --- a/theories/Reals/Rpower.v +++ b/theories/Reals/Rpower.v @@ -13,548 +13,649 @@ (* Definitions of log and Rpower : R->R->R; main properties *) (************************************************************) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require Ranalysis1. -Require Exp_prop. -Require Rsqrt_def. -Require R_sqrt. -Require MVT. -Require Ranalysis4. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +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. -Lemma P_Rmin: (P : R -> Prop) (x, y : R) (P x) -> (P y) -> (P (Rmin x y)). -Intros P x y H1 H2; Unfold Rmin; Case (total_order_Rle x y); Intro; Assumption. +Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y). +intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro; + assumption. Qed. -Lemma exp_le_3 : ``(exp 1)<=3``. -Assert exp_1 : ``(exp 1)<>0``. -Assert H0 := (exp_pos R1); Red; Intro; Rewrite H in H0; Elim (Rlt_antirefl ? H0). -Apply Rle_monotony_contra with ``/(exp 1)``. -Apply Rlt_Rinv; Apply exp_pos. -Rewrite <- Rinv_l_sym. -Apply Rle_monotony_contra with ``/3``. -Apply Rlt_Rinv; Sup0. -Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Replace ``/(exp 1)`` with ``(exp (-1))``. -Unfold exp; Case (exist_exp ``-1``); Intros; Simpl; Unfold exp_in in e; Assert H := (alternated_series_ineq [i:nat]``/(INR (fact i))`` x (S O)). -Cut ``(sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (S (mult (S (S O)) (S O)))) <= x <= (sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (mult (S (S O)) (S O)))``. -Intro; Elim H0; Clear H0; Intros H0 _; Simpl in H0; Unfold tg_alt in H0; Simpl in H0. -Replace ``/3`` with ``1*/1+ -1*1*/1+ -1*( -1*1)*/2+ -1*( -1*( -1*1))*/(2+1+1+1+1)``. -Apply H0. -Repeat Rewrite Rinv_R1; Repeat Rewrite Rmult_1r; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_r; Rewrite Rmult_1r; Rewrite Rplus_Ol; Rewrite Rmult_1l; Apply r_Rmult_mult with ``6``. -Rewrite Rmult_Rplus_distr; Replace ``2+1+1+1+1`` with ``6``. -Rewrite <- (Rmult_sym ``/6``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Replace ``6`` with ``2*3``. -Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Rewrite (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Ring. -DiscrR. -DiscrR. -Ring. -DiscrR. -Ring. -DiscrR. -Apply H. -Unfold Un_decreasing; Intros; Apply Rle_monotony_contra with ``(INR (fact n))``. -Apply INR_fact_lt_0. -Apply Rle_monotony_contra with ``(INR (fact (S n)))``. -Apply INR_fact_lt_0. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Apply le_INR; Apply fact_growing; Apply le_n_Sn. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Assert H0 := (cv_speed_pow_fact R1); Unfold Un_cv; Unfold Un_cv in H0; Intros; Elim (H0 ? H1); Intros; Exists x0; Intros; Unfold R_dist in H2; Unfold R_dist; Replace ``/(INR (fact n))`` with ``(pow 1 n)/(INR (fact n))``. -Apply (H2 ? H3). -Unfold Rdiv; Rewrite pow1; Rewrite Rmult_1l; Reflexivity. -Unfold infinit_sum in e; Unfold Un_cv tg_alt; Intros; Elim (e ? H0); Intros; Exists x0; Intros; Replace (sum_f_R0 ([i:nat]``(pow ( -1) i)*/(INR (fact i))``) n) with (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow ( -1) i)``) n). -Apply (H1 ? H2). -Apply sum_eq; Intros; Apply Rmult_sym. -Apply r_Rmult_mult with ``(exp 1)``. -Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite <- Rinv_r_sym. -Reflexivity. -Assumption. -Assumption. -DiscrR. -Assumption. +Lemma exp_le_3 : exp 1 <= 3. +assert (exp_1 : exp 1 <> 0). +assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0; + elim (Rlt_irrefl _ H0). +apply Rmult_le_reg_l with (/ exp 1). +apply Rinv_0_lt_compat; apply exp_pos. +rewrite <- Rinv_l_sym. +apply Rmult_le_reg_l with (/ 3). +apply Rinv_0_lt_compat; prove_sup0. +rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)). +unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *; + unfold exp_in in e; + assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1). +cut + (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <= + sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)). +intro; elim H0; clear H0; intros H0 _; simpl in H0; unfold tg_alt in H0; + simpl in H0. +replace (/ 3) with + (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 + + -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)). +apply H0. +repeat rewrite Rinv_1; repeat rewrite Rmult_1_r; + rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; + rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r; + rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6. +rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6. +rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; replace 6 with 6. +do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +ring. +discrR. +discrR. +ring. +discrR. +ring. +discrR. +apply H. +unfold Un_decreasing in |- *; intros; + apply Rmult_le_reg_l with (INR (fact n)). +apply INR_fact_lt_0. +apply Rmult_le_reg_l with (INR (fact (S n))). +apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0; + intros; elim (H0 _ H1); intros; exists x0; intros; + unfold R_dist in H2; unfold R_dist in |- *; + replace (/ INR (fact n)) with (1 ^ n / INR (fact n)). +apply (H2 _ H3). +unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity. +unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0); + intros; exists x0; intros; + replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with + (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n). +apply (H1 _ H2). +apply sum_eq; intros; apply Rmult_comm. +apply Rmult_eq_reg_l with (exp 1). +rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite <- Rinv_r_sym. +reflexivity. +assumption. +assumption. +discrR. +assumption. Qed. (******************************************************************) (* Properties of Exp *) (******************************************************************) -Theorem exp_increasing: (x, y : R) ``x<y`` -> ``(exp x)<(exp y)``. -Intros x y H. -Assert H0 : (derivable exp). -Apply derivable_exp. -Assert H1 := (positive_derivative ? H0). -Unfold strict_increasing in H1. -Apply H1. -Intro. -Replace (derive_pt exp x0 (H0 x0)) with (exp x0). -Apply exp_pos. -Symmetry; Apply derive_pt_eq_0. -Apply (derivable_pt_lim_exp x0). -Apply H. +Theorem exp_increasing : forall x y:R, x < y -> exp x < exp y. +intros x y H. +assert (H0 : derivable exp). +apply derivable_exp. +assert (H1 := positive_derivative _ H0). +unfold strict_increasing in H1. +apply H1. +intro. +replace (derive_pt exp x0 (H0 x0)) with (exp x0). +apply exp_pos. +symmetry in |- *; apply derive_pt_eq_0. +apply (derivable_pt_lim_exp x0). +apply H. Qed. -Theorem exp_lt_inv: (x, y : R) ``(exp x)<(exp y)`` -> ``x<y``. -Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]]. -Assumption. -Rewrite H1 in H; Elim (Rlt_antirefl ? H). -Assert H2 := (exp_increasing ? ? H1). -Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H2)). +Theorem exp_lt_inv : forall x y:R, exp x < exp y -> x < y. +intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]. +assumption. +rewrite H1 in H; elim (Rlt_irrefl _ H). +assert (H2 := exp_increasing _ _ H1). +elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)). Qed. -Lemma exp_ineq1 : (x:R) ``0<x`` -> ``1+x < (exp x)``. -Intros; Apply Rlt_anti_compatibility with ``-(exp 0)``; Rewrite <- (Rplus_sym (exp x)); Assert H0 := (MVT_cor1 exp R0 x derivable_exp H); Elim H0; Intros; Elim H1; Intros; Unfold Rminus in H2; Rewrite H2; Rewrite Ropp_O; Rewrite Rplus_Or; Replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0). -Rewrite exp_0; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Pattern 1 x; Rewrite <- Rmult_1r; Rewrite (Rmult_sym (exp x0)); Apply Rlt_monotony. -Apply H. -Rewrite <- exp_0; Apply exp_increasing; Elim H3; Intros; Assumption. -Symmetry; Apply derive_pt_eq_0; Apply derivable_pt_lim_exp. +Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x. +intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x)); + assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; + intros; elim H1; intros; unfold Rminus in H2; rewrite H2; + rewrite Ropp_0; rewrite Rplus_0_r; + replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0). +rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0)); + apply Rmult_lt_compat_l. +apply H. +rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption. +symmetry in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp. Qed. -Lemma ln_exists1 : (y:R) ``0<y``->``1<=y``->(sigTT R [z:R]``y==(exp z)``). -Intros; Pose f := [x:R]``(exp x)-y``; Cut ``(f 0)<=0``. -Intro; Cut (continuity f). -Intro; Cut ``0<=(f y)``. -Intro; Cut ``(f 0)*(f y)<=0``. -Intro; Assert X := (IVT_cor f R0 y H2 (Rlt_le ? ? H) H4); Elim X; Intros t H5; Apply existTT with t; Elim H5; Intros; Unfold f in H7; Apply Rminus_eq_right; Exact H7. -Pattern 2 R0; Rewrite <- (Rmult_Or (f y)); Rewrite (Rmult_sym (f R0)); Apply Rle_monotony; Assumption. -Unfold f; Apply Rle_anti_compatibility with y; Left; Apply Rlt_trans with ``1+y``. -Rewrite <- (Rplus_sym y); Apply Rlt_compatibility; Apply Rlt_R0_R1. -Replace ``y+((exp y)-y)`` with (exp y); [Apply (exp_ineq1 y H) | Ring]. -Unfold f; Change (continuity (minus_fct exp (fct_cte y))); Apply continuity_minus; [Apply derivable_continuous; Apply derivable_exp | Apply derivable_continuous; Apply derivable_const]. -Unfold f; Rewrite exp_0; Apply Rle_anti_compatibility with y; Rewrite Rplus_Or; Replace ``y+(1-y)`` with R1; [Apply H0 | Ring]. +Lemma ln_exists1 : forall y:R, 0 < y -> 1 <= y -> sigT (fun z:R => y = exp z). +intros; pose (f := fun x:R => exp x - y); cut (f 0 <= 0). +intro; cut (continuity f). +intro; cut (0 <= f y). +intro; cut (f 0 * f y <= 0). +intro; assert (X := IVT_cor f 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5; + apply existT with t; elim H5; intros; unfold f in H7; + apply Rminus_diag_uniq_sym; exact H7. +pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)); + rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; + assumption. +unfold f in |- *; apply Rplus_le_reg_l with y; left; + apply Rlt_trans with (1 + y). +rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1. +replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ]. +unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *; + apply continuity_minus; + [ apply derivable_continuous; apply derivable_exp + | apply derivable_continuous; apply derivable_const ]. +unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y; + rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ]. Qed. (**********) -Lemma ln_exists : (y:R) ``0<y`` -> (sigTT R [z:R]``y==(exp z)``). -Intros; Case (total_order_Rle R1 y); Intro. -Apply (ln_exists1 ? H r). -Assert H0 : ``1<=/y``. -Apply Rle_monotony_contra with y. -Apply H. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Left; Apply (not_Rle ? ? n). -Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H). -Assert H1 : ``0</y``. -Apply Rlt_Rinv; Apply H. -Assert H2 := (ln_exists1 ? H1 H0); Elim H2; Intros; Apply existTT with ``-x``; Apply r_Rmult_mult with ``(exp x)/y``. -Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``/y``); Rewrite Rmult_assoc; Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite Rmult_1r; Symmetry; Apply p. -Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H). -Unfold Rdiv; Apply prod_neq_R0. -Assert H3 := (exp_pos x); Red; Intro; Rewrite H4 in H3; Elim (Rlt_antirefl ? H3). -Apply Rinv_neq_R0; Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H). +Lemma ln_exists : forall y:R, 0 < y -> sigT (fun z:R => y = exp z). +intros; case (Rle_dec 1 y); intro. +apply (ln_exists1 _ H r). +assert (H0 : 1 <= / y). +apply Rmult_le_reg_l with y. +apply H. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n). +red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). +assert (H1 : 0 < / y). +apply Rinv_0_lt_compat; apply H. +assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x); + apply Rmult_eq_reg_l with (exp x / y). +unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc; + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite Rmult_1_r; symmetry in |- *; apply p. +red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). +unfold Rdiv in |- *; apply prod_neq_R0. +assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3; + elim (Rlt_irrefl _ H3). +apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H; + elim (Rlt_irrefl _ H). Qed. (* Definition of log R+* -> R *) -Definition Rln [y:posreal] : R := Cases (ln_exists (pos y) (RIneq.cond_pos y)) of (existTT a b) => a end. +Definition Rln (y:posreal) : R := + match ln_exists (pos y) (cond_pos y) with + | existT a b => a + end. (* Extension on R *) -Definition ln : R->R := [x:R](Cases (total_order_Rlt R0 x) of - (leftT a) => (Rln (mkposreal x a)) - | (rightT a) => R0 end). +Definition ln (x:R) : R := + match Rlt_dec 0 x with + | left a => Rln (mkposreal x a) + | right a => 0 + end. -Lemma exp_ln : (x : R) ``0<x`` -> (exp (ln x)) == x. -Intros; Unfold ln; Case (total_order_Rlt R0 x); Intro. -Unfold Rln; Case (ln_exists (mkposreal x r) (RIneq.cond_pos (mkposreal x r))); Intros. -Simpl in e; Symmetry; Apply e. -Elim n; Apply H. +Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x. +intros; unfold ln in |- *; case (Rlt_dec 0 x); intro. +unfold Rln in |- *; + case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); + intros. +simpl in e; symmetry in |- *; apply e. +elim n; apply H. Qed. -Theorem exp_inv: (x, y : R) (exp x) == (exp y) -> x == y. -Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto; Assert H2 := (exp_increasing ? ? H1); Rewrite H in H2; Elim (Rlt_antirefl ? H2). +Theorem exp_inv : forall x y:R, exp x = exp y -> x = y. +intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto; + assert (H2 := exp_increasing _ _ H1); rewrite H in H2; + elim (Rlt_irrefl _ H2). Qed. -Theorem exp_Ropp: (x : R) ``(exp (-x)) == /(exp x)``. -Intros x; Assert H : ``(exp x)<>0``. -Assert H := (exp_pos x); Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H). -Apply r_Rmult_mult with r := (exp x). -Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0. -Apply Rinv_r_sym. -Apply H. -Apply H. +Theorem exp_Ropp : forall x:R, exp (- x) = / exp x. +intros x; assert (H : exp x <> 0). +assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H; + elim (Rlt_irrefl _ H). +apply Rmult_eq_reg_l with (r := exp x). +rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0. +apply Rinv_r_sym. +apply H. +apply H. Qed. (******************************************************************) (* Properties of Ln *) (******************************************************************) -Theorem ln_increasing: - (x, y : R) ``0<x`` -> ``x<y`` -> ``(ln x) < (ln y)``. -Intros x y H H0; Apply exp_lt_inv. -Repeat Rewrite exp_ln. -Apply H0. -Apply Rlt_trans with x; Assumption. -Apply H. +Theorem ln_increasing : forall x y:R, 0 < x -> x < y -> ln x < ln y. +intros x y H H0; apply exp_lt_inv. +repeat rewrite exp_ln. +apply H0. +apply Rlt_trans with x; assumption. +apply H. Qed. -Theorem ln_exp: (x : R) (ln (exp x)) == x. -Intros x; Apply exp_inv. -Apply exp_ln. -Apply exp_pos. +Theorem ln_exp : forall x:R, ln (exp x) = x. +intros x; apply exp_inv. +apply exp_ln. +apply exp_pos. Qed. -Theorem ln_1: ``(ln 1) == 0``. -Rewrite <- exp_0; Rewrite ln_exp; Reflexivity. +Theorem ln_1 : ln 1 = 0. +rewrite <- exp_0; rewrite ln_exp; reflexivity. Qed. -Theorem ln_lt_inv: - (x, y : R) ``0<x`` -> ``0<y`` -> ``(ln x)<(ln y)`` -> ``x<y``. -Intros x y H H0 H1; Rewrite <- (exp_ln x); Try Rewrite <- (exp_ln y). -Apply exp_increasing; Apply H1. -Assumption. -Assumption. +Theorem ln_lt_inv : forall x y:R, 0 < x -> 0 < y -> ln x < ln y -> x < y. +intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y). +apply exp_increasing; apply H1. +assumption. +assumption. Qed. -Theorem ln_inv: (x, y : R) ``0<x`` -> ``0<y`` -> (ln x) == (ln y) -> x == y. -Intros x y H H0 H'0; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto. -Assert H2 := (ln_increasing ? ? H H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2). -Assert H2 := (ln_increasing ? ? H0 H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2). +Theorem ln_inv : forall x y:R, 0 < x -> 0 < y -> ln x = ln y -> x = y. +intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; + auto. +assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2; + elim (Rlt_irrefl _ H2). +assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2; + elim (Rlt_irrefl _ H2). Qed. -Theorem ln_mult: (x, y : R) ``0<x`` -> ``0<y`` -> ``(ln (x*y)) == (ln x)+(ln y)``. -Intros x y H H0; Apply exp_inv. -Rewrite exp_plus. -Repeat Rewrite exp_ln. -Reflexivity. -Assumption. -Assumption. -Apply Rmult_lt_pos; Assumption. +Theorem ln_mult : forall x y:R, 0 < x -> 0 < y -> ln (x * y) = ln x + ln y. +intros x y H H0; apply exp_inv. +rewrite exp_plus. +repeat rewrite exp_ln. +reflexivity. +assumption. +assumption. +apply Rmult_lt_0_compat; assumption. Qed. -Theorem ln_Rinv: (x : R) ``0<x`` -> ``(ln (/x)) == -(ln x)``. -Intros x H; Apply exp_inv; Repeat (Rewrite exp_ln Orelse Rewrite exp_Ropp). -Reflexivity. -Assumption. -Apply Rlt_Rinv; Assumption. +Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x. +intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp. +reflexivity. +assumption. +apply Rinv_0_lt_compat; assumption. Qed. -Theorem ln_continue: - (y : R) ``0<y`` -> (continue_in ln [x : R] (Rlt R0 x) y). -Intros y H. -Unfold continue_in limit1_in limit_in; Intros eps Heps. -Cut (Rlt R1 (exp eps)); [Intros H1 | Idtac]. -Cut (Rlt (exp (Ropp eps)) R1); [Intros H2 | Idtac]. -Exists - (Rmin (Rmult y (Rminus (exp eps) R1)) (Rmult y (Rminus R1 (exp (Ropp eps))))); - Split. -Red; Apply P_Rmin. -Apply Rmult_lt_pos. -Assumption. -Apply Rlt_anti_compatibility with R1. -Rewrite Rplus_Or; Replace ``(1+((exp eps)-1))`` with (exp eps); [Apply H1 | Ring]. -Apply Rmult_lt_pos. -Assumption. -Apply Rlt_anti_compatibility with ``(exp (-eps))``. -Rewrite Rplus_Or; Replace ``(exp ( -eps))+(1-(exp ( -eps)))`` with R1; [Apply H2 | Ring]. -Unfold dist R_met R_dist; Simpl. -Intros x ((H3, H4), H5). -Cut (Rmult y (Rmult x (Rinv y))) == x. -Intro Hxyy. -Replace (Rminus (ln x) (ln y)) with (ln (Rmult x (Rinv y))). -Case (total_order x y); [Intros Hxy | Intros [Hxy|Hxy]]. -Rewrite Rabsolu_left. -Apply Ropp_Rlt; Rewrite Ropp_Ropp. -Apply exp_lt_inv. -Rewrite exp_ln. -Apply Rlt_monotony_contra with z := y. -Apply H. -Rewrite Hxyy. -Apply Ropp_Rlt. -Apply Rlt_anti_compatibility with r := y. -Replace (Rplus y (Ropp (Rmult y (exp (Ropp eps))))) - with (Rmult y (Rminus R1 (exp (Ropp eps)))); [Idtac | Ring]. -Replace (Rplus y (Ropp x)) with (Rabsolu (Rminus x y)); [Idtac | Ring]. -Apply Rlt_le_trans with 1 := H5; Apply Rmin_r. -Rewrite Rabsolu_left; [Ring | Idtac]. -Apply (Rlt_minus ? ? Hxy). -Apply Rmult_lt_pos; [Apply H3 | Apply (Rlt_Rinv ? H)]. -Rewrite <- ln_1. -Apply ln_increasing. -Apply Rmult_lt_pos; [Apply H3 | Apply (Rlt_Rinv ? H)]. -Apply Rlt_monotony_contra with z := y. -Apply H. -Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy. -Rewrite Hxy; Rewrite Rinv_r. -Rewrite ln_1; Rewrite Rabsolu_R0; Apply Heps. -Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H). -Rewrite Rabsolu_right. -Apply exp_lt_inv. -Rewrite exp_ln. -Apply Rlt_monotony_contra with z := y. -Apply H. -Rewrite Hxyy. -Apply Rlt_anti_compatibility with r := (Ropp y). -Replace (Rplus (Ropp y) (Rmult y (exp eps))) - with (Rmult y (Rminus (exp eps) R1)); [Idtac | Ring]. -Replace (Rplus (Ropp y) x) with (Rabsolu (Rminus x y)); [Idtac | Ring]. -Apply Rlt_le_trans with 1 := H5; Apply Rmin_l. -Rewrite Rabsolu_right; [Ring | Idtac]. -Left; Apply (Rgt_minus ? ? Hxy). -Apply Rmult_lt_pos; [Apply H3 | Apply (Rlt_Rinv ? H)]. -Rewrite <- ln_1. -Apply Rgt_ge; Red; Apply ln_increasing. -Apply Rlt_R0_R1. -Apply Rlt_monotony_contra with z := y. -Apply H. -Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy. -Rewrite ln_mult. -Rewrite ln_Rinv. -Ring. -Assumption. -Assumption. -Apply Rlt_Rinv; Assumption. -Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Ring. -Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H). -Apply Rlt_monotony_contra with (exp eps). -Apply exp_pos. -Rewrite <- exp_plus; Rewrite Rmult_1r; Rewrite Rplus_Ropp_r; Rewrite exp_0; Apply H1. -Rewrite <- exp_0. -Apply exp_increasing; Apply Heps. +Theorem ln_continue : + forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y. +intros y H. +unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps. +cut (1 < exp eps); [ intros H1 | idtac ]. +cut (exp (- eps) < 1); [ intros H2 | idtac ]. +exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split. +red in |- *; apply P_Rmin. +apply Rmult_lt_0_compat. +assumption. +apply Rplus_lt_reg_r with 1. +rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps); + [ apply H1 | ring ]. +apply Rmult_lt_0_compat. +assumption. +apply Rplus_lt_reg_r with (exp (- eps)). +rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1; + [ apply H2 | ring ]. +unfold dist, R_met, R_dist in |- *; simpl in |- *. +intros x [[H3 H4] H5]. +cut (y * (x * / y) = x). +intro Hxyy. +replace (ln x - ln y) with (ln (x * / y)). +case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ]. +rewrite Rabs_left. +apply Ropp_lt_cancel; rewrite Ropp_involutive. +apply exp_lt_inv. +rewrite exp_ln. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy. +apply Ropp_lt_cancel. +apply Rplus_lt_reg_r with (r := y). +replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps))); + [ idtac | ring ]. +replace (y + - x) with (Rabs (x - y)); [ idtac | ring ]. +apply Rlt_le_trans with (1 := H5); apply Rmin_r. +rewrite Rabs_left; [ ring | idtac ]. +apply (Rlt_minus _ _ Hxy). +apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. +rewrite <- ln_1. +apply ln_increasing. +apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. +rewrite Hxy; rewrite Rinv_r. +rewrite ln_1; rewrite Rabs_R0; apply Heps. +red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). +rewrite Rabs_right. +apply exp_lt_inv. +rewrite exp_ln. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy. +apply Rplus_lt_reg_r with (r := - y). +replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ]. +replace (- y + x) with (Rabs (x - y)); [ idtac | ring ]. +apply Rlt_le_trans with (1 := H5); apply Rmin_l. +rewrite Rabs_right; [ ring | idtac ]. +left; apply (Rgt_minus _ _ Hxy). +apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. +rewrite <- ln_1. +apply Rgt_ge; red in |- *; apply ln_increasing. +apply Rlt_0_1. +apply Rmult_lt_reg_l with (r := y). +apply H. +rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. +rewrite ln_mult. +rewrite ln_Rinv. +ring. +assumption. +assumption. +apply Rinv_0_lt_compat; assumption. +rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +ring. +red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). +apply Rmult_lt_reg_l with (exp eps). +apply exp_pos. +rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0; + apply H1. +rewrite <- exp_0. +apply exp_increasing; apply Heps. Qed. (******************************************************************) (* Definition of Rpower *) (******************************************************************) -Definition Rpower := [x : R] [y : R] ``(exp (y*(ln x)))``. +Definition Rpower (x y:R) := exp (y * ln x). -Infix Local "^R" Rpower (at level 2, left associativity) : R_scope. +Infix Local "^R" := Rpower (at level 30, left associativity) : R_scope. (******************************************************************) (* Properties of Rpower *) (******************************************************************) -Theorem Rpower_plus: - (x, y, z : R) ``(Rpower z (x+y)) == (Rpower z x)*(Rpower z y)``. -Intros x y z; Unfold Rpower. -Rewrite Rmult_Rplus_distrl; Rewrite exp_plus; Auto. +Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y. +intros x y z; unfold Rpower in |- *. +rewrite Rmult_plus_distr_r; rewrite exp_plus; auto. Qed. -Theorem Rpower_mult: - (x, y, z : R) ``(Rpower (Rpower x y) z) == (Rpower x (y*z))``. -Intros x y z; Unfold Rpower. -Rewrite ln_exp. -Replace (Rmult z (Rmult y (ln x))) with (Rmult (Rmult y z) (ln x)). -Reflexivity. -Ring. +Theorem Rpower_mult : forall x y z:R, x ^R y ^R z = x ^R (y * z). +intros x y z; unfold Rpower in |- *. +rewrite ln_exp. +replace (z * (y * ln x)) with (y * z * ln x). +reflexivity. +ring. Qed. -Theorem Rpower_O: (x : R) ``0<x`` -> ``(Rpower x 0) == 1``. -Intros x H; Unfold Rpower. -Rewrite Rmult_Ol; Apply exp_0. +Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1. +intros x H; unfold Rpower in |- *. +rewrite Rmult_0_l; apply exp_0. Qed. -Theorem Rpower_1: (x : R) ``0<x`` -> ``(Rpower x 1) == x``. -Intros x H; Unfold Rpower. -Rewrite Rmult_1l; Apply exp_ln; Apply H. +Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x. +intros x H; unfold Rpower in |- *. +rewrite Rmult_1_l; apply exp_ln; apply H. Qed. -Theorem Rpower_pow: - (n : nat) (x : R) ``0<x`` -> (Rpower x (INR n)) == (pow x n). -Intros n; Elim n; Simpl; Auto; Fold INR. -Intros x H; Apply Rpower_O; Auto. -Intros n1; Case n1. -Intros H x H0; Simpl; Rewrite Rmult_1r; Apply Rpower_1; Auto. -Intros n0 H x H0; Rewrite Rpower_plus; Rewrite H; Try Rewrite Rpower_1; Try Apply Rmult_sym Orelse Assumption. +Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> x ^R INR n = x ^ n. +intros n; elim n; simpl in |- *; auto; fold INR in |- *. +intros x H; apply Rpower_O; auto. +intros n1; case n1. +intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto. +intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1; + try apply Rmult_comm || assumption. Qed. -Theorem Rpower_lt: (x, y, z : R) ``1<x`` -> ``0<=y`` -> ``y<z`` -> ``(Rpower x y) < (Rpower x z)``. -Intros x y z H H0 H1. -Unfold Rpower. -Apply exp_increasing. -Apply Rlt_monotony_r. -Rewrite <- ln_1; Apply ln_increasing. -Apply Rlt_R0_R1. -Apply H. -Apply H1. +Theorem Rpower_lt : + forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z. +intros x y z H H0 H1. +unfold Rpower in |- *. +apply exp_increasing. +apply Rmult_lt_compat_r. +rewrite <- ln_1; apply ln_increasing. +apply Rlt_0_1. +apply H. +apply H1. Qed. -Theorem Rpower_sqrt: (x : R) ``0<x`` -> ``(Rpower x (/2)) == (sqrt x)``. -Intros x H. -Apply ln_inv. -Unfold Rpower; Apply exp_pos. -Apply sqrt_lt_R0; Apply H. -Apply r_Rmult_mult with (INR (S (S O))). -Apply exp_inv. -Fold Rpower. -Cut (Rpower (Rpower x (Rinv (Rplus R1 R1))) (INR (S (S O)))) == (Rpower (sqrt x) (INR (S (S O)))). -Unfold Rpower; Auto. -Rewrite Rpower_mult. -Rewrite Rinv_l. -Replace R1 with (INR (S O)); Auto. -Repeat Rewrite Rpower_pow; Simpl. -Pattern 1 x; Rewrite <- (sqrt_sqrt x (Rlt_le ? ? H)). -Ring. -Apply sqrt_lt_R0; Apply H. -Apply H. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Discriminate. +Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x. +intros x H. +apply ln_inv. +unfold Rpower in |- *; apply exp_pos. +apply sqrt_lt_R0; apply H. +apply Rmult_eq_reg_l with (INR 2). +apply exp_inv. +fold Rpower in |- *. +cut (x ^R (/ 2) ^R INR 2 = sqrt x ^R INR 2). +unfold Rpower in |- *; auto. +rewrite Rpower_mult. +rewrite Rinv_l. +replace 1 with (INR 1); auto. +repeat rewrite Rpower_pow; simpl in |- *. +pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)). +ring. +apply sqrt_lt_R0; apply H. +apply H. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. Qed. -Theorem Rpower_Ropp: (x, y : R) ``(Rpower x (-y)) == /(Rpower x y)``. -Unfold Rpower. -Intros x y; Rewrite Ropp_mul1. -Apply exp_Ropp. +Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y. +unfold Rpower in |- *. +intros x y; rewrite Ropp_mult_distr_l_reverse. +apply exp_Ropp. Qed. -Theorem Rle_Rpower: (e,n,m : R) ``1<e`` -> ``0<=n`` -> ``n<=m`` -> ``(Rpower e n)<=(Rpower e m)``. -Intros e n m H H0 H1; Case H1. -Intros H2; Left; Apply Rpower_lt; Assumption. -Intros H2; Rewrite H2; Right; Reflexivity. +Theorem Rle_Rpower : + forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m. +intros e n m H H0 H1; case H1. +intros H2; left; apply Rpower_lt; assumption. +intros H2; rewrite H2; right; reflexivity. Qed. -Theorem ln_lt_2: ``/2<(ln 2)``. -Apply Rlt_monotony_contra with z := (Rplus R1 R1). -Sup0. -Rewrite Rinv_r. -Apply exp_lt_inv. -Apply Rle_lt_trans with 1 := exp_le_3. -Change (Rlt (Rplus R1 (Rplus R1 R1)) (Rpower (Rplus R1 R1) (Rplus R1 R1))). -Repeat Rewrite Rpower_plus; Repeat Rewrite Rpower_1. -Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; - Repeat Rewrite Rmult_1l. -Pattern 1 ``3``; Rewrite <- Rplus_Or; Replace ``2+2`` with ``3+1``; [Apply Rlt_compatibility; Apply Rlt_R0_R1 | Ring]. -Sup0. -DiscrR. +Theorem ln_lt_2 : / 2 < ln 2. +apply Rmult_lt_reg_l with (r := 2). +prove_sup0. +rewrite Rinv_r. +apply exp_lt_inv. +apply Rle_lt_trans with (1 := exp_le_3). +change (3 < 2 ^R 2) in |- *. +repeat rewrite Rpower_plus; repeat rewrite Rpower_1. +repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rmult_1_l. +pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1); + [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ]. +prove_sup0. +discrR. Qed. (**************************************) (* Differentiability of Ln and Rpower *) (**************************************) -Theorem limit1_ext: (f, g : R -> R)(D : R -> Prop)(l, x : R) ((x : R) (D x) -> (f x) == (g x)) -> (limit1_in f D l x) -> (limit1_in g D l x). -Intros f g D l x H; Unfold limit1_in limit_in. -Intros H0 eps H1; Case (H0 eps); Auto. -Intros x0 (H2, H3); Exists x0; Split; Auto. -Intros x1 (H4, H5); Rewrite <- H; Auto. +Theorem limit1_ext : + forall (f g:R -> R) (D:R -> Prop) (l x:R), + (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x. +intros f g D l x H; unfold limit1_in, limit_in in |- *. +intros H0 eps H1; case (H0 eps); auto. +intros x0 [H2 H3]; exists x0; split; auto. +intros x1 [H4 H5]; rewrite <- H; auto. Qed. -Theorem limit1_imp: (f : R -> R)(D, D1 : R -> Prop)(l, x : R) ((x : R) (D1 x) -> (D x)) -> (limit1_in f D l x) -> (limit1_in f D1 l x). -Intros f D D1 l x H; Unfold limit1_in limit_in. -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. +Theorem limit1_imp : + forall (f:R -> R) (D D1:R -> Prop) (l x:R), + (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x. +intros f D D1 l x H; unfold limit1_in, limit_in in |- *. +intros H0 eps H1; case (H0 eps H1); auto. +intros alpha [H2 H3]; exists alpha; split; auto. +intros d [H4 H5]; apply H3; split; auto. Qed. -Theorem Rinv_Rdiv: (x, y : R) ``x<>0`` -> ``y<>0`` -> ``/(x/y) == y/x``. -Intros x y H1 H2; Unfold Rdiv; Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Apply Rmult_sym. -Assumption. -Assumption. -Apply Rinv_neq_R0; Assumption. +Theorem Rinv_Rdiv : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x. +intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +apply Rmult_comm. +assumption. +assumption. +apply Rinv_neq_0_compat; assumption. Qed. -Theorem Dln: (y : R) ``0<y`` -> (D_in ln Rinv [x:R]``0<x`` y). -Intros y Hy; Unfold D_in. -Apply limit1_ext with f := [x : R](Rinv (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y)))). -Intros x (HD1, HD2); Repeat Rewrite exp_ln. -Unfold Rdiv; Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Apply Rmult_sym. -Apply Rminus_eq_contra. -Red; Intros H2; Case HD2. -Symmetry; Apply (ln_inv ? ? HD1 Hy H2). -Apply Rminus_eq_contra; Apply (not_sym ? ? HD2). -Apply Rinv_neq_R0; Apply Rminus_eq_contra; Red; Intros H2; Case HD2; Apply ln_inv; Auto. -Assumption. -Assumption. -Apply limit_inv with f := [x : R] (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y))). -Apply limit1_imp with f := [x : R] ([x : R] (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus x (ln y))) (ln x)) D := (Dgf (D_x [x : R] (Rlt R0 x) y) (D_x [x : R] True (ln y)) ln). -Intros x (H1, H2); Split. -Split; Auto. -Split; Auto. -Red; Intros H3; Case H2; Apply ln_inv; Auto. -Apply limit_comp with l := (ln y) g := [x : R] (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus 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; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H0 ? H); Intros; Exists (pos x); Split. -Apply (RIneq.cond_pos x). -Intros; Pattern 3 y; Rewrite <- exp_ln. -Pattern 1 x0; 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 not_sym; Apply H3. -Elim H2; Clear H2; Intros _ H2; Apply H2. -Assumption. -Red; Intro; Rewrite H in Hy; Elim (Rlt_antirefl ? Hy). +Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y. +intros y Hy; unfold D_in in |- *. +apply limit1_ext with + (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))). +intros x [HD1 HD2]; repeat rewrite exp_ln. +unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +apply Rmult_comm. +apply Rminus_eq_contra. +red in |- *; intros H2; case HD2. +symmetry in |- *; apply (ln_inv _ _ HD1 Hy H2). +apply Rminus_eq_contra; apply (sym_not_eq HD2). +apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2; + case HD2; apply ln_inv; auto. +assumption. +assumption. +apply limit_inv with + (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)). +apply limit1_imp with + (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x)) + (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln). +intros x [H1 H2]; split. +split; auto. +split; auto. +red in |- *; intros H3; case H2; apply ln_inv; auto. +apply limit_comp with + (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln). +apply ln_continue; auto. +assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); + intros; exists (pos x); split. +apply (cond_pos x). +intros; pattern y at 3 in |- *; rewrite <- exp_ln. +pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y)); + [ idtac | ring ]. +apply H1. +elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3; + apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); + apply H3. +elim H2; clear H2; intros _ H2; apply H2. +assumption. +red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy). Qed. -Lemma derivable_pt_lim_ln : (x:R) ``0<x`` -> (derivable_pt_lim ln x ``/x``). -Intros; Assert H0 := (Dln x H); Unfold D_in in H0; Unfold limit1_in in H0; Unfold limit_in in H0; Simpl in H0; Unfold R_dist in H0; Unfold derivable_pt_lim; Intros; Elim (H0 ? H1); Intros; Elim H2; Clear H2; Intros; Pose alp := (Rmin x0 ``x/2``); Assert H4 : ``0<alp``. -Unfold alp; Unfold Rmin; Case (total_order_Rle x0 ``x/2``); Intro. -Apply H2. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Exists (mkposreal ? H4); Intros; Pattern 2 h; Replace h with ``(x+h)-x``; [Idtac | Ring]. -Apply H3; Split. -Unfold D_x; Split. -Case (case_Rabsolu h); Intro. -Assert H7 : ``(Rabsolu h)<x/2``. -Apply Rlt_le_trans with alp. -Apply H6. -Unfold alp; Apply Rmin_r. -Apply Rlt_trans with ``x/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. -Rewrite Rabsolu_left in H7. -Apply Rlt_anti_compatibility with ``-h-x/2``. -Replace ``-h-x/2+x/2`` with ``-h``; [Idtac | Ring]. -Pattern 2 x; Rewrite double_var. -Replace ``-h-x/2+(x/2+x/2+h)`` with ``x/2``; [Apply H7 | Ring]. -Apply r. -Apply gt0_plus_ge0_is_gt0; [Assumption | Apply Rle_sym2; Apply r]. -Apply not_sym; 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; Apply Rmin_l] | Ring]. +Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x). +intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0; + unfold limit_in in H0; simpl in H0; unfold R_dist in H0; + unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); + intros; elim H2; clear H2; intros; pose (alp := Rmin x0 (x / 2)); + assert (H4 : 0 < alp). +unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro. +apply H2. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +exists (mkposreal _ H4); intros; pattern h at 2 in |- *; + replace h with (x + h - x); [ idtac | ring ]. +apply H3; split. +unfold D_x in |- *; split. +case (Rcase_abs h); intro. +assert (H7 : Rabs h < x / 2). +apply Rlt_le_trans with alp. +apply H6. +unfold alp in |- *; apply Rmin_r. +apply Rlt_trans with (x / 2). +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +rewrite Rabs_left in H7. +apply Rplus_lt_reg_r with (- h - x / 2). +replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ]. +pattern x at 2 in |- *; rewrite double_var. +replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ]. +apply r. +apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ]. +apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h; + [ apply H5 | ring ]. +replace (x + h - x) with h; + [ apply Rlt_le_trans with alp; + [ apply H6 | unfold alp in |- *; apply Rmin_l ] + | ring ]. Qed. -Theorem D_in_imp: (f, g : R -> R)(D, D1 : R -> Prop)(x : R) ((x : R) (D1 x) -> (D x)) -> (D_in f g D x) -> (D_in f g D1 x). -Intros f g D D1 x H; Unfold D_in. -Intros H0; Apply limit1_imp with D := (D_x D x); Auto. -Intros x1 (H1, H2); Split; Auto. +Theorem D_in_imp : + forall (f g:R -> R) (D D1:R -> Prop) (x:R), + (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x. +intros f g D D1 x H; unfold D_in in |- *. +intros H0; apply limit1_imp with (D := D_x D x); auto. +intros x1 [H1 H2]; split; auto. Qed. -Theorem D_in_ext: (f, g, h : R -> R)(D : R -> Prop) (x : R) (f x) == (g x) -> (D_in h f D x) -> (D_in h g D x). -Intros f g h D x H; Unfold D_in. -Rewrite H; Auto. +Theorem D_in_ext : + forall (f g h:R -> R) (D:R -> Prop) (x:R), + f x = g x -> D_in h f D x -> D_in h g D x. +intros f g h D x H; unfold D_in in |- *. +rewrite H; auto. Qed. -Theorem Dpower: (y, z : R) ``0<y`` -> (D_in [x:R](Rpower x z) [x:R](Rmult z (Rpower x (Rminus z R1))) [x:R]``0<x`` y). -Intros y z H; Apply D_in_imp with D := (Dgf [x : R] (Rlt R0 x) [x : R] True ln). -Intros x H0; Repeat Split. -Assumption. -Apply D_in_ext with f := [x : R] (Rmult (Rinv x) (Rmult z (exp (Rmult z (ln x))))). -Unfold Rminus; Rewrite Rpower_plus; Rewrite Rpower_Ropp; Rewrite (Rpower_1 ? H); Ring. -Apply Dcomp with f := ln g := [x : R] (exp (Rmult z x)) df := Rinv dg := [x : R] (Rmult z (exp (Rmult z x))). -Apply (Dln ? H). -Apply D_in_imp with D := (Dgf [x : R] True [x : R] True [x : R] (Rmult z x)). -Intros x H1; Repeat Split; Auto. -Apply (Dcomp [_ : R] True [_ : R] True [x : ?] z exp [x : R] (Rmult z x) exp); Simpl. -Apply D_in_ext with f := [x : R] (Rmult z R1). -Apply Rmult_1r. -Apply (Dmult_const [x : ?] True [x : ?] x [x : ?] R1); Apply Dx. -Assert H0 := (derivable_pt_lim_D_in exp exp ``z*(ln y)``); Elim H0; Clear H0; Intros _ H0; Apply H0; Apply derivable_pt_lim_exp. +Theorem Dpower : + forall y z:R, + 0 < y -> + D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) ( + fun x:R => 0 < x) y. +intros y z H; + apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln). +intros x H0; repeat split. +assumption. +apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))). +unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp; + rewrite (Rpower_1 _ H); ring. +apply Dcomp with + (f := ln) + (g := fun x:R => exp (z * x)) + (df := Rinv) + (dg := fun x:R => z * exp (z * x)). +apply (Dln _ H). +apply D_in_imp with + (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)). +intros x H1; repeat split; auto. +apply + (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp + (fun x:R => z * x) exp); simpl in |- *. +apply D_in_ext with (f := fun x:R => z * 1). +apply Rmult_1_r. +apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx. +assert (H0 := derivable_pt_lim_D_in exp exp (z * ln y)); elim H0; clear H0; + intros _ H0; apply H0; apply derivable_pt_lim_exp. Qed. -Theorem derivable_pt_lim_power: (x, y : R) (Rlt R0 x) -> (derivable_pt_lim [x : ?] (Rpower x y) x (Rmult y (Rpower x (Rminus y R1)))). -Intros x y H. -Unfold Rminus; Rewrite Rpower_plus. -Rewrite Rpower_Ropp. -Rewrite Rpower_1; Auto. -Rewrite <- Rmult_assoc. -Unfold Rpower. -Apply derivable_pt_lim_comp with f1 := ln f2 := [x : ?] (exp (Rmult y x)). -Apply derivable_pt_lim_ln; Assumption. -Rewrite (Rmult_sym y). -Apply derivable_pt_lim_comp with f1 := [x : ?] (Rmult y x) f2 := exp. -Pattern 2 y; Replace y with (Rplus (Rmult R0 (ln x)) (Rmult y R1)). -Apply derivable_pt_lim_mult with f1 := [x : R] y f2 := [x : R] x. -Apply derivable_pt_lim_const with a := y. -Apply derivable_pt_lim_id. -Ring. -Apply derivable_pt_lim_exp. -Qed. +Theorem derivable_pt_lim_power : + forall x y:R, + 0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)). +intros x y H. +unfold Rminus in |- *; rewrite Rpower_plus. +rewrite Rpower_Ropp. +rewrite Rpower_1; auto. +rewrite <- Rmult_assoc. +unfold Rpower in |- *. +apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)). +apply derivable_pt_lim_ln; assumption. +rewrite (Rmult_comm y). +apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp). +pattern y at 2 in |- *; replace y with (0 * ln x + y * 1). +apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x). +apply derivable_pt_lim_const with (a := y). +apply derivable_pt_lim_id. +ring. +apply derivable_pt_lim_exp. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v index c613c7647..9d962e125 100644 --- a/theories/Reals/Rprod.v +++ b/theories/Reals/Rprod.v @@ -8,157 +8,184 @@ (*i $Id$ i*) -Require Compare. -Require Rbase. -Require Rfunctions. -Require Rseries. -Require PartSum. -Require Binomial. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Compare. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import PartSum. +Require Import Binomial. Open Local Scope R_scope. (* TT Ak; 1<=k<=N *) -Fixpoint prod_f_SO [An:nat->R;N:nat] : R := Cases N of - O => R1 -| (S p) => ``(prod_f_SO An p)*(An (S p))`` -end. +Fixpoint prod_f_SO (An:nat -> R) (N:nat) {struct N} : R := + match N with + | O => 1 + | S p => prod_f_SO An p * An (S p) + end. (**********) -Lemma prod_SO_split : (An:nat->R;n,k:nat) (le k n) -> (prod_f_SO An n)==(Rmult (prod_f_SO An k) (prod_f_SO [l:nat](An (plus k l)) (minus n k))). -Intros; Induction n. -Cut k=O; [Intro; Rewrite H0; Simpl; Ring | Inversion H; Reflexivity]. -Cut k=(S n)\/(le k n). -Intro; Elim H0; Intro. -Rewrite H1; Simpl; Rewrite <- minus_n_n; Simpl; Ring. -Replace (minus (S n) k) with (S (minus n k)). -Simpl; Replace (plus k (S (minus n k))) with (S n). -Rewrite Hrecn; [Ring | Assumption]. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite S_INR; Rewrite minus_INR; [Ring | Assumption]. -Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR. -Rewrite S_INR; Ring. -Apply le_trans with n; [Assumption | Apply le_n_Sn]. -Assumption. -Inversion H; [Left; Reflexivity | Right; Assumption]. +Lemma prod_SO_split : + forall (An:nat -> R) (n k:nat), + (k <= n)%nat -> + prod_f_SO An n = + prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k). +intros; induction n as [| n Hrecn]. +cut (k = 0%nat); + [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ]. +cut (k = S n \/ (k <= n)%nat). +intro; elim H0; intro. +rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring. +replace (S n - k)%nat with (S (n - k)). +simpl in |- *; replace (k + S (n - k))%nat with (S n). +rewrite Hrecn; [ ring | assumption ]. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite S_INR; + rewrite minus_INR; [ ring | assumption ]. +apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. +rewrite S_INR; ring. +apply le_trans with n; [ assumption | apply le_n_Sn ]. +assumption. +inversion H; [ left; reflexivity | right; assumption ]. Qed. (**********) -Lemma prod_SO_pos : (An:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)``) -> ``0<=(prod_f_SO An N)``. -Intros; Induction N. -Simpl; Left; Apply Rlt_R0_R1. -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. +Lemma prod_SO_pos : + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N. +intros; induction N as [| N HrecN]. +simpl in |- *; left; apply Rlt_0_1. +simpl in |- *; apply Rmult_le_pos. +apply HrecN; intros; apply H; apply le_trans with N; + [ assumption | apply le_n_Sn ]. +apply H; apply le_n. Qed. (**********) -Lemma prod_SO_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)<=(Bn n)``) -> ``(prod_f_SO An N)<=(prod_f_SO Bn N)``. -Intros; Induction N. -Right; Reflexivity. -Simpl; Apply Rle_trans with ``(prod_f_SO An N)*(Bn (S N))``. -Apply Rle_monotony. -Apply prod_SO_pos; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Assumption. -Elim (H (S N) (le_n (S N))); Intros; Assumption. -Do 2 Rewrite <- (Rmult_sym (Bn (S N))); Apply Rle_monotony. -Elim (H (S N) (le_n (S N))); Intros. -Apply Rle_trans with (An (S N)); Assumption. -Apply HrecN; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Split; Assumption. +Lemma prod_SO_Rle : + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) -> + prod_f_SO An N <= prod_f_SO Bn N. +intros; induction N as [| N HrecN]. +right; reflexivity. +simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)). +apply Rmult_le_compat_l. +apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; + assumption. +elim (H (S N) (le_n (S N))); intros; assumption. +do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l. +elim (H (S N) (le_n (S N))); intros. +apply Rle_trans with (An (S N)); assumption. +apply HrecN; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; + split; assumption. Qed. (* Application to factorial *) -Lemma fact_prodSO : (n:nat) (INR (fact n))==(prod_f_SO [k:nat](INR k) n). -Intro; Induction n. -Reflexivity. -Change (INR (mult (S n) (fact n)))==(prod_f_SO ([k:nat](INR k)) (S n)). -Rewrite mult_INR; Rewrite Rmult_sym; Rewrite Hrecn; Reflexivity. +Lemma fact_prodSO : + forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n. +intro; induction n as [| n Hrecn]. +reflexivity. +change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *. +rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity. Qed. -Lemma le_n_2n : (n:nat) (le n (mult (2) n)). -Induction n. -Replace (mult (2) (O)) with O; [Apply le_n | Ring]. -Intros; Replace (mult (2) (S n0)) with (S (S (mult (2) n0))). -Apply le_n_S; Apply le_S; Assumption. -Replace (S (S (mult (2) n0))) with (plus (mult (2) n0) (2)); [Idtac | Ring]. -Replace (S n0) with (plus n0 (1)); [Idtac | Ring]. -Ring. +Lemma le_n_2n : forall n:nat, (n <= 2 * n)%nat. +simple induction n. +replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ]. +intros; replace (2 * S n0)%nat with (S (S (2 * n0))). +apply le_n_S; apply le_S; assumption. +replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ]. +replace (S n0) with (n0 + 1)%nat; [ idtac | ring ]. +ring. Qed. (* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *) -Lemma RfactN_fact2N_factk : (N,k:nat) (le k (mult (2) N)) -> ``(Rsqr (INR (fact N)))<=(INR (fact (minus (mult (S (S O)) N) k)))*(INR (fact k))``. -Intros; Unfold Rsqr; Repeat Rewrite fact_prodSO. -Cut (le k N)\/(le N k). -Intro; Elim H0; Intro. -Rewrite (prod_SO_split [l:nat](INR l) (minus (mult (2) N) k) N). -Rewrite Rmult_assoc; Apply Rle_monotony. -Apply prod_SO_pos; Intros; Apply pos_INR. -Replace (minus (minus (mult (2) N) k) N) with (minus N k). -Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N k). -Apply Rle_monotony. -Apply prod_SO_pos; Intros; Apply pos_INR. -Apply prod_SO_Rle; Intros; Split. -Apply pos_INR. -Apply le_INR; Apply le_reg_r; Assumption. -Assumption. -Apply INR_eq; Repeat Rewrite minus_INR. -Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply le_trans with N; [Assumption | Apply le_n_2n]. -Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus. -Replace (mult (2) N) with (plus N N); [Idtac | Ring]. -Apply le_reg_r; Assumption. -Assumption. -Assumption. -Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus. -Replace (mult (2) N) with (plus N N); [Idtac | Ring]. -Apply le_reg_r; Assumption. -Assumption. -Rewrite <- (Rmult_sym (prod_f_SO [l:nat](INR l) k)); Rewrite (prod_SO_split [l:nat](INR l) k N). -Rewrite Rmult_assoc; Apply Rle_monotony. -Apply prod_SO_pos; Intros; Apply pos_INR. -Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N (minus (mult (2) N) k)). -Apply Rle_monotony. -Apply prod_SO_pos; Intros; Apply pos_INR. -Replace (minus N (minus (mult (2) N) k)) with (minus k N). -Apply prod_SO_Rle; Intros; Split. -Apply pos_INR. -Apply le_INR; Apply le_reg_r. -Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus. -Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption. -Assumption. -Apply INR_eq; Repeat Rewrite minus_INR. -Rewrite mult_INR; Do 2 Rewrite S_INR; Ring. -Assumption. -Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus. -Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption. -Assumption. -Assumption. -Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus. -Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption. -Assumption. -Assumption. -Elim (le_dec k N); Intro; [Left; Assumption | Right; Assumption]. +Lemma RfactN_fact2N_factk : + forall N k:nat, + (k <= 2 * N)%nat -> + Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k). +intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO. +cut ((k <= N)%nat \/ (N <= k)%nat). +intro; elim H0; intro. +rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +replace (2 * N - k - N)%nat with (N - k)%nat. +rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k). +apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +apply prod_SO_Rle; intros; split. +apply pos_INR. +apply le_INR; apply plus_le_compat_r; assumption. +assumption. +apply INR_eq; repeat rewrite minus_INR. +rewrite mult_INR; repeat rewrite S_INR; ring. +apply le_trans with N; [ assumption | apply le_n_2n ]. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. +apply plus_le_compat_r; assumption. +assumption. +assumption. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. +apply plus_le_compat_r; assumption. +assumption. +rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k)); + rewrite (prod_SO_split (fun l:nat => INR l) k N). +rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +rewrite Rmult_comm; + rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)). +apply Rmult_le_compat_l. +apply prod_SO_pos; intros; apply pos_INR. +replace (N - (2 * N - k))%nat with (k - N)%nat. +apply prod_SO_Rle; intros; split. +apply pos_INR. +apply le_INR; apply plus_le_compat_r. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; + apply plus_le_compat_r; assumption. +assumption. +apply INR_eq; repeat rewrite minus_INR. +rewrite mult_INR; do 2 rewrite S_INR; ring. +assumption. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; + apply plus_le_compat_r; assumption. +assumption. +assumption. +apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. +replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; + apply plus_le_compat_r; assumption. +assumption. +assumption. +elim (le_dec k N); intro; [ left; assumption | right; assumption ]. Qed. (**********) -Lemma INR_fact_lt_0 : (n:nat) ``0<(INR (fact n))``. -Intro; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Elim (fact_neq_0 n); Symmetry; Assumption. +Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n). +intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + elim (fact_neq_0 n); symmetry in |- *; assumption. Qed. (* We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *) -Lemma C_maj : (N,k:nat) (le k (mult (2) N)) -> ``(C (mult (S (S O)) N) k)<=(C (mult (S (S O)) N) N)``. -Intros; Unfold C; Unfold Rdiv; Apply Rle_monotony. -Apply pos_INR. -Replace (minus (mult (2) N) N) with N. -Apply Rle_monotony_contra with ``((INR (fact N))*(INR (fact N)))``. -Apply Rmult_lt_pos; Apply INR_fact_lt_0. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_sym; Apply Rle_monotony_contra with ``((INR (fact k))* - (INR (fact (minus (mult (S (S O)) N) k))))``. -Apply Rmult_lt_pos; Apply INR_fact_lt_0. -Rewrite Rmult_1r; Rewrite <- mult_INR; Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite mult_INR; Rewrite (Rmult_sym (INR (fact k))); Replace ``(INR (fact N))*(INR (fact N))`` with (Rsqr (INR (fact N))). -Apply RfactN_fact2N_factk. -Assumption. -Reflexivity. -Rewrite mult_INR; Apply prod_neq_R0; Apply INR_fact_neq_0. -Apply prod_neq_R0; Apply INR_fact_neq_0. -Apply INR_eq; Rewrite minus_INR; [Rewrite mult_INR; Do 2 Rewrite S_INR; Ring | Apply le_n_2n]. -Qed. +Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N. +intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l. +apply pos_INR. +replace (2 * N - N)%nat with N. +apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)). +apply Rmult_lt_0_compat; apply INR_fact_lt_0. +rewrite <- Rinv_r_sym. +rewrite Rmult_comm; + apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))). +apply Rmult_lt_0_compat; apply INR_fact_lt_0. +rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (INR (fact k))); + replace (INR (fact N) * INR (fact N)) with (Rsqr (INR (fact N))). +apply RfactN_fact2N_factk. +assumption. +reflexivity. +rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0. +apply prod_neq_R0; apply INR_fact_neq_0. +apply INR_eq; rewrite minus_INR; + [ rewrite mult_INR; do 2 rewrite S_INR; ring | apply le_n_2n ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v index 032524771..03544af4b 100644 --- a/theories/Reals/Rseries.v +++ b/theories/Reals/Rseries.v @@ -8,14 +8,13 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Classical. -Require Compare. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Classical. +Require Import Compare. Open Local Scope R_scope. -Implicit Variable Type r:R. +Implicit Type r : R. (* classical is needed for [Un_cv_crit] *) (*********************************************************) @@ -26,144 +25,153 @@ Implicit Variable Type r:R. Section sequence. (*********) -Variable Un:nat->R. +Variable Un : nat -> R. (*********) -Fixpoint Rmax_N [N:nat]:R:= - Cases N of - O => (Un O) - |(S n) => (Rmax (Un (S n)) (Rmax_N n)) - end. +Fixpoint Rmax_N (N:nat) : R := + match N with + | O => Un 0 + | S n => Rmax (Un (S n)) (Rmax_N n) + end. (*********) -Definition EUn:R->Prop:=[r:R](Ex [i:nat] (r==(Un i))). +Definition EUn r : Prop := exists i : nat | r = Un i. (*********) -Definition Un_cv:R->Prop:=[l:R] - (eps:R)(Rgt eps R0)->(Ex[N:nat](n:nat)(ge n N)-> - (Rlt (R_dist (Un n) l) eps)). +Definition Un_cv (l:R) : Prop := + forall eps:R, + eps > 0 -> + exists N : nat | (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps). (*********) -Definition Cauchy_crit:Prop:=(eps:R)(Rgt eps R0)-> - (Ex[N:nat] (n,m:nat)(ge n N)->(ge m N)-> - (Rlt (R_dist (Un n) (Un m)) eps)). +Definition Cauchy_crit : Prop := + forall eps:R, + eps > 0 -> + exists N : nat + | (forall n m:nat, + (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps). (*********) -Definition Un_growing:Prop:=(n:nat)(Rle (Un n) (Un (S n))). +Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n). (*********) -Lemma EUn_noempty:(ExT [r:R] (EUn r)). -Unfold EUn;Split with (Un O);Split with O;Trivial. +Lemma EUn_noempty : exists r : R | EUn r. +unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial. Qed. (*********) -Lemma Un_in_EUn:(n:nat)(EUn (Un n)). -Intro;Unfold EUn;Split with n;Trivial. +Lemma Un_in_EUn : forall n:nat, EUn (Un n). +intro; unfold EUn in |- *; split with n; trivial. Qed. (*********) -Lemma Un_bound_imp:(x:R)((n:nat)(Rle (Un n) x))->(is_upper_bound EUn x). -Intros;Unfold is_upper_bound;Intros;Unfold EUn in H0;Elim H0;Clear H0; - Intros;Generalize (H x1);Intro;Rewrite <- H0 in H1;Trivial. +Lemma Un_bound_imp : + forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x. +intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0; + clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; + trivial. Qed. (*********) -Lemma growing_prop:(n,m:nat)Un_growing->(ge n m)->(Rge (Un n) (Un m)). -Double Induction n m;Intros. -Unfold Rge;Right;Trivial. -ElimType False;Unfold ge in H1;Generalize (le_Sn_O n0);Intro;Auto. -Cut (ge n0 (0)). -Generalize H0;Intros;Unfold Un_growing in H0; - Apply (Rge_trans (Un (S n0)) (Un n0) (Un (0)) - (Rle_sym1 (Un n0) (Un (S n0)) (H0 n0)) (H O H2 H3)). -Elim n0;Auto. -Elim (lt_eq_lt_dec n1 n0);Intro y. -Elim y;Clear y;Intro y. -Unfold ge in H2;Generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2));Intro; - ElimType False;Auto. -Rewrite y;Unfold Rge;Right;Trivial. -Unfold ge in H0;Generalize (H0 (S n0) H1 (lt_le_S n0 n1 y));Intro; - Unfold Un_growing in H1; - Apply (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) - (Rle_sym1 (Un n1) (Un (S n1)) (H1 n1)) H3). +Lemma growing_prop : + forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m. +double induction n m; intros. +unfold Rge in |- *; right; trivial. +elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto. +cut (n0 >= 0)%nat. +generalize H0; intros; unfold Un_growing in H0; + apply + (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0)) + (H 0%nat H2 H3)). +elim n0; auto. +elim (lt_eq_lt_dec n1 n0); intro y. +elim y; clear y; intro y. +unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro; + elimtype False; auto. +rewrite y; unfold Rge in |- *; right; trivial. +unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro; + unfold Un_growing in H1; + apply + (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) + (Rle_ge (Un n1) (Un (S n1)) (H1 n1)) H3). Qed. (* classical is needed: [not_all_not_ex] *) (*********) -Lemma Un_cv_crit:Un_growing->(bound EUn)->(ExT [l:R] (Un_cv l)). -Unfold Un_growing Un_cv;Intros; - Generalize (complet_weak EUn H0 EUn_noempty);Intro; - Elim H1;Clear H1;Intros;Split with x;Intros; - Unfold is_lub in H1;Unfold bound in H0;Unfold is_upper_bound in H0 H1; - Elim H0;Clear H0;Intros;Elim H1;Clear H1;Intros; - Generalize (H3 x0 H0);Intro;Cut (n:nat)(Rle (Un n) x);Intro. -Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))). -Intro;Elim H6;Clear H6;Intros;Split with x1. -Intros;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps). -Unfold Rgt in H2; - Apply (Rle_lt_trans (Rminus (Un n) x) R0 eps - (Rle_minus (Un n) x (H5 n)) H2). -Fold Un_growing in H;Generalize (growing_prop n x1 H H7);Intro; - Generalize (Rlt_le_trans (Rminus x eps) (Un x1) (Un n) H6 - (Rle_sym2 (Un x1) (Un n) H8));Intro; - Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9); - Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps)); - Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x); - Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2); - Trivial. -Cut ~((N:nat)(Rge (Rminus x eps) (Un N))). -Intro;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N)))); - Red;Intro;Red in H6;Elim H6;Clear H6;Intro; - Apply (Rlt_not_ge (Rminus x eps) (Un N) (H7 N)). -Red;Intro;Cut (N:nat)(Rle (Un N) (Rminus x eps)). -Intro;Generalize (Un_bound_imp (Rminus x eps) H7);Intro; - Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);Intro; - Generalize (Rle_minus x (Rminus x eps) H9);Unfold Rminus; - Rewrite Ropp_distr1;Rewrite <- Rplus_assoc;Rewrite Rplus_Ropp_r; - Rewrite (let (H1,H2)=(Rplus_ne (Ropp (Ropp eps))) in H2); - Rewrite Ropp_Ropp;Intro;Unfold Rgt in H2; - Generalize (Rle_not eps R0 H2);Intro;Auto. -Intro;Elim (H6 N);Intro;Unfold Rle. -Left;Unfold Rgt in H7;Assumption. -Right;Auto. -Apply (H1 (Un n) (Un_in_EUn n)). +Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R | Un_cv l. +unfold Un_growing, Un_cv in |- *; intros; + generalize (completeness_weak EUn H0 EUn_noempty); + intro; elim H1; clear H1; intros; split with x; intros; + unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1; + elim H0; clear H0; intros; elim H1; clear H1; intros; + generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); + intro. +cut ( exists N : nat | x - eps < Un N). +intro; elim H6; clear H6; intros; split with x1. +intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). +unfold Rgt in H2; + apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2). +fold Un_growing in H; generalize (growing_prop n x1 H H7); intro; + generalize + (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8)); + intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); + rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; + rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); + trivial. +cut (~ (forall N:nat, x - eps >= Un N)). +intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *; + intro; red in H6; elim H6; clear H6; intro; + apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)). +red in |- *; intro; cut (forall N:nat, Un N <= x - eps). +intro; generalize (Un_bound_imp (x - eps) H7); intro; + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); + rewrite Ropp_involutive; intro; unfold Rgt in H2; + generalize (Rgt_not_le eps 0 H2); intro; auto. +intro; elim (H6 N); intro; unfold Rle in |- *. +left; unfold Rgt in H7; assumption. +right; auto. +apply (H1 (Un n) (Un_in_EUn n)). Qed. (*********) -Lemma finite_greater:(N:nat)(ExT [M:R] (n:nat)(le n N)->(Rle (Un n) M)). -Intro;Induction N. -Split with (Un O);Intros;Rewrite (le_n_O_eq n H); - Apply (eq_Rle (Un (n)) (Un (n)) (refl_eqT R (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 (Rle (Un n) (Un n)) (Rle (Un n) x) - (eq_Rle (Un n) (Un n) (refl_eqT R (Un n))))). -Apply (H2 (or_intror (Rle (Un n) (Un (S N))) (Rle (Un n) x) - (H n H3))). +Lemma finite_greater : + forall N:nat, exists M : R | (forall n:nat, (n <= N)%nat -> Un n <= M). +intro; induction N as [| N HrecN]. +split with (Un 0); intros; rewrite (le_n_O_eq n H); + apply (Req_le (Un n) (Un n) (refl_equal (Un n))). +elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros; + elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; + inversion H0. +rewrite <- H1; rewrite <- H1 in H2; + apply + (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))). +apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))). Qed. (*********) -Lemma cauchy_bound:Cauchy_crit->(bound EUn). -Unfold Cauchy_crit bound;Intros;Unfold is_upper_bound; - Unfold Rgt in H;Elim (H R1 Rlt_R0_R1);Clear H;Intros; - Generalize (H x);Intro;Generalize (le_dec x);Intro; - Elim (finite_greater x);Intros;Split with (Rmax x0 (Rplus (Un x) R1)); - Clear H;Intros;Unfold EUn in H;Elim H;Clear H;Intros;Elim (H1 x2); - Clear H1;Intro y. -Unfold ge in H0;Generalize (H0 x2 (le_n x) y);Clear H0;Intro; - Rewrite <- H in H0;Unfold R_dist in H0; - Elim (Rabsolu_def2 (Rminus (Un x) x1) R1 H0);Clear H0;Intros; - Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Apply H4;Clear H3 H4; - Right;Clear H H0 y;Apply (Rlt_le x1 (Rplus (Un x) R1)); - Generalize (Rlt_minus (Ropp R1) (Rminus (Un x) x1) H1);Clear H1; - Intro;Apply (Rminus_lt x1 (Rplus (Un x) R1)); - Cut (Rminus (Ropp R1) (Rminus (Un x) x1))== - (Rminus x1 (Rplus (Un x) R1));[Intro;Rewrite H0 in H;Assumption|Ring]. -Generalize (H2 x2 y);Clear H2 H0;Intro;Rewrite<-H in H0; - Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Clear H1;Apply H2; - Left;Assumption. +Lemma cauchy_bound : Cauchy_crit -> bound EUn. +unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *; + unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; + generalize (H x); intro; generalize (le_dec x); intro; + elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); + clear H; intros; unfold EUn in H; elim H; clear H; + intros; elim (H1 x2); clear H1; intro y. +unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro; + rewrite <- H in H0; unfold R_dist in H0; elim (Rabs_def2 (Un x - x1) 1 H0); + clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); + intros; apply H4; clear H3 H4; right; clear H H0 y; + apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1); + clear H1; intro; apply (Rminus_lt x1 (Un x + 1)); + cut (-1 - (Un x - x1) = x1 - (Un x + 1)); + [ intro; rewrite H0 in H; assumption | ring ]. +generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0; + elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; + apply H2; left; assumption. Qed. End sequence. @@ -176,104 +184,92 @@ End sequence. Section Isequence. (*********) -Variable An:nat->R. +Variable An : nat -> R. (*********) -Definition Pser:R->R->Prop:=[x,l:R] - (infinit_sum [n:nat](Rmult (An n) (pow x n)) l). +Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l. End Isequence. -Lemma GP_infinite: - (x:R) (Rlt (Rabsolu x) R1) - -> (Pser ([n:nat] R1) x (Rinv(Rminus R1 x))). -Intros;Unfold Pser; Unfold infinit_sum;Intros;Elim (Req_EM x R0). -Intros;Exists O; Intros;Rewrite H1;Rewrite minus_R0;Rewrite Rinv_R1; - Cut (sum_f_R0 [n0:nat](Rmult R1 (pow R0 n0)) n)==R1. -Intros; Rewrite H3;Rewrite R_dist_eq;Auto. -Elim n; Simpl. -Ring. -Intros;Rewrite H3;Ring. -Intro;Cut (Rlt R0 - (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) - (Rabsolu (Rinv x))))). -Intro;Elim (pow_lt_1_zero x H - (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) - (Rabsolu (Rinv x)))) - H2);Intro N; Intros;Exists N; Intros; - Cut (sum_f_R0 [n0:nat](Rmult R1 (pow x n0)) n)== - (sum_f_R0 [n0:nat](pow x n0) n). -Intros; Rewrite H5;Apply (Rlt_monotony_rev - (Rabsolu (Rminus R1 x)) - (R_dist (sum_f_R0 [n0:nat](pow x n0) n) - (Rinv (Rminus R1 x))) - eps). -Apply Rabsolu_pos_lt. -Apply Rminus_eq_contra. -Apply imp_not_Req. -Right; Unfold Rgt. -Apply (Rle_lt_trans x (Rabsolu x) R1). -Apply Rle_Rabsolu. -Assumption. -Unfold R_dist; Rewrite <- Rabsolu_mult. -Rewrite Rminus_distr. -Cut (Rmult (Rminus R1 x) (sum_f_R0 [n0:nat](pow x n0) n))== - (Ropp (Rmult(sum_f_R0 [n0:nat](pow x n0) n) - (Rminus x R1))). -Intro; Rewrite H6. -Rewrite GP_finite. -Rewrite Rinv_r. -Cut (Rminus (Ropp (Rminus (pow x (plus n (1))) R1)) R1)== - (Ropp (pow x (plus n (1)))). -Intro; Rewrite H7. -Rewrite Rabsolu_Ropp;Cut (plus n (S O))=(S n);Auto. -Intro H8;Rewrite H8;Simpl;Rewrite Rabsolu_mult; - Apply (Rlt_le_trans (Rmult (Rabsolu x) (Rabsolu (pow x n))) - (Rmult (Rabsolu x) - (Rmult eps - (Rmult (Rabsolu (Rminus R1 x)) - (Rabsolu (Rinv x))))) - (Rmult (Rabsolu (Rminus R1 x)) eps)). -Apply Rlt_monotony. -Apply Rabsolu_pos_lt. -Assumption. -Auto. -Cut (Rmult (Rabsolu x) - (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) - (Rabsolu (Rinv x)))))== - (Rmult (Rmult (Rabsolu x) (Rabsolu (Rinv x))) - (Rmult eps (Rabsolu (Rminus R1 x)))). -Clear H8;Intros; Rewrite H8;Rewrite <- Rabsolu_mult;Rewrite Rinv_r. -Rewrite Rabsolu_R1;Cut (Rmult R1 (Rmult eps (Rabsolu (Rminus R1 x))))== - (Rmult (Rabsolu (Rminus R1 x)) eps). -Intros; Rewrite H9;Unfold Rle; Right; Reflexivity. -Ring. -Assumption. -Ring. -Ring. -Ring. -Apply Rminus_eq_contra. -Apply imp_not_Req. -Right; Unfold Rgt. -Apply (Rle_lt_trans x (Rabsolu x) R1). -Apply Rle_Rabsolu. -Assumption. -Ring; Ring. -Elim n; Simpl. -Ring. -Intros; Rewrite H5. -Ring. -Apply Rmult_lt_pos. -Auto. -Apply Rmult_lt_pos. -Apply Rabsolu_pos_lt. -Apply Rminus_eq_contra. -Apply imp_not_Req. -Right; Unfold Rgt. -Apply (Rle_lt_trans x (Rabsolu x) R1). -Apply Rle_Rabsolu. -Assumption. -Apply Rabsolu_pos_lt. -Apply Rinv_neq_R0. -Assumption. -Qed. +Lemma GP_infinite : + forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)). +intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros; + elim (Req_dec x 0). +intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1; + cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1). +intros; rewrite H3; rewrite R_dist_eq; auto. +elim n; simpl in |- *. +ring. +intros; rewrite H3; ring. +intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))). +intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2); + intro N; intros; exists N; intros; + cut + (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n). +intros; rewrite H5; + apply + (Rmult_lt_reg_l (Rabs (1 - x)) + (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps). +apply Rabs_pos_lt. +apply Rminus_eq_contra. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *. +apply (Rle_lt_trans x (Rabs x) 1). +apply RRle_abs. +assumption. +unfold R_dist in |- *; rewrite <- Rabs_mult. +rewrite Rmult_minus_distr_l. +cut + ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n = + - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))). +intro; rewrite H6. +rewrite GP_finite. +rewrite Rinv_r. +cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)). +intro; rewrite H7. +rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto. +intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult; + apply + (Rlt_le_trans (Rabs x * Rabs (x ^ n)) + (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) ( + Rabs (1 - x) * eps)). +apply Rmult_lt_compat_l. +apply Rabs_pos_lt. +assumption. +auto. +cut + (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) = + Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))). +clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r. +rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps). +intros; rewrite H9; unfold Rle in |- *; right; reflexivity. +ring. +assumption. +ring. +ring. +ring. +apply Rminus_eq_contra. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *. +apply (Rle_lt_trans x (Rabs x) 1). +apply RRle_abs. +assumption. +ring; ring. +elim n; simpl in |- *. +ring. +intros; rewrite H5. +ring. +apply Rmult_lt_0_compat. +auto. +apply Rmult_lt_0_compat. +apply Rabs_pos_lt. +apply Rminus_eq_contra. +apply Rlt_dichotomy_converse. +right; unfold Rgt in |- *. +apply (Rle_lt_trans x (Rabs x) 1). +apply RRle_abs. +assumption. +apply Rabs_pos_lt. +apply Rinv_neq_0_compat. +assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v index fd14d2c8c..592ddf68f 100644 --- a/theories/Reals/Rsigma.v +++ b/theories/Reals/Rsigma.v @@ -8,110 +8,133 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require PartSum. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import PartSum. Open Local Scope R_scope. Set Implicit Arguments. Section Sigma. -Variable f : nat->R. +Variable f : nat -> R. -Definition sigma [low,high:nat] : R := (sum_f_R0 [k:nat](f (plus low k)) (minus high low)). +Definition sigma (low high:nat) : R := + sum_f_R0 (fun k:nat => f (low + k)) (high - low). -Theorem sigma_split : (low,high,k:nat) (le low k)->(lt k high)->``(sigma low high)==(sigma low k)+(sigma (S k) high)``. -Intros; Induction k. -Cut low = O. -Intro; Rewrite H1; Unfold sigma; Rewrite <- minus_n_n; Rewrite <- minus_n_O; Simpl; Replace (minus high (S O)) with (pred high). -Apply (decomp_sum [k:nat](f k)). -Assumption. -Apply pred_of_minus. -Inversion H; Reflexivity. -Cut (le low k)\/low=(S k). -Intro; Elim H1; Intro. -Replace (sigma low (S k)) with ``(sigma low k)+(f (S k))``. -Rewrite Rplus_assoc; Replace ``(f (S k))+(sigma (S (S k)) high)`` with (sigma (S k) high). -Apply Hreck. -Assumption. -Apply lt_trans with (S k); [Apply lt_n_Sn | Assumption]. -Unfold sigma; Replace (minus high (S (S k))) with (pred (minus high (S k))). -Pattern 3 (S k); Replace (S k) with (plus (S k) O); [Idtac | Ring]. -Replace (sum_f_R0 [k0:nat](f (plus (S (S k)) k0)) (pred (minus high (S k)))) with (sum_f_R0 [k0:nat](f (plus (S k) (S k0))) (pred (minus high (S k)))). -Apply (decomp_sum [i:nat](f (plus (S k) i))). -Apply lt_minus_O_lt; Assumption. -Apply sum_eq; Intros; Replace (plus (S k) (S i)) with (plus (S (S k)) i). -Reflexivity. -Apply INR_eq; Do 2 Rewrite plus_INR; Do 3 Rewrite S_INR; Ring. -Replace (minus high (S (S k))) with (minus (minus high (S k)) (S O)). -Apply pred_of_minus. -Apply INR_eq; Repeat Rewrite minus_INR. -Do 4 Rewrite S_INR; Ring. -Apply lt_le_S; Assumption. -Apply lt_le_weak; Assumption. -Apply lt_le_S; Apply lt_minus_O_lt; Assumption. -Unfold sigma; Replace (minus (S k) low) with (S (minus k low)). -Pattern 1 (S k); Replace (S k) with (plus low (S (minus k low))). -Symmetry; Apply (tech5 [i:nat](f (plus low i))). -Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR. -Ring. -Assumption. -Apply minus_Sn_m; Assumption. -Rewrite <- H2; Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (minus high (S low)) with (pred (minus high low)). -Replace (sum_f_R0 [k0:nat](f (S (plus low k0))) (pred (minus high low))) with (sum_f_R0 [k0:nat](f (plus low (S k0))) (pred (minus high low))). -Apply (decomp_sum [k0:nat](f (plus low k0))). -Apply lt_minus_O_lt. -Apply le_lt_trans with (S k); [Rewrite H2; Apply le_n | Assumption]. -Apply sum_eq; Intros; Replace (S (plus low i)) with (plus low (S i)). -Reflexivity. -Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Ring. -Replace (minus high (S low)) with (minus (minus high low) (S O)). -Apply pred_of_minus. -Apply INR_eq; Repeat Rewrite minus_INR. -Do 2 Rewrite S_INR; Ring. -Apply lt_le_S; Rewrite H2; Assumption. -Rewrite H2; Apply lt_le_weak; Assumption. -Apply lt_le_S; Apply lt_minus_O_lt; Rewrite H2; Assumption. -Inversion H; [ - Right; Reflexivity -| Left; Assumption]. +Theorem sigma_split : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high. +intros; induction k as [| k Hreck]. +cut (low = 0%nat). +intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n; + rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high). +apply (decomp_sum (fun k:nat => f k)). +assumption. +apply pred_of_minus. +inversion H; reflexivity. +cut ((low <= k)%nat \/ low = S k). +intro; elim H1; intro. +replace (sigma low (S k)) with (sigma low k + f (S k)). +rewrite Rplus_assoc; + replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high). +apply Hreck. +assumption. +apply lt_trans with (S k); [ apply lt_n_Sn | assumption ]. +unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)). +pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat; + [ idtac | ring ]. +replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with + (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))). +apply (decomp_sum (fun i:nat => f (S k + i))). +apply lt_minus_O_lt; assumption. +apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat. +reflexivity. +apply INR_eq; do 2 rewrite plus_INR; do 3 rewrite S_INR; ring. +replace (high - S (S k))%nat with (high - S k - 1)%nat. +apply pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +do 4 rewrite S_INR; ring. +apply lt_le_S; assumption. +apply lt_le_weak; assumption. +apply lt_le_S; apply lt_minus_O_lt; assumption. +unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)). +pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat. +symmetry in |- *; apply (tech5 (fun i:nat => f (low + i))). +apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite minus_INR. +ring. +assumption. +apply minus_Sn_m; assumption. +rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + replace (high - S low)%nat with (pred (high - low)). +replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with + (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))). +apply (decomp_sum (fun k0:nat => f (low + k0))). +apply lt_minus_O_lt. +apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ]. +apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat. +reflexivity. +apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; ring. +replace (high - S low)%nat with (high - low - 1)%nat. +apply pred_of_minus. +apply INR_eq; repeat rewrite minus_INR. +do 2 rewrite S_INR; ring. +apply lt_le_S; rewrite H2; assumption. +rewrite H2; apply lt_le_weak; assumption. +apply lt_le_S; apply lt_minus_O_lt; rewrite H2; assumption. +inversion H; [ right; reflexivity | left; assumption ]. Qed. -Theorem sigma_diff : (low,high,k:nat) (le low k) -> (lt k high )->``(sigma low high)-(sigma low k)==(sigma (S k) high)``. -Intros low high k H1 H2; Symmetry; Rewrite -> (sigma_split H1 H2); Ring. +Theorem sigma_diff : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high. +intros low high k H1 H2; symmetry in |- *; rewrite (sigma_split H1 H2); ring. Qed. -Theorem sigma_diff_neg : (low,high,k:nat) (le low k) -> (lt k high)-> ``(sigma low k)-(sigma low high)==-(sigma (S k) high)``. -Intros low high k H1 H2; Rewrite -> (sigma_split H1 H2); Ring. +Theorem sigma_diff_neg : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high. +intros low high k H1 H2; rewrite (sigma_split H1 H2); ring. Qed. -Theorem sigma_first : (low,high:nat) (lt low high) -> ``(sigma low high)==(f low)+(sigma (S low) high)``. -Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f low)`` with ``(sigma low low)``. -Apply sigma_split. -Apply le_n. -Assumption. -Unfold sigma; Rewrite <- minus_n_n. -Simpl. -Replace (plus low O) with low; [Reflexivity | Ring]. +Theorem sigma_first : + forall low high:nat, + (low < high)%nat -> sigma low high = f low + sigma (S low) high. +intros low high H1; generalize (lt_le_S low high H1); intro H2; + generalize (lt_le_weak low high H1); intro H3; + replace (f low) with (sigma low low). +apply sigma_split. +apply le_n. +assumption. +unfold sigma in |- *; rewrite <- minus_n_n. +simpl in |- *. +replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. -Theorem sigma_last : (low,high:nat) (lt low high) -> ``(sigma low high)==(f high)+(sigma low (pred high))``. -Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f high)`` with ``(sigma high high)``. -Rewrite Rplus_sym; Cut high = (S (pred high)). -Intro; Pattern 3 high; 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 O; Apply le_lt_trans with low; [Apply le_O_n | Assumption]. -Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (plus high O) with high; [Reflexivity | Ring]. +Theorem sigma_last : + forall low high:nat, + (low < high)%nat -> sigma low high = f high + sigma low (pred high). +intros low high H1; generalize (lt_le_S low high H1); intro H2; + generalize (lt_le_weak low high H1); intro H3; + replace (f high) with (sigma high high). +rewrite Rplus_comm; cut (high = S (pred high)). +intro; pattern high at 3 in |- *; rewrite H. +apply sigma_split. +apply le_S_n; rewrite <- H; apply lt_le_S; assumption. +apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ]. +apply S_pred with 0%nat; apply le_lt_trans with low; + [ apply le_O_n | assumption ]. +unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + replace (high + 0)%nat with high; [ reflexivity | ring ]. Qed. -Theorem sigma_eq_arg : (low:nat) (sigma low low)==(f low). -Intro; Unfold sigma; Rewrite <- minus_n_n. -Simpl; Replace (plus low O) with low; [Reflexivity | Ring]. +Theorem sigma_eq_arg : forall low:nat, sigma low low = f low. +intro; unfold sigma in |- *; rewrite <- minus_n_n. +simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. -End Sigma. +End Sigma.
\ No newline at end of file diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v index ebdece374..b123f1bb7 100644 --- a/theories/Reals/Rsqrt_def.v +++ b/theories/Reals/Rsqrt_def.v @@ -8,681 +8,755 @@ (*i $Id$ i*) -Require Sumbool. -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Ranalysis1. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Sumbool. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Ranalysis1. Open Local Scope R_scope. -Fixpoint Dichotomy_lb [x,y:R;P:R->bool;N:nat] : R := -Cases N of - O => x -| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2`` in if (P z) then down else z -end -with Dichotomy_ub [x,y:R;P:R->bool;N:nat] : R := -Cases N of - O => y -| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2`` in if (P z) then z else up -end. +Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R := + match N with + | O => x + | S n => + let down := Dichotomy_lb x y P n in + let up := Dichotomy_ub x y P n in + let z := (down + up) / 2 in if P z then down else z + end + + with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R := + match N with + | O => y + | S n => + let down := Dichotomy_lb x y P n in + let up := Dichotomy_ub x y P n in + let z := (down + up) / 2 in if P z then z else up + end. -Definition dicho_lb [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_lb x y P N). -Definition dicho_up [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_ub x y P N). +Definition dicho_lb (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_lb x y P N. +Definition dicho_up (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_ub x y P N. (**********) -Lemma dicho_comp : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_lb x y P n)<=(dicho_up x y P n)``. -Intros. -Induction n. -Simpl; Assumption. -Simpl. -Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``). -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Pattern 1 ``2``; Rewrite Rmult_sym. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]. -Rewrite Rmult_1r. -Rewrite double. -Apply Rle_compatibility. -Assumption. -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Pattern 3 ``2``; Rewrite Rmult_sym. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]. -Rewrite Rmult_1r. -Rewrite double. -Rewrite <- (Rplus_sym (Dichotomy_ub x y P n)). -Apply Rle_compatibility. -Assumption. +Lemma dicho_comp : + forall (x y:R) (P:R -> bool) (n:nat), + x <= y -> dicho_lb x y P n <= dicho_up x y P n. +intros. +induction n as [| n Hrecn]. +simpl in |- *; assumption. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 1 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +apply Rplus_le_compat_l. +assumption. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 3 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +rewrite <- (Rplus_comm (Dichotomy_ub x y P n)). +apply Rplus_le_compat_l. +assumption. Qed. -Lemma dicho_lb_growing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_growing (dicho_lb x y P)). -Intros. -Unfold Un_growing. -Intro. -Simpl. -Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``). -Right; Reflexivity. -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Pattern 1 ``2``; Rewrite Rmult_sym. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]. -Rewrite Rmult_1r. -Rewrite double. -Apply Rle_compatibility. -Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Apply dicho_comp; Assumption | Reflexivity]. +Lemma dicho_lb_growing : + forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P). +intros. +unfold Un_growing in |- *. +intro. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +right; reflexivity. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 1 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +apply Rplus_le_compat_l. +replace (Dichotomy_ub x y P n) with (dicho_up x y P n); + [ apply dicho_comp; assumption | reflexivity ]. Qed. -Lemma dicho_up_decreasing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_decreasing (dicho_up x y P)). -Intros. -Unfold Un_decreasing. -Intro. -Simpl. -Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``). -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Pattern 3 ``2``; Rewrite Rmult_sym. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]. -Rewrite Rmult_1r. -Rewrite double. -Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Idtac | Reflexivity]. -Replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); [Idtac | Reflexivity]. -Rewrite <- (Rplus_sym ``(dicho_up x y P n)``). -Apply Rle_compatibility. -Apply dicho_comp; Assumption. -Right; Reflexivity. +Lemma dicho_up_decreasing : + forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P). +intros. +unfold Un_decreasing in |- *. +intro. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 3 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. +rewrite Rmult_1_r. +rewrite double. +replace (Dichotomy_ub x y P n) with (dicho_up x y P n); + [ idtac | reflexivity ]. +replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); + [ idtac | reflexivity ]. +rewrite <- (Rplus_comm (dicho_up x y P n)). +apply Rplus_le_compat_l. +apply dicho_comp; assumption. +right; reflexivity. Qed. -Lemma dicho_lb_maj_y : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``(dicho_lb x y P n)<=y``. -Intros. -Induction n. -Simpl; Assumption. -Simpl. -Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``). -Assumption. -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Pattern 3 ``2``; Rewrite Rmult_sym. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR]. -Rewrite double; Apply Rplus_le. -Assumption. -Pattern 2 y; Replace y with (Dichotomy_ub x y P O); [Idtac | Reflexivity]. -Apply decreasing_prop. -Assert H0 := (dicho_up_decreasing x y P H). -Assumption. -Apply le_O_n. +Lemma dicho_lb_maj_y : + forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y. +intros. +induction n as [| n Hrecn]. +simpl in |- *; assumption. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +assumption. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 3 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. +rewrite double; apply Rplus_le_compat. +assumption. +pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0); + [ idtac | reflexivity ]. +apply decreasing_prop. +assert (H0 := dicho_up_decreasing x y P H). +assumption. +apply le_O_n. Qed. -Lemma dicho_lb_maj : (x,y:R;P:R->bool) ``x<=y`` -> (has_ub (dicho_lb x y P)). -Intros. -Cut (n:nat)``(dicho_lb x y P n)<=y``. -Intro. -Unfold has_ub. -Unfold bound. -Exists y. -Unfold is_upper_bound. -Intros. -Elim H1; Intros. -Rewrite H2; Apply H0. -Apply dicho_lb_maj_y; Assumption. +Lemma dicho_lb_maj : + forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P). +intros. +cut (forall n:nat, dicho_lb x y P n <= y). +intro. +unfold has_ub in |- *. +unfold bound in |- *. +exists y. +unfold is_upper_bound in |- *. +intros. +elim H1; intros. +rewrite H2; apply H0. +apply dicho_lb_maj_y; assumption. Qed. -Lemma dicho_up_min_x : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``x<=(dicho_up x y P n)``. -Intros. -Induction n. -Simpl; Assumption. -Simpl. -Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``). -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Pattern 1 ``2``; Rewrite Rmult_sym. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR]. -Rewrite double; Apply Rplus_le. -Pattern 1 x; Replace x with (Dichotomy_lb x y P O); [Idtac | Reflexivity]. -Apply tech9. -Assert H0 := (dicho_lb_growing x y P H). -Assumption. -Apply le_O_n. -Assumption. -Assumption. +Lemma dicho_up_min_x : + forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n. +intros. +induction n as [| n Hrecn]. +simpl in |- *; assumption. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +pattern 2 at 1 in |- *; rewrite Rmult_comm. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. +rewrite double; apply Rplus_le_compat. +pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0); + [ idtac | reflexivity ]. +apply tech9. +assert (H0 := dicho_lb_growing x y P H). +assumption. +apply le_O_n. +assumption. +assumption. Qed. -Lemma dicho_up_min : (x,y:R;P:R->bool) ``x<=y`` -> (has_lb (dicho_up x y P)). -Intros. -Cut (n:nat)``x<=(dicho_up x y P n)``. -Intro. -Unfold has_lb. -Unfold bound. -Exists ``-x``. -Unfold is_upper_bound. -Intros. -Elim H1; Intros. -Rewrite H2. -Unfold opp_seq. -Apply Rle_Ropp1. -Apply H0. -Apply dicho_up_min_x; Assumption. +Lemma dicho_up_min : + forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P). +intros. +cut (forall n:nat, x <= dicho_up x y P n). +intro. +unfold has_lb in |- *. +unfold bound in |- *. +exists (- x). +unfold is_upper_bound in |- *. +intros. +elim H1; intros. +rewrite H2. +unfold opp_seq in |- *. +apply Ropp_le_contravar. +apply H0. +apply dicho_up_min_x; assumption. Qed. -Lemma dicho_lb_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_lb x y P) l)). -Intros. -Apply growing_cv. -Apply dicho_lb_growing; Assumption. -Apply dicho_lb_maj; Assumption. +Lemma dicho_lb_cv : + forall (x y:R) (P:R -> bool), + x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l). +intros. +apply growing_cv. +apply dicho_lb_growing; assumption. +apply dicho_lb_maj; assumption. Qed. -Lemma dicho_up_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_up x y P) l)). -Intros. -Apply decreasing_cv. -Apply dicho_up_decreasing; Assumption. -Apply dicho_up_min; Assumption. +Lemma dicho_up_cv : + forall (x y:R) (P:R -> bool), + x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l). +intros. +apply decreasing_cv. +apply dicho_up_decreasing; assumption. +apply dicho_up_min; assumption. Qed. -Lemma dicho_lb_dicho_up : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_up x y P n)-(dicho_lb x y P n)==(y-x)/(pow 2 n)``. -Intros. -Induction n. -Simpl. -Unfold Rdiv; Rewrite Rinv_R1; Ring. -Simpl. -Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``). -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; Rewrite Hrecn. -Unfold Rdiv. -Rewrite Rinv_Rmult. -Ring. -DiscrR. -Apply pow_nonzero; DiscrR. -Pattern 2 (Dichotomy_lb x y P n); Rewrite (double_var (Dichotomy_lb x y P n)); 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; Rewrite Hrecn. -Unfold Rdiv. -Rewrite Rinv_Rmult. -Ring. -DiscrR. -Apply pow_nonzero; DiscrR. -Pattern 1 (Dichotomy_ub x y P n); Rewrite (double_var (Dichotomy_ub x y P n)); Unfold dicho_up dicho_lb Rminus Rdiv; Ring. +Lemma dicho_lb_dicho_up : + forall (x y:R) (P:R -> bool) (n:nat), + x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n. +intros. +induction n as [| n Hrecn]. +simpl in |- *. +unfold Rdiv in |- *; rewrite Rinv_1; ring. +simpl in |- *. +case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). +unfold Rdiv in |- *. +replace + ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n) + with ((dicho_up x y P n - dicho_lb x y P n) / 2). +unfold Rdiv in |- *; rewrite Hrecn. +unfold Rdiv in |- *. +rewrite Rinv_mult_distr. +ring. +discrR. +apply pow_nonzero; discrR. +pattern (Dichotomy_lb x y P n) at 2 in |- *; + rewrite (double_var (Dichotomy_lb x y P n)); + unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. +replace + (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2) + with ((dicho_up x y P n - dicho_lb x y P n) / 2). +unfold Rdiv in |- *; rewrite Hrecn. +unfold Rdiv in |- *. +rewrite Rinv_mult_distr. +ring. +discrR. +apply pow_nonzero; discrR. +pattern (Dichotomy_ub x y P n) at 1 in |- *; + rewrite (double_var (Dichotomy_ub x y P n)); + unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. Qed. -Definition pow_2_n := [n:nat](pow ``2`` n). +Definition pow_2_n (n:nat) := 2 ^ n. -Lemma pow_2_n_neq_R0 : (n:nat) ``(pow_2_n n)<>0``. -Intro. -Unfold pow_2_n. -Apply pow_nonzero. -DiscrR. +Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0. +intro. +unfold pow_2_n in |- *. +apply pow_nonzero. +discrR. Qed. -Lemma pow_2_n_growing : (Un_growing pow_2_n). -Unfold Un_growing. -Intro. -Replace (S n) with (plus n (1)); [Unfold pow_2_n; Rewrite pow_add | Ring]. -Pattern 1 (pow ``2`` n); Rewrite <- Rmult_1r. -Apply Rle_monotony. -Left; Apply pow_lt; Sup0. -Simpl. -Rewrite Rmult_1r. -Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1. +Lemma pow_2_n_growing : Un_growing pow_2_n. +unfold Un_growing in |- *. +intro. +replace (S n) with (n + 1)%nat; + [ unfold pow_2_n in |- *; rewrite pow_add | ring ]. +pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r. +apply Rmult_le_compat_l. +left; apply pow_lt; prove_sup0. +simpl in |- *. +rewrite Rmult_1_r. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. Qed. -Lemma pow_2_n_infty : (cv_infty pow_2_n). -Cut (N:nat)``(INR N)<=(pow 2 N)``. -Intros. -Unfold cv_infty. -Intro. -Case (total_order_T R0 M); Intro. -Elim s; Intro. -Pose N := (up M). -Cut `0<=N`. -Intro. -Elim (IZN N H0); Intros N0 H1. -Exists N0. -Intros. -Apply Rlt_le_trans with (INR N0). -Rewrite INR_IZR_INZ. -Rewrite <- H1. -Unfold N. -Assert H3 := (archimed M). -Elim H3; Intros; Assumption. -Apply Rle_trans with (pow_2_n N0). -Unfold pow_2_n; Apply H. -Apply Rle_sym2. -Apply growing_prop. -Apply pow_2_n_growing. -Assumption. -Apply le_IZR. -Unfold N. -Simpl. -Assert H0 := (archimed M); Elim H0; Intros. -Left; Apply Rlt_trans with M; Assumption. -Exists O; Intros. -Rewrite <- b. -Unfold pow_2_n; Apply pow_lt; Sup0. -Exists O; Intros. -Apply Rlt_trans with R0. -Assumption. -Unfold pow_2_n; Apply pow_lt; Sup0. -Induction N. -Simpl. -Left; Apply Rlt_R0_R1. -Intros. -Pattern 2 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring]. -Rewrite S_INR; Rewrite pow_add. -Simpl. -Rewrite Rmult_1r. -Apply Rle_trans with ``(pow 2 n)``. -Rewrite <- (Rplus_sym R1). -Rewrite <- (Rmult_1r (INR n)). -Apply (poly n R1). -Apply Rlt_R0_R1. -Pattern 1 (pow ``2`` n); Rewrite <- Rplus_Or. -Rewrite <- (Rmult_sym ``2``). -Rewrite double. -Apply Rle_compatibility. -Left; Apply pow_lt; Sup0. +Lemma pow_2_n_infty : cv_infty pow_2_n. +cut (forall N:nat, INR N <= 2 ^ N). +intros. +unfold cv_infty in |- *. +intro. +case (total_order_T 0 M); intro. +elim s; intro. +pose (N := up M). +cut (0 <= N)%Z. +intro. +elim (IZN N H0); intros N0 H1. +exists N0. +intros. +apply Rlt_le_trans with (INR N0). +rewrite INR_IZR_INZ. +rewrite <- H1. +unfold N in |- *. +assert (H3 := archimed M). +elim H3; intros; assumption. +apply Rle_trans with (pow_2_n N0). +unfold pow_2_n in |- *; apply H. +apply Rge_le. +apply growing_prop. +apply pow_2_n_growing. +assumption. +apply le_IZR. +unfold N in |- *. +simpl in |- *. +assert (H0 := archimed M); elim H0; intros. +left; apply Rlt_trans with M; assumption. +exists 0%nat; intros. +rewrite <- b. +unfold pow_2_n in |- *; apply pow_lt; prove_sup0. +exists 0%nat; intros. +apply Rlt_trans with 0. +assumption. +unfold pow_2_n in |- *; apply pow_lt; prove_sup0. +simple induction N. +simpl in |- *. +left; apply Rlt_0_1. +intros. +pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite S_INR; rewrite pow_add. +simpl in |- *. +rewrite Rmult_1_r. +apply Rle_trans with (2 ^ n). +rewrite <- (Rplus_comm 1). +rewrite <- (Rmult_1_r (INR n)). +apply (poly n 1). +apply Rlt_0_1. +pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r. +rewrite <- (Rmult_comm 2). +rewrite double. +apply Rplus_le_compat_l. +left; apply pow_lt; prove_sup0. Qed. -Lemma cv_dicho : (x,y,l1,l2:R;P:R->bool) ``x<=y`` -> (Un_cv (dicho_lb x y P) l1) -> (Un_cv (dicho_up x y P) l2) -> l1==l2. -Intros. -Assert H2 := (CV_minus ? ? ? ? H0 H1). -Cut (Un_cv [i:nat]``(dicho_lb x y P i)-(dicho_up x y P i)`` R0). -Intro. -Assert H4 := (UL_sequence ? ? ? H2 H3). -Symmetry; Apply Rminus_eq_right; 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. -Elim s; Intro. -Unfold Un_cv in H4; Unfold R_dist in H4. -Cut ``0<y-x``. -Intro Hyp. -Cut ``0<eps/(y-x)``. -Intro. -Elim (H4 ``eps/(y-x)`` H5); Intros N H6. -Exists N; Intros. -Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring]. -Rewrite <- Rabsolu_Ropp. -Rewrite Ropp_distr3. -Rewrite dicho_lb_dicho_up. -Unfold Rdiv; Rewrite Rabsolu_mult. -Rewrite (Rabsolu_right ``y-x``). -Apply Rlt_monotony_contra with ``/(y-x)``. -Apply Rlt_Rinv; Assumption. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Replace ``/(pow 2 n)`` with ``/(pow 2 n)-0``; [Unfold pow_2_n Rdiv in H6; Rewrite <- (Rmult_sym eps); Apply H6; Assumption | Ring]. -Red; Intro; Rewrite H8 in Hyp; Elim (Rlt_antirefl ? Hyp). -Apply Rle_sym1. -Apply Rle_anti_compatibility with x; Rewrite Rplus_Or. -Replace ``x+(y-x)`` with y; [Assumption | Ring]. -Assumption. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]. -Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or. -Replace ``x+(y-x)`` with y; [Assumption | Ring]. -Exists O; Intros. -Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring]. -Rewrite <- Rabsolu_Ropp. -Rewrite Ropp_distr3. -Rewrite dicho_lb_dicho_up. -Rewrite b. -Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption. -Assumption. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)). +Lemma cv_dicho : + forall (x y l1 l2:R) (P:R -> bool), + x <= y -> + Un_cv (dicho_lb x y P) l1 -> Un_cv (dicho_up x y P) l2 -> l1 = l2. +intros. +assert (H2 := CV_minus _ _ _ _ H0 H1). +cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0). +intro. +assert (H4 := UL_sequence _ _ _ H2 H3). +symmetry in |- *; apply Rminus_diag_uniq_sym; assumption. +unfold Un_cv in |- *; unfold R_dist in |- *. +intros. +assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty). +case (total_order_T x y); intro. +elim s; intro. +unfold Un_cv in H4; unfold R_dist in H4. +cut (0 < y - x). +intro Hyp. +cut (0 < eps / (y - x)). +intro. +elim (H4 (eps / (y - x)) H5); intros N H6. +exists N; intros. +replace (dicho_lb x y P n - dicho_up x y P n - 0) with + (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. +rewrite <- Rabs_Ropp. +rewrite Ropp_minus_distr'. +rewrite dicho_lb_dicho_up. +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite (Rabs_right (y - x)). +apply Rmult_lt_reg_l with (/ (y - x)). +apply Rinv_0_lt_compat; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (/ 2 ^ n) with (/ 2 ^ n - 0); + [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6; + assumption + | ring ]. +red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp). +apply Rle_ge. +apply Rplus_le_reg_l with x; rewrite Rplus_0_r. +replace (x + (y - x)) with y; [ assumption | ring ]. +assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ]. +apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. +replace (x + (y - x)) with y; [ assumption | ring ]. +exists 0%nat; intros. +replace (dicho_lb x y P n - dicho_up x y P n - 0) with + (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. +rewrite <- Rabs_Ropp. +rewrite Ropp_minus_distr'. +rewrite dicho_lb_dicho_up. +rewrite b. +unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l; + rewrite Rabs_R0; assumption. +assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). Qed. -Definition cond_positivity [x:R] : bool := Cases (total_order_Rle R0 x) of - (leftT _) => true -| (rightT _) => false end. +Definition cond_positivity (x:R) : bool := + match Rle_dec 0 x with + | left _ => true + | right _ => false + end. (* Sequential caracterisation of continuity *) -Lemma continuity_seq : (f:R->R;Un:nat->R;l:R) (continuity_pt f l) -> (Un_cv Un l) -> (Un_cv [i:nat](f (Un i)) (f l)). -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_EM (Un n) l); Intro. -Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Apply H4. -Split. -Unfold D_x no_cond. -Split. -Trivial. -Apply not_sym; Assumption. -Apply H5; Assumption. +Lemma continuity_seq : + forall (f:R -> R) (Un:nat -> R) (l:R), + continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l). +unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *. +unfold limit1_in in |- *. +unfold limit_in in |- *. +unfold dist in |- *. +simpl in |- *. +unfold R_dist in |- *. +intros. +elim (H eps H1); intros alp H2. +elim H2; intros. +elim (H0 alp H3); intros N H5. +exists N; intros. +case (Req_dec (Un n) l); intro. +rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +apply H4. +split. +unfold D_x, no_cond in |- *. +split. +trivial. +apply (sym_not_eq (A:=R)); assumption. +apply H5; assumption. Qed. -Lemma dicho_lb_car : (x,y:R;P:R->bool;n:nat) (P x)=false -> (P (dicho_lb x y P n))=false. -Intros. -Induction n. -Simpl. -Assumption. -Simpl. -Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)). -Elim X; Intro. -Rewrite a. -Unfold dicho_lb in Hrecn; Assumption. -Rewrite b. -Assumption. +Lemma dicho_lb_car : + forall (x y:R) (P:R -> bool) (n:nat), + P x = false -> P (dicho_lb x y P n) = false. +intros. +induction n as [| n Hrecn]. +simpl in |- *. +assumption. +simpl in |- *. +assert + (X := + sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). +elim X; intro. +rewrite a. +unfold dicho_lb in Hrecn; assumption. +rewrite b. +assumption. Qed. -Lemma dicho_up_car : (x,y:R;P:R->bool;n:nat) (P y)=true -> (P (dicho_up x y P n))=true. -Intros. -Induction n. -Simpl. -Assumption. -Simpl. -Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)). -Elim X; Intro. -Rewrite a. -Unfold dicho_lb in Hrecn; Assumption. -Rewrite b. -Assumption. +Lemma dicho_up_car : + forall (x y:R) (P:R -> bool) (n:nat), + P y = true -> P (dicho_up x y P n) = true. +intros. +induction n as [| n Hrecn]. +simpl in |- *. +assumption. +simpl in |- *. +assert + (X := + sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). +elim X; intro. +rewrite a. +unfold dicho_lb in Hrecn; assumption. +rewrite b. +assumption. Qed. (* Intermediate Value Theorem *) -Lemma IVT : (f:R->R;x,y:R) (continuity f) -> ``x<y`` -> ``(f x)<0`` -> ``0<(f y)`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``). -Intros. -Cut ``x<=y``. -Intro. -Generalize (dicho_lb_cv x y [z:R](cond_positivity (f z)) H3). -Generalize (dicho_up_cv x y [z:R](cond_positivity (f z)) H3). -Intros. -Elim X; Intros. -Elim X0; Intros. -Assert H4 := (cv_dicho ? ? ? ? ? H3 p0 p). -Rewrite H4 in p0. -Apply existTT with x0. -Split. -Split. -Apply Rle_trans with (dicho_lb x y [z:R](cond_positivity (f z)) O). -Simpl. -Right; Reflexivity. -Apply growing_ineq. -Apply dicho_lb_growing; Assumption. -Assumption. -Apply Rle_trans with (dicho_up x y [z:R](cond_positivity (f z)) O). -Apply decreasing_ineq. -Apply dicho_up_decreasing; Assumption. -Assumption. -Right; Reflexivity. -2:Left; Assumption. -Pose Vn := [n:nat](dicho_lb x y [z:R](cond_positivity (f z)) n). -Pose Wn := [n:nat](dicho_up x y [z:R](cond_positivity (f z)) n). -Cut ((n:nat)``(f (Vn n))<=0``)->``(f x0)<=0``. -Cut ((n:nat)``0<=(f (Wn n))``)->``0<=(f x0)``. -Intros. -Cut (n:nat)``(f (Vn n))<=0``. -Cut (n:nat)``0<=(f (Wn n))``. -Intros. -Assert H9 := (H6 H8). -Assert H10 := (H5 H7). -Apply Rle_antisym; Assumption. -Intro. -Unfold Wn. -Cut (z:R) (cond_positivity z)=true <-> ``0<=z``. -Intro. -Assert H8 := (dicho_up_car x y [z:R](cond_positivity (f z)) n). -Elim (H7 (f (dicho_up x y [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. -Case (total_order_Rle R0 z); Intro. -Split. -Intro; Assumption. -Intro; Reflexivity. -Split. -Intro; Elim diff_false_true; Assumption. -Intro. -Elim n0; Assumption. -Unfold Vn. -Cut (z:R) (cond_positivity z)=false <-> ``z<0``. -Intros. -Assert H8 := (dicho_lb_car x y [z:R](cond_positivity (f z)) n). -Left. -Elim (H7 (f (dicho_lb x y [z:R](cond_positivity (f z)) n))); Intros. -Apply H9. -Apply H8. -Elim (H7 (f x)); Intros. -Apply H12. -Assumption. -Intro. -Unfold cond_positivity. -Case (total_order_Rle R0 z); Intro. -Split. -Intro; Elim diff_true_false; Assumption. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H7)). -Split. -Intro; Auto with real. -Intro; Reflexivity. -Cut (Un_cv Wn x0). -Intros. -Assert H7 := (continuity_seq f Wn x0 (H x0) H5). -Case (total_order_T R0 (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 (ge x2 x2); [Intro | Unfold ge; Apply le_n]. -Assert H11 := (H9 x2 H10). -Rewrite Rabsolu_right in H11. -Pattern 1 ``-(f x0)`` in H11; Rewrite <- Rplus_Or in H11. -Unfold Rminus in H11; Rewrite (Rplus_sym (f (Wn x2))) in H11. -Assert H12 := (Rlt_anti_compatibility ? ? ? H11). -Assert H13 := (H6 x2). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H13 H12)). -Apply Rle_sym1; Left; Unfold Rminus; Apply ge0_plus_gt0_is_gt0. -Apply H6. -Exact H8. -Apply Rgt_RO_Ropp; Assumption. -Unfold Wn; Assumption. -Cut (Un_cv Vn x0). -Intros. -Assert H7 := (continuity_seq f Vn x0 (H x0) H5). -Case (total_order_T R0 (f x0)); Intro. -Elim s; Intro. -Unfold Un_cv in H7; Unfold R_dist in H7. -Elim (H7 ``(f x0)`` a); Intros. -Cut (ge x2 x2); [Intro | Unfold ge; Apply le_n]. -Assert H10 := (H8 x2 H9). -Rewrite Rabsolu_left in H10. -Pattern 2 ``(f x0)`` in H10; Rewrite <- Rplus_Or in H10. -Rewrite Ropp_distr3 in H10. -Unfold Rminus in H10. -Assert H11 := (Rlt_anti_compatibility ? ? ? H10). -Assert H12 := (H6 x2). -Cut ``0<(f (Vn x2))``. -Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H13 H12)). -Rewrite <- (Ropp_Ropp (f (Vn x2))). -Apply Rgt_RO_Ropp; Assumption. -Apply Rlt_anti_compatibility with ``(f x0)-(f (Vn x2))``. -Rewrite Rplus_Or; Replace ``(f x0)-(f (Vn x2))+((f (Vn x2))-(f x0))`` with R0; [Unfold Rminus; Apply gt0_plus_ge0_is_gt0 | Ring]. -Assumption. -Apply Rge_RO_Ropp; Apply Rle_sym1; Apply H6. -Right; Rewrite <- b; Reflexivity. -Left; Assumption. -Unfold Vn; Assumption. +Lemma IVT : + forall (f:R -> R) (x y:R), + continuity f -> + x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0). +intros. +cut (x <= y). +intro. +generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). +generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). +intros. +elim X; intros. +elim X0; intros. +assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p). +rewrite H4 in p0. +apply existT with x0. +split. +split. +apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). +simpl in |- *. +right; reflexivity. +apply growing_ineq. +apply dicho_lb_growing; assumption. +assumption. +apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0). +apply decreasing_ineq. +apply dicho_up_decreasing; assumption. +assumption. +right; reflexivity. +2: left; assumption. +pose (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n). +pose (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n). +cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0). +cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0). +intros. +cut (forall n:nat, f (Vn n) <= 0). +cut (forall n:nat, 0 <= f (Wn n)). +intros. +assert (H9 := H6 H8). +assert (H10 := H5 H7). +apply Rle_antisym; assumption. +intro. +unfold Wn in |- *. +cut (forall z:R, cond_positivity z = true <-> 0 <= z). +intro. +assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n). +elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros. +apply H9. +apply H8. +elim (H7 (f y)); intros. +apply H12. +left; assumption. +intro. +unfold cond_positivity in |- *. +case (Rle_dec 0 z); intro. +split. +intro; assumption. +intro; reflexivity. +split. +intro; elim diff_false_true; assumption. +intro. +elim n0; assumption. +unfold Vn in |- *. +cut (forall z:R, cond_positivity z = false <-> z < 0). +intros. +assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n). +left. +elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros. +apply H9. +apply H8. +elim (H7 (f x)); intros. +apply H12. +assumption. +intro. +unfold cond_positivity in |- *. +case (Rle_dec 0 z); intro. +split. +intro; elim diff_true_false; assumption. +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)). +split. +intro; auto with real. +intro; reflexivity. +cut (Un_cv Wn x0). +intros. +assert (H7 := continuity_seq f Wn x0 (H x0) H5). +case (total_order_T 0 (f x0)); intro. +elim s; intro. +left; assumption. +rewrite <- b; right; reflexivity. +unfold Un_cv in H7; unfold R_dist in H7. +cut (0 < - f x0). +intro. +elim (H7 (- f x0) H8); intros. +cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. +assert (H11 := H9 x2 H10). +rewrite Rabs_right in H11. +pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11. +unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11. +assert (H12 := Rplus_lt_reg_r _ _ _ H11). +assert (H13 := H6 x2). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). +apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat. +apply H6. +exact H8. +apply Ropp_0_gt_lt_contravar; assumption. +unfold Wn in |- *; assumption. +cut (Un_cv Vn x0). +intros. +assert (H7 := continuity_seq f Vn x0 (H x0) H5). +case (total_order_T 0 (f x0)); intro. +elim s; intro. +unfold Un_cv in H7; unfold R_dist in H7. +elim (H7 (f x0) a); intros. +cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. +assert (H10 := H8 x2 H9). +rewrite Rabs_left in H10. +pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10. +rewrite Ropp_minus_distr' in H10. +unfold Rminus in H10. +assert (H11 := Rplus_lt_reg_r _ _ _ H10). +assert (H12 := H6 x2). +cut (0 < f (Vn x2)). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). +rewrite <- (Ropp_involutive (f (Vn x2))). +apply Ropp_0_gt_lt_contravar; assumption. +apply Rplus_lt_reg_r with (f x0 - f (Vn x2)). +rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0; + [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ]. +assumption. +apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6. +right; rewrite <- b; reflexivity. +left; assumption. +unfold Vn in |- *; assumption. Qed. -Lemma IVT_cor : (f:R->R;x,y:R) (continuity f) -> ``x<=y`` -> ``(f x)*(f y)<=0`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``). -Intros. -Case (total_order_T R0 (f x)); Intro. -Case (total_order_T R0 (f y)); Intro. -Elim s; Intro. -Elim s0; Intro. -Cut ``0<(f x)*(f y)``; [Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 H2)) | Apply Rmult_lt_pos; Assumption]. -Exists y. -Split. -Split; [Assumption | Right; Reflexivity]. -Symmetry; Exact b. -Exists x. -Split. -Split; [Right; Reflexivity | Assumption]. -Symmetry; Exact b. -Elim s; Intro. -Cut ``x<y``. -Intro. -Assert H3 := (IVT (opp_fct f) x y (continuity_opp f H) H2). -Cut ``(opp_fct f x)<0``. -Cut ``0<(opp_fct f y)``. -Intros. -Elim (H3 H5 H4); Intros. -Apply existTT with x0. -Elim p; Intros. -Split. -Assumption. -Unfold opp_fct in H7. -Rewrite <- (Ropp_Ropp (f x0)). -Apply eq_RoppO; Assumption. -Unfold opp_fct; Apply Rgt_RO_Ropp; Assumption. -Unfold opp_fct. -Apply Rlt_anti_compatibility with (f x); Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption. -Inversion H0. -Assumption. -Rewrite H2 in a. -Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)). -Apply existTT with x. -Split. -Split; [Right; Reflexivity | Assumption]. -Symmetry; Assumption. -Case (total_order_T R0 (f y)); Intro. -Elim s; Intro. -Cut ``x<y``. -Intro. -Apply IVT; Assumption. -Inversion H0. -Assumption. -Rewrite H2 in r. -Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)). -Apply existTT with y. -Split. -Split; [Assumption | Right; Reflexivity]. -Symmetry; Assumption. -Cut ``0<(f x)*(f y)``. -Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H2 H1)). -Rewrite <- Ropp_mul2; Apply Rmult_lt_pos; Apply Rgt_RO_Ropp; Assumption. +Lemma IVT_cor : + forall (f:R -> R) (x y:R), + continuity f -> + x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0). +intros. +case (total_order_T 0 (f x)); intro. +case (total_order_T 0 (f y)); intro. +elim s; intro. +elim s0; intro. +cut (0 < f x * f y); + [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2)) + | apply Rmult_lt_0_compat; assumption ]. +exists y. +split. +split; [ assumption | right; reflexivity ]. +symmetry in |- *; exact b. +exists x. +split. +split; [ right; reflexivity | assumption ]. +symmetry in |- *; exact b. +elim s; intro. +cut (x < y). +intro. +assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2). +cut ((- f)%F x < 0). +cut (0 < (- f)%F y). +intros. +elim (H3 H5 H4); intros. +apply existT with x0. +elim p; intros. +split. +assumption. +unfold opp_fct in H7. +rewrite <- (Ropp_involutive (f x0)). +apply Ropp_eq_0_compat; assumption. +unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption. +unfold opp_fct in |- *. +apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r; + assumption. +inversion H0. +assumption. +rewrite H2 in a. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). +apply existT with x. +split. +split; [ right; reflexivity | assumption ]. +symmetry in |- *; assumption. +case (total_order_T 0 (f y)); intro. +elim s; intro. +cut (x < y). +intro. +apply IVT; assumption. +inversion H0. +assumption. +rewrite H2 in r. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). +apply existT with y. +split. +split; [ assumption | right; reflexivity ]. +symmetry in |- *; assumption. +cut (0 < f x * f y). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)). +rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat; + apply Ropp_0_gt_lt_contravar; assumption. Qed. (* We can now define the square root function as the reciprocal transformation of the square root function *) -Lemma Rsqrt_exists : (y:R) ``0<=y`` -> (sigTT R [z:R]``0<=z``/\``y==(Rsqr z)``). -Intros. -Pose f := [x:R]``(Rsqr x)-y``. -Cut ``(f 0)<=0``. -Intro. -Cut (continuity f). -Intro. -Case (total_order_T y R1); Intro. -Elim s; Intro. -Cut ``0<=(f 1)``. -Intro. -Cut ``(f 0)*(f 1)<=0``. -Intro. -Assert X := (IVT_cor f R0 R1 H1 (Rlt_le ? ? Rlt_R0_R1) H3). -Elim X; Intros t H4. -Apply existTT with t. -Elim H4; Intros. -Split. -Elim H5; Intros; Assumption. -Unfold f in H6. -Apply Rminus_eq_right; Exact H6. -Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f R1)). -Apply Rle_monotony; Assumption. -Unfold f. -Rewrite Rsqr_1. -Apply Rle_anti_compatibility with y. -Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Left; Assumption. -Apply existTT with R1. -Split. -Left; Apply Rlt_R0_R1. -Rewrite b; Symmetry; Apply Rsqr_1. -Cut ``0<=(f y)``. -Intro. -Cut ``(f 0)*(f y)<=0``. -Intro. -Assert X := (IVT_cor f R0 y H1 H H3). -Elim X; Intros t H4. -Apply existTT with t. -Elim H4; Intros. -Split. -Elim H5; Intros; Assumption. -Unfold f in H6. -Apply Rminus_eq_right; Exact H6. -Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f y)). -Apply Rle_monotony; Assumption. -Unfold f. -Apply Rle_anti_compatibility with y. -Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or. -Pattern 1 y; Rewrite <- Rmult_1r. -Unfold Rsqr; Apply Rle_monotony. -Assumption. -Left; Exact r. -Replace f with (minus_fct Rsqr (fct_cte y)). -Apply continuity_minus. -Apply derivable_continuous; Apply derivable_Rsqr. -Apply derivable_continuous; Apply derivable_const. -Reflexivity. -Unfold f; Rewrite Rsqr_O. -Unfold Rminus; Rewrite Rplus_Ol. -Apply Rle_sym2. -Apply Rle_RO_Ropp; Assumption. +Lemma Rsqrt_exists : + forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z). +intros. +pose (f := fun x:R => Rsqr x - y). +cut (f 0 <= 0). +intro. +cut (continuity f). +intro. +case (total_order_T y 1); intro. +elim s; intro. +cut (0 <= f 1). +intro. +cut (f 0 * f 1 <= 0). +intro. +assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3). +elim X; intros t H4. +apply existT with t. +elim H4; intros. +split. +elim H5; intros; assumption. +unfold f in H6. +apply Rminus_diag_uniq_sym; exact H6. +rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)). +apply Rmult_le_compat_l; assumption. +unfold f in |- *. +rewrite Rsqr_1. +apply Rplus_le_reg_l with y. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + left; assumption. +apply existT with 1. +split. +left; apply Rlt_0_1. +rewrite b; symmetry in |- *; apply Rsqr_1. +cut (0 <= f y). +intro. +cut (f 0 * f y <= 0). +intro. +assert (X := IVT_cor f 0 y H1 H H3). +elim X; intros t H4. +apply existT with t. +elim H4; intros. +split. +elim H5; intros; assumption. +unfold f in H6. +apply Rminus_diag_uniq_sym; exact H6. +rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)). +apply Rmult_le_compat_l; assumption. +unfold f in |- *. +apply Rplus_le_reg_l with y. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +pattern y at 1 in |- *; rewrite <- Rmult_1_r. +unfold Rsqr in |- *; apply Rmult_le_compat_l. +assumption. +left; exact r. +replace f with (Rsqr - fct_cte y)%F. +apply continuity_minus. +apply derivable_continuous; apply derivable_Rsqr. +apply derivable_continuous; apply derivable_const. +reflexivity. +unfold f in |- *; rewrite Rsqr_0. +unfold Rminus in |- *; rewrite Rplus_0_l. +apply Rge_le. +apply Ropp_0_le_ge_contravar; assumption. Qed. (* Definition of the square root: R+->R *) -Definition Rsqrt [y:nonnegreal] : R := Cases (Rsqrt_exists (nonneg y) (cond_nonneg y)) of (existTT a b) => a end. +Definition Rsqrt (y:nonnegreal) : R := + match Rsqrt_exists (nonneg y) (cond_nonneg y) with + | existT a b => a + end. (**********) -Lemma Rsqrt_positivity : (x:nonnegreal) ``0<=(Rsqrt x)``. -Intro. -Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)). -Elim X; Intros. -Cut x0==(Rsqrt x). -Intros. -Elim p; Intros. -Rewrite H in H0; Assumption. -Unfold Rsqrt. -Case (Rsqrt_exists x (cond_nonneg x)). -Intros. -Elim p; Elim a; Intros. -Apply Rsqr_inj. -Assumption. -Assumption. -Rewrite <- H0; Rewrite <- H2; Reflexivity. +Lemma Rsqrt_positivity : forall x:nonnegreal, 0 <= Rsqrt x. +intro. +assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). +elim X; intros. +cut (x0 = Rsqrt x). +intros. +elim p; intros. +rewrite H in H0; assumption. +unfold Rsqrt in |- *. +case (Rsqrt_exists x (cond_nonneg x)). +intros. +elim p; elim a; intros. +apply Rsqr_inj. +assumption. +assumption. +rewrite <- H0; rewrite <- H2; reflexivity. Qed. (**********) -Lemma Rsqrt_Rsqrt : (x:nonnegreal) ``(Rsqrt x)*(Rsqrt x)==x``. -Intros. -Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)). -Elim X; Intros. -Cut x0==(Rsqrt x). -Intros. -Rewrite <- H. -Elim p; Intros. -Rewrite H1; Reflexivity. -Unfold Rsqrt. -Case (Rsqrt_exists x (cond_nonneg x)). -Intros. -Elim p; Elim a; Intros. -Apply Rsqr_inj. -Assumption. -Assumption. -Rewrite <- H0; Rewrite <- H2; Reflexivity. -Qed. +Lemma Rsqrt_Rsqrt : forall x:nonnegreal, Rsqrt x * Rsqrt x = x. +intros. +assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). +elim X; intros. +cut (x0 = Rsqrt x). +intros. +rewrite <- H. +elim p; intros. +rewrite H1; reflexivity. +unfold Rsqrt in |- *. +case (Rsqrt_exists x (cond_nonneg x)). +intros. +elim p; elim a; intros. +apply Rsqr_inj. +assumption. +assumption. +rewrite <- H0; rewrite <- H2; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rsyntax.v b/theories/Reals/Rsyntax.v index 53f8aec07..b453ef9db 100644 --- a/theories/Reals/Rsyntax.v +++ b/theories/Reals/Rsyntax.v @@ -9,228 +9,5 @@ Require Export Rdefinitions. -Axiom NRplus : R->R. -Axiom NRmult : R->R. - -V7only[ -Grammar rnatural ident := - nat_id [ prim:var($id) ] -> [$id] - -with rnegnumber : constr := - neg_expr [ "-" rnumber ($c) ] -> [ (Ropp $c) ] - -with rnumber := - -with rformula : constr := - form_expr [ rexpr($p) ] -> [ $p ] -(* | form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT R $p $c) ] *) -| form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT ? $p $c) ] -| form_eq2 [ rexpr($p) "=" rexpr($c) ] -> [ (eqT ? $p $c) ] -| form_le [ rexpr($p) "<=" rexpr($c) ] -> [ (Rle $p $c) ] -| form_lt [ rexpr($p) "<" rexpr($c) ] -> [ (Rlt $p $c) ] -| form_ge [ rexpr($p) ">=" rexpr($c) ] -> [ (Rge $p $c) ] -| form_gt [ rexpr($p) ">" rexpr($c) ] -> [ (Rgt $p $c) ] -(* -| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ] - -> [ (eqT R $p $c)/\(eqT R $c $c1) ] -*) -| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ] - -> [ (eqT ? $p $c)/\(eqT ? $c $c1) ] -| form_le_le [ rexpr($p) "<=" rexpr($c) "<=" rexpr($c1) ] - -> [ (Rle $p $c)/\(Rle $c $c1) ] -| form_le_lt [ rexpr($p) "<=" rexpr($c) "<" rexpr($c1) ] - -> [ (Rle $p $c)/\(Rlt $c $c1) ] -| form_lt_le [ rexpr($p) "<" rexpr($c) "<=" rexpr($c1) ] - -> [ (Rlt $p $c)/\(Rle $c $c1) ] -| form_lt_lt [ rexpr($p) "<" rexpr($c) "<" rexpr($c1) ] - -> [ (Rlt $p $c)/\(Rlt $c $c1) ] -| form_neq [ rexpr($p) "<>" rexpr($c) ] -> [ ~(eqT ? $p $c) ] - -with rexpr : constr := - expr_plus [ rexpr($p) "+" rexpr($c) ] -> [ (Rplus $p $c) ] -| expr_minus [ rexpr($p) "-" rexpr($c) ] -> [ (Rminus $p $c) ] -| rexpr2 [ rexpr2($e) ] -> [ $e ] - -with rexpr2 : constr := - expr_mult [ rexpr2($p) "*" rexpr2($c) ] -> [ (Rmult $p $c) ] -| rexpr0 [ rexpr0($e) ] -> [ $e ] - - -with rexpr0 : constr := - expr_id [ constr:global($c) ] -> [ $c ] -| expr_com [ "[" constr:constr($c) "]" ] -> [ $c ] -| expr_appl [ "(" rapplication($a) ")" ] -> [ $a ] -| expr_num [ rnumber($s) ] -> [ $s ] -| expr_negnum [ "-" rnegnumber($n) ] -> [ $n ] -| expr_div [ rexpr0($p) "/" rexpr0($c) ] -> [ (Rdiv $p $c) ] -| expr_opp [ "-" rexpr0($c) ] -> [ (Ropp $c) ] -| expr_inv [ "/" rexpr0($c) ] -> [ (Rinv $c) ] -| expr_meta [ meta($m) ] -> [ $m ] - -with meta := -| rimpl [ "?" ] -> [ ? ] -| rmeta0 [ "?" "0" ] -> [ ?0 ] -| rmeta1 [ "?" "1" ] -> [ ?1 ] -| rmeta2 [ "?" "2" ] -> [ ?2 ] -| rmeta3 [ "?" "3" ] -> [ ?3 ] -| rmeta4 [ "?" "4" ] -> [ ?4 ] -| rmeta5 [ "?" "5" ] -> [ ?5 ] - -with rapplication : constr := - apply [ rapplication($p) rexpr($c1) ] -> [ ($p $c1) ] -| pair [ rexpr($p) "," rexpr($c) ] -> [ ($p, $c) ] -| appl0 [ rexpr($a) ] -> [ $a ]. - -Grammar constr constr0 := - r_in_com [ "``" rnatural:rformula($c) "``" ] -> [ $c ]. - -Grammar constr atomic_pattern := - r_in_pattern [ "``" rnatural:rnumber($c) "``" ] -> [ $c ]. - -(*i* pp **) - -Syntax constr - level 0: - Rle [ (Rle $n1 $n2) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2) "``"]] - | Rlt [ (Rlt $n1 $n2) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "< "(REXPR $n2) "``" ]] - | Rge [ (Rge $n1 $n2) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] ">= "(REXPR $n2) "``" ]] - | Rgt [ (Rgt $n1 $n2) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "> "(REXPR $n2) "``" ]] - | Req [ (eqT R $n1 $n2) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "= "(REXPR $n2)"``"]] - | Rneq [ ~(eqT R $n1 $n2) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "<> "(REXPR $n2) "``"]] - | Rle_Rle [ (Rle $n1 $n2)/\(Rle $n2 $n3) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2) - [1 0] "<= " (REXPR $n3) "``"]] - | Rle_Rlt [ (Rle $n1 $n2)/\(Rlt $n2 $n3) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "<= "(REXPR $n2) - [1 0] "< " (REXPR $n3) "``"]] - | Rlt_Rle [ (Rlt $n1 $n2)/\(Rle $n2 $n3) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2) - [1 0] "<= " (REXPR $n3) "``"]] - | Rlt_Rlt [ (Rlt $n1 $n2)/\(Rlt $n2 $n3) ] -> - [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2) - [1 0] "< " (REXPR $n3) "``"]] - | Rzero [ R0 ] -> [ "``0``" ] - | Rone [ R1 ] -> [ "``1``" ] - ; - - level 7: - Rplus [ (Rplus $n1 $n2) ] - -> [ [<hov 0> "``"(REXPR $n1):E "+" [0 0] (REXPR $n2):L "``"] ] - | Rodd_outside [(Rplus R1 $r)] -> [ $r:"r_printer_odd_outside"] - | Rminus [ (Rminus $n1 $n2) ] - -> [ [<hov 0> "``"(REXPR $n1):E "-" [0 0] (REXPR $n2):L "``"] ] - ; - - level 6: - Rmult [ (Rmult $n1 $n2) ] - -> [ [<hov 0> "``"(REXPR $n1):E "*" [0 0] (REXPR $n2):L "``"] ] - | Reven_outside [ (Rmult (Rplus R1 R1) $r) ] -> [ $r:"r_printer_even_outside"] - | Rdiv [ (Rdiv $n1 $n2) ] - -> [ [<hov 0> "``"(REXPR $n1):E "/" [0 0] (REXPR $n2):L "``"] ] - ; - - level 8: - Ropp [(Ropp $n1)] -> [ [<hov 0> "``" "-"(REXPR $n1):E "``"] ] - | Rinv [(Rinv $n1)] -> [ [<hov 0> "``" "/"(REXPR $n1):E "``"] ] - ; - - level 0: - rescape_inside [<< (REXPR $r) >>] -> [ "[" $r:E "]" ] - ; - - level 4: - Rappl_inside [<<(REXPR (APPLIST $h ($LIST $t)))>>] - -> [ [<hov 0> "("(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E ")"] ] - | Rappl_inside_tail [<<(RAPPLINSIDETAIL $h ($LIST $t))>>] - -> [(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E] - | Rappl_inside_one [<<(RAPPLINSIDETAIL $e)>>] ->[(REXPR $e):E] - | rpair_inside [<<(REXPR <<(pair $s1 $s2 $r1 $r2)>>)>>] - -> [ [<hov 0> "("(REXPR $r1):E "," [1 0] (REXPR $r2):E ")"] ] - ; - - level 3: - rvar_inside [<<(REXPR ($VAR $i))>>] -> [$i] - | rsecvar_inside [<<(REXPR (SECVAR $i))>>] -> [(SECVAR $i)] - | rconst_inside [<<(REXPR (CONST $c))>>] -> [(CONST $c)] - | rmutind_inside [<<(REXPR (MUTIND $i $n))>>] - -> [(MUTIND $i $n)] - | rmutconstruct_inside [<<(REXPR (MUTCONSTRUCT $c1 $c2 $c3))>>] - -> [ (MUTCONSTRUCT $c1 $c2 $c3) ] - | rimplicit_head_inside [<<(REXPR (XTRA "!" $c))>>] -> [ $c ] - | rimplicit_arg_inside [<<(REXPR (XTRA "!" $n $c))>>] -> [ ] - - ; - - - level 7: - Rplus_inside - [<<(REXPR <<(Rplus $n1 $n2)>>)>>] - -> [ (REXPR $n1):E "+" [0 0] (REXPR $n2):L ] - | Rminus_inside - [<<(REXPR <<(Rminus $n1 $n2)>>)>>] - -> [ (REXPR $n1):E "-" [0 0] (REXPR $n2):L ] - | NRplus_inside - [<<(REXPR <<(NRplus $r)>>)>>] -> [ "(" "1" "+" (REXPR $r):L ")"] - ; - - level 6: - Rmult_inside - [<<(REXPR <<(Rmult $n1 $n2)>>)>>] - -> [ (REXPR $n1):E "*" (REXPR $n2):L ] - | NRmult_inside - [<<(REXPR <<(NRmult $r)>>)>>] -> [ "(" "2" "*" (REXPR $r):L ")"] - ; - - level 5: - Ropp_inside [<<(REXPR <<(Ropp $n1)>>)>>] -> [ " -" (REXPR $n1):E ] - | Rinv_inside [<<(REXPR <<(Rinv $n1)>>)>>] -> [ "/" (REXPR $n1):E ] - | Rdiv_inside - [<<(REXPR <<(Rdiv $n1 $n2)>>)>>] - -> [ (REXPR $n1):E "/" [0 0] (REXPR $n2):L ] - ; - - level 0: - Rzero_inside [<<(REXPR <<R0>>)>>] -> ["0"] - | Rone_inside [<<(REXPR <<R1>>)>>] -> ["1"] - | Rodd_inside [<<(REXPR <<(Rplus R1 $r)>>)>>] -> [ $r:"r_printer_odd" ] - | Reven_inside [<<(REXPR <<(Rmult (Rplus R1 R1) $r)>>)>>] -> [ $r:"r_printer_even" ] -. - -(* For parsing/printing based on scopes *) -Module R_scope. - -Infix "<=" Rle (at level 5, no associativity) : R_scope V8only. -Infix "<" Rlt (at level 5, no associativity) : R_scope V8only. -Infix ">=" Rge (at level 5, no associativity) : R_scope V8only. -Infix ">" Rgt (at level 5, no associativity) : R_scope V8only. -Infix "+" Rplus (at level 4) : R_scope V8only. -Infix "-" Rminus (at level 4) : R_scope V8only. -Infix "*" Rmult (at level 3) : R_scope V8only. -Infix "/" Rdiv (at level 3) : R_scope V8only. -Notation "- x" := (Ropp x) (at level 0) : R_scope V8only. -Notation "x == y == z" := (eqT R x y)/\(eqT R y z) - (at level 5, y at level 4, no associtivity): R_scope. -Notation "x <= y <= z" := (Rle x y)/\(Rle y z) - (at level 5, y at level 4) : R_scope - V8only. -Notation "x <= y < z" := (Rle x y)/\(Rlt y z) - (at level 5, y at level 4) : R_scope - V8only. -Notation "x < y < z" := (Rlt x y)/\(Rlt y z) - (at level 5, y at level 4) : R_scope - V8only. -Notation "x < y <= z" := (Rlt x y)/\(Rle y z) - (at level 5, y at level 4) : R_scope - V8only. -Notation "/ x" := (Rinv x) (at level 0): R_scope - V8only. - -Open Local Scope R_scope. -End R_scope. -]. +Axiom NRplus : R -> R. +Axiom NRmult : R -> R. diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v index c59db60ce..17b884d45 100644 --- a/theories/Reals/Rtopology.v +++ b/theories/Reals/Rtopology.v @@ -8,879 +8,1263 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Ranalysis1. -Require RList. -Require Classical_Prop. -Require Classical_Pred_Type. -V7only [Import R_scope.]. Open Local Scope R_scope. - -Definition included [D1,D2:R->Prop] : Prop := (x:R)(D1 x)->(D2 x). -Definition disc [x:R;delta:posreal] : R->Prop := [y:R]``(Rabsolu (y-x))<delta``. -Definition neighbourhood [V:R->Prop;x:R] : Prop := (EXT delta:posreal | (included (disc x delta) V)). -Definition open_set [D:R->Prop] : Prop := (x:R) (D x)->(neighbourhood D x). -Definition complementary [D:R->Prop] : R->Prop := [c:R]~(D c). -Definition closed_set [D:R->Prop] : Prop := (open_set (complementary D)). -Definition intersection_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)/\(D2 c). -Definition union_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)\/(D2 c). -Definition interior [D:R->Prop] : R->Prop := [x:R](neighbourhood D x). - -Lemma interior_P1 : (D:R->Prop) (included (interior D) D). -Intros; Unfold included; Unfold interior; Intros; Unfold neighbourhood in H; Elim H; Intros; Unfold included in H0; Apply H0; Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0). +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import RList. +Require Import Classical_Prop. +Require Import Classical_Pred_Type. Open Local Scope R_scope. + +Definition included (D1 D2:R -> Prop) : Prop := forall x:R, D1 x -> D2 x. +Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta. +Definition neighbourhood (V:R -> Prop) (x:R) : Prop := + exists delta : posreal | included (disc x delta) V. +Definition open_set (D:R -> Prop) : Prop := + forall x:R, D x -> neighbourhood D x. +Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c. +Definition closed_set (D:R -> Prop) : Prop := open_set (complementary D). +Definition intersection_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c /\ D2 c. +Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c. +Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x. + +Lemma interior_P1 : forall D:R -> Prop, included (interior D) D. +intros; unfold included in |- *; unfold interior in |- *; intros; + unfold neighbourhood in H; elim H; intros; unfold included in H0; + apply H0; unfold disc in |- *; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). Qed. -Lemma interior_P2 : (D:R->Prop) (open_set D) -> (included D (interior D)). -Intros; Unfold open_set in H; Unfold included; Intros; Assert H1 := (H ? H0); Unfold interior; Apply H1. +Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D). +intros; unfold open_set in H; unfold included in |- *; intros; + assert (H1 := H _ H0); unfold interior in |- *; apply H1. Qed. -Definition point_adherent [D:R->Prop;x:R] : Prop := (V:R->Prop) (neighbourhood V x) -> (EXT y:R | (intersection_domain V D y)). -Definition adherence [D:R->Prop] : R->Prop := [x:R](point_adherent D x). - -Lemma adherence_P1 : (D:R->Prop) (included D (adherence D)). -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; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0). -Apply H. +Definition point_adherent (D:R -> Prop) (x:R) : Prop := + forall V:R -> Prop, + neighbourhood V x -> exists y : R | intersection_domain V D y. +Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x. + +Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D). +intro; unfold included in |- *; intros; unfold adherence in |- *; + unfold point_adherent in |- *; intros; exists x; + unfold intersection_domain in |- *; split. +unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1; + unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply (cond_pos x0). +apply H. Qed. -Lemma included_trans : (D1,D2,D3:R->Prop) (included D1 D2) -> (included D2 D3) -> (included D1 D3). -Unfold included; Intros; Apply H0; Apply H; Apply H1. +Lemma included_trans : + forall D1 D2 D3:R -> Prop, + included D1 D2 -> included D2 D3 -> included D1 D3. +unfold included in |- *; intros; apply H0; apply H; apply H1. Qed. -Lemma interior_P3 : (D:R->Prop) (open_set (interior D)). -Intro; Unfold open_set interior; Unfold neighbourhood; Intros; Elim H; Intros. -Exists x0; Unfold included; Intros. -Pose del := ``x0-(Rabsolu (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; Unfold disc; Intros. -Apply Rle_lt_trans with ``(Rabsolu (x3-x1))+(Rabsolu (x1-x))``. -Replace ``x3-x`` with ``(x3-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring]. -Replace (pos x0) with ``del+(Rabsolu (x1-x))``. -Do 2 Rewrite <- (Rplus_sym (Rabsolu ``x1-x``)); Apply Rlt_compatibility; Apply H4. -Unfold del; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring. -Unfold del; Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Idtac | Ring]. -Unfold disc in H1; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1. +Lemma interior_P3 : forall D:R -> Prop, open_set (interior D). +intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *; + intros; elim H; intros. +exists x0; unfold included in |- *; intros. +pose (del := x0 - Rabs (x - x1)). +cut (0 < del). +intro; exists (mkposreal del H2); intros. +cut (included (disc x1 (mkposreal del H2)) (disc x x0)). +intro; assert (H5 := included_trans _ _ _ H4 H0). +apply H5; apply H3. +unfold included in |- *; unfold disc in |- *; intros. +apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)). +replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. +replace (pos x0) with (del + Rabs (x1 - x)). +do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; + apply H4. +unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; + ring. +unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1)); + rewrite Rplus_0_r; + replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); + [ idtac | ring ]. +unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1. Qed. -Lemma complementary_P1 : (D:R->Prop) ~(EXT y:R | (intersection_domain D (complementary D) y)). -Intro; Red; Intro; Elim H; Intros; Unfold intersection_domain complementary in H0; Elim H0; Intros; Elim H2; Assumption. +Lemma complementary_P1 : + forall D:R -> Prop, + ~ ( exists y : R | intersection_domain D (complementary D) y). +intro; red in |- *; intro; elim H; intros; + unfold intersection_domain, complementary in H0; elim H0; + intros; elim H2; assumption. Qed. -Lemma adherence_P2 : (D:R->Prop) (closed_set D) -> (included (adherence D) D). -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; Unfold intersection_domain in H5; Elim H5; Intros; Elim H6; Assumption. +Lemma adherence_P2 : + forall D:R -> Prop, closed_set D -> included (adherence D) D. +unfold closed_set in |- *; unfold open_set, complementary in |- *; intros; + unfold included, adherence in |- *; intros; assert (H1 := classic (D x)); + elim H1; intro. +assumption. +assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; + unfold intersection_domain in H5; elim H5; intros; + elim H6; assumption. Qed. -Lemma adherence_P3 : (D:R->Prop) (closed_set (adherence D)). -Intro; Unfold closed_set adherence; Unfold open_set complementary point_adherent; Intros; Pose P := [V:R->Prop](neighbourhood V x)->(EXT 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; Elim H2; Intros; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Intros; Red; Intro. -Assert H8 := (H7 V0); Cut (EXT delta:posreal | (x:R)(disc x1 delta x)->(V0 x)). -Intro; Assert H10 := (H8 H9); Elim H4; Assumption. -Cut ``0<x0-(Rabsolu (x-x1))``. -Intro; Pose del := (mkposreal ? H9); Exists del; Intros; Unfold included in H5; Apply H5; Unfold disc; Apply Rle_lt_trans with ``(Rabsolu (x2-x1))+(Rabsolu (x1-x))``. -Replace ``x2-x`` with ``(x2-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring]. -Replace (pos x0) with ``del+(Rabsolu (x1-x))``. -Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x1-x))``); Apply Rlt_compatibility; Apply H10. -Unfold del; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring. -Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H6 | Ring]. +Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D). +intro; unfold closed_set, adherence in |- *; + unfold open_set, complementary, point_adherent in |- *; + intros; + pose + (P := + fun V:R -> Prop => + neighbourhood V x -> exists y : R | intersection_domain V D y); + assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; + unfold P in H1; assert (H2 := imply_to_and _ _ H1); + unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3; + elim H3; intros; exists x0; unfold included in |- *; + intros; red in |- *; intro. +assert (H8 := H7 V0); + cut ( exists delta : posreal | (forall x:R, disc x1 delta x -> V0 x)). +intro; assert (H10 := H8 H9); elim H4; assumption. +cut (0 < x0 - Rabs (x - x1)). +intro; pose (del := mkposreal _ H9); exists del; intros; + unfold included in H5; apply H5; unfold disc in |- *; + apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)). +replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. +replace (pos x0) with (del + Rabs (x1 - x)). +do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; + apply H10. +unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1)); + rewrite Ropp_minus_distr; ring. +apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r; + replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); + [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ]. Qed. -Definition eq_Dom [D1,D2:R->Prop] : Prop := (included D1 D2)/\(included D2 D1). +Definition eq_Dom (D1 D2:R -> Prop) : Prop := + included D1 D2 /\ included D2 D1. -Infix "=_D" eq_Dom (at level 5, no associativity). +Infix "=_D" := eq_Dom (at level 70, no associativity). -Lemma open_set_P1 : (D:R->Prop) (open_set D) <-> D =_D (interior D). -Intro; 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; Intros; Unfold included interior in H; Unfold included in H0; Apply (H ? H1). +Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D. +intro; split. +intro; unfold eq_Dom in |- *; split. +apply interior_P2; assumption. +apply interior_P1. +intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *; + intros; unfold included, interior in H; unfold included in H0; + apply (H _ H1). Qed. -Lemma closed_set_P1 : (D:R->Prop) (closed_set D) <-> D =_D (adherence D). -Intro; Split. -Intro; Unfold eq_Dom; Split. -Apply adherence_P1. -Apply adherence_P2; Assumption. -Unfold eq_Dom; Unfold included; Intros; Assert H0 := (adherence_P3 D); Unfold closed_set in H0; Unfold closed_set; Unfold open_set; Unfold open_set in H0; Intros; Assert H2 : (complementary (adherence D) x). -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; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Unfold included in H4; Intros; Assert H6 := (H4 ? H5); Unfold complementary in H6; Unfold complementary; Red; Intro; Elim H; Clear H; Intros H _; Elim H6; Apply (H ? H7). +Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D. +intro; split. +intro; unfold eq_Dom in |- *; split. +apply adherence_P1. +apply adherence_P2; assumption. +unfold eq_Dom in |- *; unfold included in |- *; intros; + assert (H0 := adherence_P3 D); unfold closed_set in H0; + unfold closed_set in |- *; unfold open_set in |- *; + unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). +unfold complementary in |- *; unfold complementary in H1; red in |- *; intro; + elim H; clear H; intros _ H; elim H1; apply (H _ H2). +assert (H3 := H0 _ H2); unfold neighbourhood in |- *; + unfold neighbourhood in H3; elim H3; intros; exists x0; + unfold included in |- *; unfold included in H4; intros; + assert (H6 := H4 _ H5); unfold complementary in H6; + unfold complementary in |- *; red in |- *; intro; + elim H; clear H; intros H _; elim H6; apply (H _ H7). Qed. -Lemma neighbourhood_P1 : (D1,D2:R->Prop;x:R) (included D1 D2) -> (neighbourhood D1 x) -> (neighbourhood D2 x). -Unfold included neighbourhood; Intros; Elim H0; Intros; Exists x0; Intros; Unfold included; Unfold included in H1; Intros; Apply (H ? (H1 ? H2)). +Lemma neighbourhood_P1 : + forall (D1 D2:R -> Prop) (x:R), + included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x. +unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0; + intros; unfold included in |- *; unfold included in H1; + intros; apply (H _ (H1 _ H2)). Qed. -Lemma open_set_P2 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (union_domain D1 D2)). -Unfold open_set; Intros; Unfold union_domain in H1; Elim H1; Intro. -Apply neighbourhood_P1 with D1. -Unfold included union_domain; Tauto. -Apply H; Assumption. -Apply neighbourhood_P1 with D2. -Unfold included union_domain; Tauto. -Apply H0; Assumption. +Lemma open_set_P2 : + forall D1 D2:R -> Prop, + open_set D1 -> open_set D2 -> open_set (union_domain D1 D2). +unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro. +apply neighbourhood_P1 with D1. +unfold included, union_domain in |- *; tauto. +apply H; assumption. +apply neighbourhood_P1 with D2. +unfold included, union_domain in |- *; tauto. +apply H0; assumption. Qed. -Lemma open_set_P3 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (intersection_domain D1 D2)). -Unfold open_set; Intros; Unfold intersection_domain in H1; Elim H1; Intros. -Assert H4 := (H ? H2); Assert H5 := (H0 ? H3); 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; Pose del := (mkposreal ? H6). -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; Simpl; Apply Rmin_l. -Apply H0; Apply Rlt_le_trans with (pos del). -Apply H7. -Unfold del; Simpl; Apply Rmin_r. -Unfold Rmin; Case (total_order_Rle del1 del2); Intro. -Apply (cond_pos del1). -Apply (cond_pos del2). +Lemma open_set_P3 : + forall D1 D2:R -> Prop, + open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2). +unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1; + intros. +assert (H4 := H _ H2); assert (H5 := H0 _ H3); + unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; + elim H4; clear H; intros del1 H; elim H5; clear H0; + intros del2 H0; cut (0 < Rmin del1 del2). +intro; pose (del := mkposreal _ H6). +exists del; unfold included in |- *; intros; unfold included in H, H0; + unfold disc in H, H0, H7. +split. +apply H; apply Rlt_le_trans with (pos del). +apply H7. +unfold del in |- *; simpl in |- *; apply Rmin_l. +apply H0; apply Rlt_le_trans with (pos del). +apply H7. +unfold del in |- *; simpl in |- *; apply Rmin_r. +unfold Rmin in |- *; case (Rle_dec del1 del2); intro. +apply (cond_pos del1). +apply (cond_pos del2). Qed. -Lemma open_set_P4 : (open_set [x:R]False). -Unfold open_set; Intros; Elim H. +Lemma open_set_P4 : open_set (fun x:R => False). +unfold open_set in |- *; intros; elim H. Qed. -Lemma open_set_P5 : (open_set [x:R]True). -Unfold open_set; Intros; Unfold neighbourhood. -Exists (mkposreal R1 Rlt_R0_R1); Unfold included; Intros; Trivial. +Lemma open_set_P5 : open_set (fun x:R => True). +unfold open_set in |- *; intros; unfold neighbourhood in |- *. +exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial. Qed. -Lemma disc_P1 : (x:R;del:posreal) (open_set (disc x del)). -Intros; Assert H := (open_set_P1 (disc x del)). -Elim H; Intros; Apply H1. -Unfold eq_Dom; Split. -Unfold included interior disc; Intros; Cut ``0<del-(Rabsolu (x-x0))``. -Intro; Pose del2 := (mkposreal ? H3). -Exists del2; Unfold included; Intros. -Apply Rle_lt_trans with ``(Rabsolu (x1-x0))+(Rabsolu (x0 -x))``. -Replace ``x1-x`` with ``(x1-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring]. -Replace (pos del) with ``del2 + (Rabsolu (x0-x))``. -Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility. -Apply H4. -Unfold del2; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x0``); Rewrite Ropp_distr2; Ring. -Apply Rlt_anti_compatibility with ``(Rabsolu (x-x0))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x0))+(del-(Rabsolu (x-x0)))`` with (pos del); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2 | Ring]. -Apply interior_P1. +Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del). +intros; assert (H := open_set_P1 (disc x del)). +elim H; intros; apply H1. +unfold eq_Dom in |- *; split. +unfold included, interior, disc in |- *; intros; + cut (0 < del - Rabs (x - x0)). +intro; pose (del2 := mkposreal _ H3). +exists del2; unfold included in |- *; intros. +apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)). +replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. +replace (pos del) with (del2 + Rabs (x0 - x)). +do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l. +apply H4. +unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0)); + rewrite Ropp_minus_distr; ring. +apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r; + replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del); + [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ]. +apply interior_P1. Qed. -Lemma continuity_P1 : (f:R->R;x:R) (continuity_pt f x) <-> (W:R->Prop)(neighbourhood W (f x)) -> (EXT V:R->Prop | (neighbourhood V x) /\ ((y:R)(V y)->(W (f y)))). -Intros; Split. -Intros; Unfold neighbourhood in H0. -Elim H0; Intros del1 H1. -Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Simpl in H; Unfold R_dist in H. -Assert H2 := (H del1 (cond_pos del1)). -Elim H2; Intros del2 H3. -Elim H3; Intros. -Exists (disc x (mkposreal del2 H4)). -Intros; Unfold included in H1; Split. -Unfold neighbourhood disc. -Exists (mkposreal del2 H4). -Unfold included; Intros; Assumption. -Intros; Apply H1; Unfold disc; Case (Req_EM y x); Intro. -Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos del1). -Apply H5; Split. -Unfold D_x no_cond; Split. -Trivial. -Apply not_sym; Apply H7. -Unfold disc in H6; Apply H6. -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)). -Intro; Assert H3 := (H1 H2). -Elim H3; Intros D H4; Elim H4; Intros; Unfold neighbourhood in H5; Elim H5; Intros del1 H7. -Exists (pos del1); Split. -Apply (cond_pos del1). -Intros; Elim H8; Intros; Simpl in H10; Unfold R_dist in H10; Simpl; Unfold R_dist; Apply (H6 ? (H7 ? H10)). -Unfold neighbourhood disc; Exists (mkposreal eps H0); Unfold included; Intros; Assumption. +Lemma continuity_P1 : + forall (f:R -> R) (x:R), + continuity_pt f x <-> + (forall W:R -> Prop, + neighbourhood W (f x) -> + exists V : R -> Prop + | neighbourhood V x /\ (forall y:R, V y -> W (f y))). +intros; split. +intros; unfold neighbourhood in H0. +elim H0; intros del1 H1. +unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H; + unfold limit_in in H; simpl in H; unfold R_dist in H. +assert (H2 := H del1 (cond_pos del1)). +elim H2; intros del2 H3. +elim H3; intros. +exists (disc x (mkposreal del2 H4)). +intros; unfold included in H1; split. +unfold neighbourhood, disc in |- *. +exists (mkposreal del2 H4). +unfold included in |- *; intros; assumption. +intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro. +rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (cond_pos del1). +apply H5; split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq (A:=R)); apply H7. +unfold disc in H6; apply H6. +intros; unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros. +assert (H1 := H (disc (f x) (mkposreal eps H0))). +cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). +intro; assert (H3 := H1 H2). +elim H3; intros D H4; elim H4; intros; unfold neighbourhood in H5; elim H5; + intros del1 H7. +exists (pos del1); split. +apply (cond_pos del1). +intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl in |- *; + unfold R_dist in |- *; apply (H6 _ (H7 _ H10)). +unfold neighbourhood, disc in |- *; exists (mkposreal eps H0); + unfold included in |- *; intros; assumption. Qed. -Definition image_rec [f:R->R;D:R->Prop] : R->Prop := [x:R](D (f x)). +Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x). (**********) -Lemma continuity_P2 : (f:R->R;D:R->Prop) (continuity f) -> (open_set D) -> (open_set (image_rec f D)). -Intros; Unfold open_set in H0; Unfold open_set; Intros; Assert H2 := (continuity_P1 f x); Elim H2; Intros H3 _; 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; Intros; Apply (H8 ? (H9 ? H10)). +Lemma continuity_P2 : + forall (f:R -> R) (D:R -> Prop), + continuity f -> open_set D -> open_set (image_rec f D). +intros; unfold open_set in H0; unfold open_set in |- *; intros; + assert (H2 := continuity_P1 f x); elim H2; intros H3 _; + assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *; + unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); + elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; + elim H7; intros del H9; exists del; unfold included in H9; + unfold included in |- *; intros; apply (H8 _ (H9 _ H10)). Qed. (**********) -Lemma continuity_P3 : (f:R->R) (continuity f) <-> (D:R->Prop) (open_set D)->(open_set (image_rec f D)). -Intros; Split. -Intros; Apply continuity_P2; Assumption. -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)). -Intro; Assert H4 := (H2 ? H3). -Unfold neighbourhood in H4; Elim H4; Intros del H5. -Exists (pos del); Split. -Apply (cond_pos del). -Intros; Unfold included in H5; Apply H5; Elim H6; Intros; Apply H8. -Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0. -Apply disc_P1. +Lemma continuity_P3 : + forall f:R -> R, + continuity f <-> + (forall D:R -> Prop, open_set D -> open_set (image_rec f D)). +intros; split. +intros; apply continuity_P2; assumption. +intros; unfold continuity in |- *; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; cut (open_set (disc (f x) (mkposreal _ H0))). +intro; assert (H2 := H _ H1). +unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)). +intro; assert (H4 := H2 _ H3). +unfold neighbourhood in H4; elim H4; intros del H5. +exists (pos del); split. +apply (cond_pos del). +intros; unfold included in H5; apply H5; elim H6; intros; apply H8. +unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply H0. +apply disc_P1. Qed. (**********) -Theorem Rsepare : (x,y:R) ``x<>y``->(EXT V:R->Prop | (EXT W:R->Prop | (neighbourhood V x)/\(neighbourhood W y)/\~(EXT y:R | (intersection_domain V W y)))). -Intros x y Hsep; Pose D := ``(Rabsolu (x-y))``. -Cut ``0<D/2``. -Intro; Exists (disc x (mkposreal ? H)). -Exists (disc y (mkposreal ? H)); Split. -Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto. -Split. -Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto. -Red; Intro; Elim H0; Intros; Unfold intersection_domain in H1; Elim H1; Intros. -Cut ``D<D``. -Intro; Elim (Rlt_antirefl ? H4). -Change ``(Rabsolu (x-y))<D``; Apply Rle_lt_trans with ``(Rabsolu (x-x0))+(Rabsolu (x0-y))``. -Replace ``x-y`` with ``(x-x0)+(x0-y)``; [Apply Rabsolu_triang | Ring]. -Rewrite (double_var D); Apply Rplus_lt. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2. -Apply H3. -Unfold Rdiv; Apply Rmult_lt_pos. -Unfold D; Apply Rabsolu_pos_lt; Apply (Rminus_eq_contra ? ? Hsep). -Apply Rlt_Rinv; Sup0. +Theorem Rsepare : + forall x y:R, + x <> y -> + exists V : R -> Prop + | ( exists W : R -> Prop + | neighbourhood V x /\ + neighbourhood W y /\ ~ ( exists y : R | intersection_domain V W y)). +intros x y Hsep; pose (D := Rabs (x - y)). +cut (0 < D / 2). +intro; exists (disc x (mkposreal _ H)). +exists (disc y (mkposreal _ H)); split. +unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + tauto. +split. +unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + tauto. +red in |- *; intro; elim H0; intros; unfold intersection_domain in H1; + elim H1; intros. +cut (D < D). +intro; elim (Rlt_irrefl _ H4). +change (Rabs (x - y) < D) in |- *; + apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)). +replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ]. +rewrite (double_var D); apply Rplus_lt_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2. +apply H3. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep). +apply Rinv_0_lt_compat; prove_sup0. Qed. -Record family : Type := mkfamily { - ind : R->Prop; - f :> R->R->Prop; - cond_fam : (x:R)(EXT y:R|(f x y))->(ind x) }. +Record family : Type := mkfamily + {ind : R -> Prop; + f :> R -> R -> Prop; + cond_fam : forall x:R, ( exists y : R | f x y) -> ind x}. -Definition family_open_set [f:family] : Prop := (x:R) (open_set (f x)). +Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x). -Definition domain_finite [D:R->Prop] : Prop := (EXT l:Rlist | (x:R)(D x)<->(In x l)). +Definition domain_finite (D:R -> Prop) : Prop := + exists l : Rlist | (forall x:R, D x <-> In x l). -Definition family_finite [f:family] : Prop := (domain_finite (ind f)). +Definition family_finite (f:family) : Prop := domain_finite (ind f). -Definition covering [D:R->Prop;f:family] : Prop := (x:R) (D x)->(EXT y:R | (f y x)). +Definition covering (D:R -> Prop) (f:family) : Prop := + forall x:R, D x -> exists y : R | f y x. -Definition covering_open_set [D:R->Prop;f:family] : Prop := (covering D f)/\(family_open_set f). +Definition covering_open_set (D:R -> Prop) (f:family) : Prop := + covering D f /\ family_open_set f. -Definition covering_finite [D:R->Prop;f:family] : Prop := (covering D f)/\(family_finite f). +Definition covering_finite (D:R -> Prop) (f:family) : Prop := + covering D f /\ family_finite f. -Lemma restriction_family : (f:family;D:R->Prop) (x:R)(EXT y:R|([z1:R][z2:R](f z1 z2)/\(D z1) x y))->(intersection_domain (ind f) D x). -Intros; Elim H; Intros; Unfold intersection_domain; Elim H0; Intros; Split. -Apply (cond_fam f0); Exists x0; Assumption. -Assumption. +Lemma restriction_family : + forall (f:family) (D:R -> Prop) (x:R), + ( exists y : R | (fun z1 z2:R => f z1 z2 /\ D z1) x y) -> + intersection_domain (ind f) D x. +intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros; + split. +apply (cond_fam f0); exists x0; assumption. +assumption. Qed. -Definition subfamily [f:family;D:R->Prop] : family := (mkfamily (intersection_domain (ind f) D) [x:R][y:R](f x y)/\(D x) (restriction_family f D)). +Definition subfamily (f:family) (D:R -> Prop) : family := + mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x) + (restriction_family f D). -Definition compact [X:R->Prop] : Prop := (f:family) (covering_open_set X f) -> (EXT D:R->Prop | (covering_finite X (subfamily f D))). +Definition compact (X:R -> Prop) : Prop := + forall f:family, + covering_open_set X f -> + exists D : R -> Prop | covering_finite X (subfamily f D). (**********) -Lemma family_P1 : (f:family;D:R->Prop) (family_open_set f) -> (family_open_set (subfamily f D)). -Unfold family_open_set; Intros; Unfold subfamily; Simpl; Assert H0 := (classic (D x)). -Elim H0; Intro. -Cut (open_set (f0 x))->(open_set [y:R](f0 x y)/\(D x)). -Intro; Apply H2; Apply H. -Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Assert H6 := (H2 ? H4); Elim H6; Intros; Exists x1; Unfold included; Intros; Split. -Apply (H7 ? H8). -Assumption. -Cut (open_set [y:R]False) -> (open_set [y:R](f0 x y)/\(D x)). -Intro; Apply H2; Apply open_set_P4. -Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Elim H1; Assumption. +Lemma family_P1 : + forall (f:family) (D:R -> Prop), + family_open_set f -> family_open_set (subfamily f D). +unfold family_open_set in |- *; intros; unfold subfamily in |- *; + simpl in |- *; assert (H0 := classic (D x)). +elim H0; intro. +cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)). +intro; apply H2; apply H. +unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; + intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1; + unfold included in |- *; intros; split. +apply (H7 _ H8). +assumption. +cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)). +intro; apply H2; apply open_set_P4. +unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; + intros; elim H1; assumption. Qed. -Definition bounded [D:R->Prop] : Prop := (EXT m:R | (EXT M:R | (x:R)(D x)->``m<=x<=M``)). +Definition bounded (D:R -> Prop) : Prop := + exists m : R | ( exists M : R | (forall x:R, D x -> m <= x <= M)). -Lemma open_set_P6 : (D1,D2:R->Prop) (open_set D1) -> D1 =_D D2 -> (open_set D2). -Unfold open_set; Unfold neighbourhood; Intros. -Unfold eq_Dom in H0; Elim H0; Intros. -Assert H4 := (H ? (H3 ? H1)). -Elim H4; Intros. -Exists x0; Apply included_trans with D1; Assumption. +Lemma open_set_P6 : + forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2. +unfold open_set in |- *; unfold neighbourhood in |- *; intros. +unfold eq_Dom in H0; elim H0; intros. +assert (H4 := H _ (H3 _ H1)). +elim H4; intros. +exists x0; apply included_trans with D1; assumption. Qed. (**********) -Lemma compact_P1 : (X:R->Prop) (compact X) -> (bounded X). -Intros; Unfold compact in H; Pose D := [x:R]True; Pose g := [x:R][y:R]``(Rabsolu y)<x``; Cut (x:R)(EXT y|(g x y))->True; [Intro | Intro; Trivial]. -Pose f0 := (mkfamily D g H0); Assert H1 := (H f0); Cut (covering_open_set X f0). -Intro; Assert H3 := (H1 H2); Elim H3; Intros D' H4; Unfold covering_finite in H4; Elim H4; Intros; Unfold family_finite in H6; Unfold domain_finite in H6; Elim H6; Intros l H7; Unfold bounded; Pose r := (MaxRlist l). -Exists ``-r``; Exists r; Intros. -Unfold covering in H5; Assert H9 := (H5 ? H8); Elim H9; Intros; Unfold subfamily in H10; Simpl in H10; Elim H10; Intros; Assert H13 := (H7 x0); Simpl in H13; Cut (intersection_domain D D' x0). -Elim H13; Clear H13; Intros. -Assert H16 := (H13 H15); Unfold g in H11; Split. -Cut ``x0<=r``. -Intro; Cut ``(Rabsolu x)<r``. -Intro; Assert H19 := (Rabsolu_def2 x r H18); Elim H19; Intros; Left; Assumption. -Apply Rlt_le_trans with x0; Assumption. -Apply (MaxRlist_P1 l x0 H16). -Cut ``x0<=r``. -Intro; Apply Rle_trans with (Rabsolu x). -Apply Rle_Rabsolu. -Apply Rle_trans with x0. -Left; Apply H11. -Assumption. -Apply (MaxRlist_P1 l x0 H16). -Unfold intersection_domain D; Tauto. -Unfold covering_open_set; Split. -Unfold covering; Intros; Simpl; Exists ``(Rabsolu x)+1``; Unfold g; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1. -Unfold family_open_set; Intro; Case (total_order R0 x); Intro. -Apply open_set_P6 with (disc R0 (mkposreal ? H2)). -Apply disc_P1. -Unfold eq_Dom; Unfold f0; Simpl; Unfold g disc; Split. -Unfold included; Intros; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3. -Unfold included; Intros; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H3. -Apply open_set_P6 with [x:R]False. -Apply open_set_P4. -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 := (Rabsolu_pos x0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)) | Assert H6 := (Rabsolu_pos x0); Assert H7 := (Rlt_trans ? ? ? H3 H4); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7))]. +Lemma compact_P1 : forall X:R -> Prop, compact X -> bounded X. +intros; unfold compact in H; pose (D := fun x:R => True); + pose (g := fun x y:R => Rabs y < x); + cut (forall x:R, ( exists y : _ | g x y) -> True); + [ intro | intro; trivial ]. +pose (f0 := mkfamily D g H0); assert (H1 := H f0); + cut (covering_open_set X f0). +intro; assert (H3 := H1 H2); elim H3; intros D' H4; + unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6; + unfold domain_finite in H6; elim H6; intros l H7; + unfold bounded in |- *; pose (r := MaxRlist l). +exists (- r); exists r; intros. +unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros; + unfold subfamily in H10; simpl in H10; elim H10; intros; + assert (H13 := H7 x0); simpl in H13; cut (intersection_domain D D' x0). +elim H13; clear H13; intros. +assert (H16 := H13 H15); unfold g in H11; split. +cut (x0 <= r). +intro; cut (Rabs x < r). +intro; assert (H19 := Rabs_def2 x r H18); elim H19; intros; left; assumption. +apply Rlt_le_trans with x0; assumption. +apply (MaxRlist_P1 l x0 H16). +cut (x0 <= r). +intro; apply Rle_trans with (Rabs x). +apply RRle_abs. +apply Rle_trans with x0. +left; apply H11. +assumption. +apply (MaxRlist_P1 l x0 H16). +unfold intersection_domain, D in |- *; tauto. +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1); + unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1. +unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro. +apply open_set_P6 with (disc 0 (mkposreal _ H2)). +apply disc_P1. +unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *; + unfold g, disc in |- *; split. +unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3; + rewrite Rplus_0_r in H3; apply H3. +unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply H3. +apply open_set_P6 with (fun x:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H3. +unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2; + intro; + [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0); + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)) + | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4); + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ]. Qed. (**********) -Lemma compact_P2 : (X:R->Prop) (compact X) -> (closed_set X). -Intros; Assert H0 := (closed_set_P1 X); Elim H0; Clear H0; Intros _ H0; Apply H0; Clear H0. -Unfold eq_Dom; Split. -Apply adherence_P1. -Unfold included; Unfold adherence; Unfold point_adherent; Intros; Unfold compact in H; Assert H1 := (classic (X x)); Elim H1; Clear H1; Intro. -Assumption. -Cut (y:R)(X y)->``0<(Rabsolu (y-x))/2``. -Intro; Pose D := X; Pose g := [y:R][z:R]``(Rabsolu (y-z))<(Rabsolu (y-x))/2``/\(D y); Cut (x:R)(EXT y|(g x y))->(D x). -Intro; Pose f0 := (mkfamily D g H3); Assert H4 := (H f0); Cut (covering_open_set X f0). -Intro; Assert H6 := (H4 H5); Elim H6; Clear H6; Intros D' H6. -Unfold covering_finite in H6; Decompose [and] H6; Unfold covering subfamily in H7; Simpl in H7; Unfold family_finite subfamily in H8; Simpl in H8; Unfold domain_finite in H8; Elim H8; Clear H8; Intros l H8; Pose alp := (MinRlist (AbsList l x)); Cut ``0<alp``. -Intro; Assert H10 := (H0 (disc x (mkposreal ? H9))); Cut (neighbourhood (disc x (mkposreal alp H9)) x). -Intro; Assert H12 := (H10 H11); Elim H12; Clear H12; Intros y H12; Unfold intersection_domain in H12; Elim H12; Clear H12; Intros; Assert H14 := (H7 ? H13); Elim H14; Clear H14; Intros y0 H14; Elim H14; Clear H14; Intros; Unfold g in H14; Elim H14; Clear H14; Intros; Unfold disc in H12; Simpl in H12; Cut ``alp<=(Rabsolu (y0-x))/2``. -Intro; Assert H18 := (Rlt_le_trans ? ? ? H12 H17); Cut ``(Rabsolu (y0-x))<(Rabsolu (y0-x))``. -Intro; Elim (Rlt_antirefl ? H19). -Apply Rle_lt_trans with ``(Rabsolu (y0-y))+(Rabsolu (y-x))``. -Replace ``y0-x`` with ``(y0-y)+(y-x)``; [Apply Rabsolu_triang | Ring]. -Rewrite (double_var ``(Rabsolu (y0-x))``); Apply Rplus_lt; Assumption. -Apply (MinRlist_P1 (AbsList l x) ``(Rabsolu (y0-x))/2``); Apply AbsList_P1; 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; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H9. -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; Split. -Unfold covering; Intros; Exists x0; Simpl; Unfold g; Split. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rminus in H2; Apply (H2 ? H5). -Apply H5. -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; Split. -Unfold included disc; Simpl; Intros; Split. -Rewrite <- (Rabsolu_Ropp ``x0-x1``); Rewrite Ropp_distr2; Apply H6. -Apply H5. -Unfold included disc; Simpl; Intros; Elim H6; Intros; Rewrite <- (Rabsolu_Ropp ``x1-x0``); Rewrite Ropp_distr2; Apply H7. -Apply open_set_P6 with [z:R]False. -Apply open_set_P4. -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; Apply Rmult_lt_pos. -Apply Rabsolu_pos_lt; Apply Rminus_eq_contra; Red; Intro; Rewrite H3 in H2; Elim H1; Apply H2. -Apply Rlt_Rinv; Sup0. +Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X. +intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0; + apply H0; clear H0. +unfold eq_Dom in |- *; split. +apply adherence_P1. +unfold included in |- *; unfold adherence in |- *; + unfold point_adherent in |- *; intros; unfold compact in H; + assert (H1 := classic (X x)); elim H1; clear H1; intro. +assumption. +cut (forall y:R, X y -> 0 < Rabs (y - x) / 2). +intro; pose (D := X); + pose (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y); + cut (forall x:R, ( exists y : _ | g x y) -> D x). +intro; pose (f0 := mkfamily D g H3); assert (H4 := H f0); + cut (covering_open_set X f0). +intro; assert (H6 := H4 H5); elim H6; clear H6; intros D' H6. +unfold covering_finite in H6; decompose [and] H6; + unfold covering, subfamily in H7; simpl in H7; + unfold family_finite, subfamily in H8; simpl in H8; + unfold domain_finite in H8; elim H8; clear H8; intros l H8; + pose (alp := MinRlist (AbsList l x)); cut (0 < alp). +intro; assert (H10 := H0 (disc x (mkposreal _ H9))); + cut (neighbourhood (disc x (mkposreal alp H9)) x). +intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12; + unfold intersection_domain in H12; elim H12; clear H12; + intros; assert (H14 := H7 _ H13); elim H14; clear H14; + intros y0 H14; elim H14; clear H14; intros; unfold g in H14; + elim H14; clear H14; intros; unfold disc in H12; simpl in H12; + cut (alp <= Rabs (y0 - x) / 2). +intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17); + cut (Rabs (y0 - x) < Rabs (y0 - x)). +intro; elim (Rlt_irrefl _ H19). +apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)). +replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ]. +rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption. +apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1; + elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *; + split; assumption. +assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11; + apply H11. +unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply H9. +unfold alp in |- *; apply MinRlist_P2; intros; + assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; + intros z H10; elim H10; clear H10; intros; rewrite H11; + apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10); + unfold intersection_domain, D in H13; elim H13; clear H13; + intros; assumption. +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *; + split. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rminus in H2; apply (H2 _ H5). +apply H5. +unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *; + elim (classic (D x0)); intro. +apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))). +apply disc_P1. +unfold eq_Dom in |- *; split. +unfold included, disc in |- *; simpl in |- *; intros; split. +rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6. +apply H5. +unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros; + rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; + apply H7. +apply open_set_P6 with (fun z:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H6. +unfold included in |- *; intros; elim H6; intros; elim H5; assumption. +intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4; + apply H4. +intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro; + rewrite H3 in H2; elim H1; apply H2. +apply Rinv_0_lt_compat; prove_sup0. Qed. (**********) -Lemma compact_EMP : (compact [_:R]False). -Unfold compact; Intros; Exists [x:R]False; Unfold covering_finite; Split. -Unfold covering; Intros; Elim H0. -Unfold family_finite; Unfold domain_finite; Exists nil; Intro. -Split. -Simpl; Unfold intersection_domain; Intros; Elim H0. -Elim H0; Clear H0; Intros _ H0; Elim H0. -Simpl; Intro; Elim H0. +Lemma compact_EMP : compact (fun _:R => False). +unfold compact in |- *; intros; exists (fun x:R => False); + unfold covering_finite in |- *; split. +unfold covering in |- *; intros; elim H0. +unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro. +split. +simpl in |- *; unfold intersection_domain in |- *; intros; elim H0. +elim H0; clear H0; intros _ H0; elim H0. +simpl in |- *; intro; elim H0. Qed. -Lemma compact_eqDom : (X1,X2:R->Prop) (compact X1) -> X1 =_D X2 -> (compact X2). -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; Intros; Apply (H1 ? (H0 ? H4)). -Apply H3. -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; Intros; Apply (H5 ? (H2 ? H7)). -Apply H6. +Lemma compact_eqDom : + forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2. +unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0; + unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0). +unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1; + clear H1; intros; split. +unfold covering in H1; unfold covering in |- *; intros; + apply (H1 _ (H0 _ H4)). +apply H3. +elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *; + unfold covering_finite in H4; elim H4; intros; split. +unfold covering in H5; unfold covering in |- *; intros; + apply (H5 _ (H2 _ H7)). +apply H6. Qed. (* Borel-Lebesgue's lemma *) -Lemma compact_P3 : (a,b:R) (compact [c:R]``a<=c<=b``). -Intros; Case (total_order_Rle a b); Intro. -Unfold compact; Intros; Pose A := [x:R]``a<=x<=b``/\(EXT D:R->Prop | (covering_finite [c:R]``a <= c <= x`` (subfamily f0 D))); Cut (A a). -Intro; Cut (bound A). -Intro; Cut (EXT a0:R | (A a0)). -Intro; Assert H3 := (complet A H1 H2); Elim H3; Clear H3; Intros m H3; Unfold is_lub in H3; Cut ``a<=m<=b``. -Intro; Unfold covering_open_set in H; Elim H; Clear H; Intros; Unfold covering in H; Assert H6 := (H m H4); Elim H6; Clear H6; Intros y0 H6; Unfold family_open_set in H5; Assert H7 := (H5 y0); Unfold open_set in H7; Assert H8 := (H7 m H6); Unfold neighbourhood in H8; Elim H8; Clear H8; Intros eps H8; Cut (EXT x:R | (A x)/\``m-eps<x<=m``). -Intro; Elim H9; Clear H9; Intros x H9; Elim H9; Clear H9; Intros; Case (Req_EM m b); Intro. -Rewrite H11 in H10; Rewrite H11 in H8; Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split. -Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro. -Cut ``a<=x0<=x``. -Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; 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; Split. -Apply H8; Unfold disc; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right. -Apply Rlt_trans with ``b-x``. -Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real. -Elim H10; Intros H15 _; Apply Rlt_anti_compatibility 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_sym1; Elim H14; Intros _ H15; Apply H15. -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_EM x0 y0); Intro. -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; Unfold intersection_domain. -Split. -Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6. -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; Left; Elim H17; Intros; Assumption. -Pose 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_antirefl ? (Rle_lt_trans ? ? ? H15 H16)). -Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro. -Pattern 1 m; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0]. -Elim H4; Intros. -Elim H17; Intro. -Assumption. -Elim H11; Assumption. -Unfold A; Split. -Split. -Apply Rle_trans with m. -Elim H4; Intros; Assumption. -Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro. -Pattern 1 m; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0]. -Elim H4; Intros. -Elim H13; Intro. -Assumption. -Elim H11; Assumption. -Unfold m'; Apply Rmin_r. -Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split. -Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro. -Cut ``a<=x0<=x``. -Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; 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; Split. -Apply H8; Unfold disc; Unfold Rabsolu; Case (case_Rabsolu ``x0-m``); Intro. -Rewrite Ropp_distr2; Apply Rlt_trans with ``m-x``. -Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real. -Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(m-x)`` with ``m-eps``. -Replace ``x-eps+eps`` with x. -Elim H10; Intros; Assumption. -Ring. -Ring. -Apply Rle_lt_trans with ``m'-m``. -Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-m``); Apply Rle_compatibility; Elim H14; Intros; Assumption. -Apply Rlt_anti_compatibility with m; Replace ``m+(m'-m)`` with m'. -Apply Rle_lt_trans with ``m+eps/2``. -Unfold m'; Apply Rmin_l. -Apply Rlt_compatibility; Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps). -DiscrR. -Ring. -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_EM x0 y0); Intro. -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; Unfold intersection_domain. -Split. -Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6. -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; Left; Elim H17; Intros; Assumption. -Elim (classic (EXT 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_antirefl ? (Rle_lt_trans ? ? ? H13 H14)). -Pattern 2 m; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Rewrite Ropp_O; Apply (cond_pos eps). -Pose P := [n:R](A n)/\``m-eps<n<=m``; Assert H12 := (not_ex_all_not ? P H9); Unfold P in H12; Unfold is_upper_bound; Intros; Assert H14 := (not_and_or ? ? (H12 x)); Elim H14; Intro. -Elim H15; Apply H13. -Elim (not_and_or ? ? H15); Intro. -Case (total_order_Rle x ``m-eps``); Intro. -Assumption. -Elim H16; Auto with real. -Unfold is_upper_bound in H10; Assert H17 := (H10 x H13); Elim H16; Apply H17. -Elim H3; Clear H3; Intros. -Unfold is_upper_bound in H3. -Split. -Apply (H3 ? H0). -Apply (H4 b); Unfold is_upper_bound; 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; 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; 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; Pose D':=[x:R]x==y0; Exists D'; Unfold covering_finite; Split. -Unfold covering; Simpl; Intros; Cut x==a. -Intro; Exists y0; Split. -Rewrite H4; Apply H2. -Unfold D'; Reflexivity. -Elim H3; Intros; Apply Rle_antisym; Assumption. -Unfold family_finite; Unfold domain_finite; Exists (cons y0 nil); Intro; Split. -Simpl; Unfold intersection_domain; Intro; Elim H3; Clear H3; Intros; Unfold D' in H4; Left; Apply H4. -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 [c:R]False. -Apply compact_EMP. -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. +Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b). +intros; case (Rle_dec a b); intro. +unfold compact in |- *; intros; + pose + (A := + fun x:R => + a <= x <= b /\ + ( exists D : R -> Prop + | covering_finite (fun c:R => a <= c <= x) (subfamily f0 D))); + cut (A a). +intro; cut (bound A). +intro; cut ( exists a0 : R | A a0). +intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3; + unfold is_lub in H3; cut (a <= m <= b). +intro; unfold covering_open_set in H; elim H; clear H; intros; + unfold covering in H; assert (H6 := H m H4); elim H6; + clear H6; intros y0 H6; unfold family_open_set in H5; + assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6); + unfold neighbourhood in H8; elim H8; clear H8; intros eps H8; + cut ( exists x : R | A x /\ m - eps < x <= m). +intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros; + case (Req_dec m b); intro. +rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9; + intros; elim H12; clear H12; intros Dx H12; + pose (Db := fun x:R => Dx x \/ x = y0); exists Db; + unfold covering_finite in |- *; split. +unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; + intros; unfold covering in H12; case (Rle_dec x0 x); + intro. +cut (a <= x0 <= x). +intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; + simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; + clear H16; intros; split; [ apply H16 | left; apply H17 ]. +split. +elim H14; intros; assumption. +assumption. +exists y0; simpl in |- *; split. +apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; + rewrite Rabs_right. +apply Rlt_trans with (b - x). +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; + auto with real. +elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (b - x)) with (b - eps); + [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ]. +apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15. +unfold Db in |- *; right; reflexivity. +unfold family_finite in |- *; unfold domain_finite in |- *; + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); + intro; split. +intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); + clear H13; intros; case (Req_dec x0 y0); intro. +simpl in |- *; left; apply H16. +simpl in |- *; right; apply H13. +simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14; + decompose [and or] H14. +split; assumption. +elim H16; assumption. +intro; simpl in H14; elim H14; intro; simpl in |- *; + unfold intersection_domain in |- *. +split. +apply (cond_fam f0); rewrite H15; exists m; apply H6. +unfold Db in |- *; right; assumption. +simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0). +intros _ H16; assert (H17 := H16 H15); simpl in H17; + unfold intersection_domain in H17; split. +elim H17; intros; assumption. +unfold Db in |- *; left; elim H17; intros; assumption. +pose (m' := Rmin (m + eps / 2) b); cut (A m'). +intro; elim H3; intros; unfold is_upper_bound in H13; + assert (H15 := H13 m' H12); cut (m < m'). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)). +unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. +pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H4; intros. +elim H17; intro. +assumption. +elim H11; assumption. +unfold A in |- *; split. +split. +apply Rle_trans with m. +elim H4; intros; assumption. +unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. +pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H4; intros. +elim H13; intro. +assumption. +elim H11; assumption. +unfold m' in |- *; apply Rmin_r. +unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12; + pose (Db := fun x:R => Dx x \/ x = y0); exists Db; + unfold covering_finite in |- *; split. +unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; + intros; unfold covering in H12; case (Rle_dec x0 x); + intro. +cut (a <= x0 <= x). +intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; + simpl in H16; simpl in |- *; unfold Db in |- *. +elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ]. +elim H14; intros; split; assumption. +exists y0; simpl in |- *; split. +apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m)); + intro. +rewrite Ropp_minus_distr; apply Rlt_trans with (m - x). +unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; + auto with real. +apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (m - x)) with (m - eps). +replace (x - eps + eps) with x. +elim H10; intros; assumption. +ring. +ring. +apply Rle_lt_trans with (m' - m). +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m)); + apply Rplus_le_compat_l; elim H14; intros; assumption. +apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'. +apply Rle_lt_trans with (m + eps / 2). +unfold m' in |- *; apply Rmin_l. +apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). +discrR. +ring. +unfold Db in |- *; right; reflexivity. +unfold family_finite in |- *; unfold domain_finite in |- *; + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); + intro; split. +intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); + clear H13; intros; case (Req_dec x0 y0); intro. +simpl in |- *; left; apply H16. +simpl in |- *; right; apply H13; simpl in |- *; + unfold intersection_domain in |- *; unfold Db in H14; + decompose [and or] H14. +split; assumption. +elim H16; assumption. +intro; simpl in H14; elim H14; intro; simpl in |- *; + unfold intersection_domain in |- *. +split. +apply (cond_fam f0); rewrite H15; exists m; apply H6. +unfold Db in |- *; right; assumption. +elim (H13 x0); intros _ H16. +assert (H17 := H16 H15). +simpl in H17. +unfold intersection_domain in H17. +split. +elim H17; intros; assumption. +unfold Db in |- *; left; elim H17; intros; assumption. +elim (classic ( exists x : R | A x /\ m - eps < x <= m)); intro. +assumption. +elim H3; intros; cut (is_upper_bound A (m - eps)). +intro; assert (H13 := H11 _ H12); cut (m - eps < m). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)). +pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; + apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive; + rewrite Ropp_0; apply (cond_pos eps). +pose (P := fun n:R => A n /\ m - eps < n <= m); + assert (H12 := not_ex_all_not _ P H9); unfold P in H12; + unfold is_upper_bound in |- *; intros; + assert (H14 := not_and_or _ _ (H12 x)); elim H14; + intro. +elim H15; apply H13. +elim (not_and_or _ _ H15); intro. +case (Rle_dec x (m - eps)); intro. +assumption. +elim H16; auto with real. +unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17. +elim H3; clear H3; intros. +unfold is_upper_bound in H3. +split. +apply (H3 _ H0). +apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5; + clear H5; intros H5 _; elim H5; clear H5; intros _ H5; + apply H5. +exists a; apply H0. +unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros; + unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; + clear H1; intros _ H1; apply H1. +unfold A in |- *; split. +split; [ right; reflexivity | apply r ]. +unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H; + cut (a <= a <= b). +intro; elim (H _ H1); intros y0 H2; pose (D' := fun x:R => x = y0); exists D'; + unfold covering_finite in |- *; split. +unfold covering in |- *; simpl in |- *; intros; cut (x = a). +intro; exists y0; split. +rewrite H4; apply H2. +unfold D' in |- *; reflexivity. +elim H3; intros; apply Rle_antisym; assumption. +unfold family_finite in |- *; unfold domain_finite in |- *; + exists (cons y0 nil); intro; split. +simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3; + intros; unfold D' in H4; left; apply H4. +simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro. +split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ]. +elim H4. +split; [ right; reflexivity | apply r ]. +apply compact_eqDom with (fun c:R => False). +apply compact_EMP. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H. +unfold included in |- *; intros; elim H; clear H; intros; + assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1. Qed. -Lemma compact_P4 : (X,F:R->Prop) (compact X) -> (closed_set F) -> (included F X) -> (compact F). -Unfold compact; Intros; Elim (classic (EXT z:R | (F z))); Intro Hyp_F_NE. -Pose D := (ind f0); Pose g := (f f0); Unfold closed_set in H0. -Pose g' := [x:R][y:R](f0 x y)\/((complementary F y)/\(D x)). -Pose D' := D. -Cut (x:R)(EXT y:R | (g' x y))->(D' x). -Intro; Pose f' := (mkfamily D' g' H3); Cut (covering_open_set X f'). -Intro; Elim (H ? H4); Intros DX H5; Exists DX. -Unfold covering_finite; Unfold covering_finite in H5; Elim H5; Clear H5; Intros. -Split. -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; 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; 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; Unfold intersection_domain; Unfold D' in H10; Apply H10. -Unfold covering_open_set; Unfold covering_open_set in H2; Elim H2; Clear H2; Intros. -Split. -Unfold covering; Unfold covering in H2; Intros. -Elim (classic (F x)); Intro. -Elim (H2 ? H6); Intros y0 H7; Exists y0; Simpl; Unfold g'; Left; Assumption. -Cut (EXT z:R | (D z)). -Intro; Elim H7; Clear H7; Intros x0 H7; Exists x0; Simpl; Unfold g'; Right. -Split. -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; 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; Split. -Unfold included union_domain complementary; Intros. -Elim H6; Intro; [Left; Apply H7 | Right; Split; Assumption]. -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; 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. -Intros; Elim H3; Intros y0 H4; Unfold g' in H4; Elim H4; Intro. -Apply (cond_fam f0); Exists y0; Apply H5. -Elim H5; Clear H5; Intros _ H5; Apply H5. +Lemma compact_P4 : + forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F. +unfold compact in |- *; intros; elim (classic ( exists z : R | F z)); + intro Hyp_F_NE. +pose (D := ind f0); pose (g := f f0); unfold closed_set in H0. +pose (g' := fun x y:R => f0 x y \/ complementary F y /\ D x). +pose (D' := D). +cut (forall x:R, ( exists y : R | g' x y) -> D' x). +intro; pose (f' := mkfamily D' g' H3); cut (covering_open_set X f'). +intro; elim (H _ H4); intros DX H5; exists DX. +unfold covering_finite in |- *; unfold covering_finite in H5; elim H5; + clear H5; intros. +split. +unfold covering in |- *; unfold covering in H5; intros. +elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *; + elim H8; clear H8; intros. +split. +unfold g' in H8; elim H8; intro. +apply H10. +elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7. +apply H9. +unfold family_finite in |- *; unfold domain_finite in |- *; + unfold family_finite in H6; unfold domain_finite in H6; + elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x); + elim H7; clear H7; intros. +split. +intro; apply H7; simpl in |- *; unfold intersection_domain in |- *; + simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; + apply H9. +intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; + simpl in |- *; unfold intersection_domain in |- *; + unfold D' in H10; apply H10. +unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2; + clear H2; intros. +split. +unfold covering in |- *; unfold covering in H2; intros. +elim (classic (F x)); intro. +elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *; + left; assumption. +cut ( exists z : R | D z). +intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *; + unfold g' in |- *; right. +split. +unfold complementary in |- *; apply H6. +apply H7. +elim Hyp_F_NE; intros z0 H7. +assert (H8 := H2 _ H7). +elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0; + apply H8. +unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *; + elim (classic (D x)); intro. +apply open_set_P6 with (union_domain (f0 x) (complementary F)). +apply open_set_P2. +unfold family_open_set in H4; apply H4. +apply H0. +unfold eq_Dom in |- *; split. +unfold included, union_domain, complementary in |- *; intros. +elim H6; intro; [ left; apply H7 | right; split; assumption ]. +unfold included, union_domain, complementary in |- *; intros. +elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ]. +apply open_set_P6 with (f0 x). +unfold family_open_set in H4; apply H4. +unfold eq_Dom in |- *; split. +unfold included, complementary in |- *; intros; left; apply H6. +unfold included, complementary in |- *; intros. +elim H6; intro. +apply H7. +elim H7; intros _ H8; elim H5; apply H8. +intros; elim H3; intros y0 H4; unfold g' in H4; elim H4; intro. +apply (cond_fam f0); exists y0; apply H5. +elim H5; clear H5; intros _ H5; apply H5. (* Cas ou F est l'ensemble vide *) -Cut (compact F). -Intro; Apply (H3 f0 H2). -Apply compact_eqDom with [_:R]False. -Apply compact_EMP. -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. +cut (compact F). +intro; apply (H3 f0 H2). +apply compact_eqDom with (fun _:R => False). +apply compact_EMP. +unfold eq_Dom in |- *; split. +unfold included in |- *; intros; elim H3. +assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros; + elim (H3 x); apply H4. Qed. (**********) -Lemma compact_P5 : (X:R->Prop) (closed_set X)->(bounded X)->(compact X). -Intros; Unfold bounded in H0. -Elim H0; Clear H0; Intros m H0. -Elim H0; Clear H0; Intros M H0. -Assert H1 := (compact_P3 m M). -Apply (compact_P4 [c:R]``m<=c<=M`` X H1 H H0). +Lemma compact_P5 : forall X:R -> Prop, closed_set X -> bounded X -> compact X. +intros; unfold bounded in H0. +elim H0; clear H0; intros m H0. +elim H0; clear H0; intros M H0. +assert (H1 := compact_P3 m M). +apply (compact_P4 (fun c:R => m <= c <= M) X H1 H H0). Qed. (**********) -Lemma compact_carac : (X:R->Prop) (compact X)<->(closed_set X)/\(bounded X). -Intro; Split. -Intro; Split; [Apply (compact_P2 ? H) | Apply (compact_P1 ? H)]. -Intro; Elim H; Clear H; Intros; Apply (compact_P5 ? H H0). +Lemma compact_carac : + forall X:R -> Prop, compact X <-> closed_set X /\ bounded X. +intro; split. +intro; split; [ apply (compact_P2 _ H) | apply (compact_P1 _ H) ]. +intro; elim H; clear H; intros; apply (compact_P5 _ H H0). Qed. -Definition image_dir [f:R->R;D:R->Prop] : R->Prop := [x:R](EXT y:R | x==(f y)/\(D y)). +Definition image_dir (f:R -> R) (D:R -> Prop) (x:R) : Prop := + exists y : R | x = f y /\ D y. (**********) -Lemma continuity_compact : (f:R->R;X:R->Prop) ((x:R)(continuity_pt f x)) -> (compact X) -> (compact (image_dir f X)). -Unfold compact; Intros; Unfold covering_open_set in H1. -Elim H1; Clear H1; Intros. -Pose D := (ind f1). -Pose g := [x:R][y:R](image_rec f0 (f1 x) y). -Cut (x:R)(EXT y:R | (g x y))->(D x). -Intro; Pose f' := (mkfamily D g H3). -Cut (covering_open_set X f'). -Intro; Elim (H0 f' H4); Intros D' H5; Exists D'. -Unfold covering_finite in H5; Elim H5; Clear H5; Intros; Unfold covering_finite; 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; Unfold domain_finite; Elim H6; Intros l H7; Exists l; Intro; Elim (H7 x); Intros; Split; Intro. -Apply H8; Simpl in H10; Simpl; Apply H10. -Apply (H9 H10). -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; Unfold family_open_set in H2; Intro; Simpl; Unfold g; Cut ([y:R](image_rec f0 (f1 x) y))==(image_rec f0 (f1 x)). -Intro; Rewrite H4. -Apply (continuity_P2 f0 (f1 x) H (H2 x)). -Reflexivity. -Intros; Apply (cond_fam f1); Unfold g in H3; Unfold image_rec in H3; Elim H3; Intros; Exists (f0 x0); Apply H4. +Lemma continuity_compact : + forall (f:R -> R) (X:R -> Prop), + (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X). +unfold compact in |- *; intros; unfold covering_open_set in H1. +elim H1; clear H1; intros. +pose (D := ind f1). +pose (g := fun x y:R => image_rec f0 (f1 x) y). +cut (forall x:R, ( exists y : R | g x y) -> D x). +intro; pose (f' := mkfamily D g H3). +cut (covering_open_set X f'). +intro; elim (H0 f' H4); intros D' H5; exists D'. +unfold covering_finite in H5; elim H5; clear H5; intros; + unfold covering_finite in |- *; split. +unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5; + intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10); + simpl in H11; elim H11; intros z H12; exists z; unfold g in H12; + unfold image_rec in H12; rewrite H9; apply H12. +unfold family_finite in H6; unfold domain_finite in H6; + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H6; intros l H7; exists l; intro; elim (H7 x); + intros; split; intro. +apply H8; simpl in H10; simpl in |- *; apply H10. +apply (H9 H10). +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; simpl in |- *; unfold covering in H1; + unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; + apply H1. +exists x; split; [ reflexivity | apply H4 ]. +unfold family_open_set in |- *; unfold family_open_set in H2; intro; + simpl in |- *; unfold g in |- *; + cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)). +intro; rewrite H4. +apply (continuity_P2 f0 (f1 x) H (H2 x)). +reflexivity. +intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3; + intros; exists (f0 x0); apply H4. Qed. -Lemma Rlt_Rminus : (a,b:R) ``a<b`` -> ``0<b-a``. -Intros; Apply Rlt_anti_compatibility with a; Rewrite Rplus_Or; Replace ``a+(b-a)`` with b; [Assumption | Ring]. +Lemma Rlt_Rminus : forall a b:R, a < b -> 0 < b - a. +intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r; + replace (a + (b - a)) with b; [ assumption | ring ]. Qed. -Lemma prolongement_C0 : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f c))). -Intros; Elim H; Intro. -Pose h := [x:R](Cases (total_order_Rle x a) of - (leftT _) => (f0 a) -| (rightT _) => (Cases (total_order_Rle x b) of - (leftT _) => (f0 x) - | (rightT _) => (f0 b) end) end). -Assert H2 : ``0<b-a``. -Apply Rlt_Rminus; Assumption. -Exists h; Split. -Unfold continuity; Intro; Case (total_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``; Apply Rlt_Rminus; Assumption. -Intros; Elim H5; Clear H5; Intros _ H5; Unfold h. -Case (total_order_Rle x a); Intro. -Case (total_order_Rle x0 a); Intro. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Elim n; Left; Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x0-x))``. -Apply Rle_Rabsolu. -Assumption. -Elim n; Left; Assumption. -Elim H3; Intro. -Assert H5 : ``a<=a<=b``. -Split; [Right; Reflexivity | Left; Assumption]. -Assert H6 := (H0 ? H5); Unfold continuity_pt in H6; Unfold continue_in in H6; Unfold limit1_in in H6; Unfold limit_in in H6; Simpl in H6; Unfold R_dist in H6; Unfold continuity_pt; 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; Case (total_order_Rle x0 ``b-a``); Intro. -Elim H8; Intros; Assumption. -Change ``0<b-a``; Apply Rlt_Rminus; Assumption. -Intros; Elim H9; Clear H9; Intros _ H9; Cut ``x1<b``. -Intro; Unfold h; Case (total_order_Rle x a); Intro. -Case (total_order_Rle x1 a); Intro. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Case (total_order_Rle x1 b); Intro. -Elim H8; Intros; Apply H12; Split. -Unfold D_x no_cond; Split. -Trivial. -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. -Elim n0; Left; Assumption. -Elim n; Right; Assumption. -Apply Rlt_anti_compatibility with ``-a``; Do 2 Rewrite (Rplus_sym ``-a``); Rewrite H4 in H9; Apply Rle_lt_trans with ``(Rabsolu (x1-a))``. -Apply Rle_Rabsolu. -Apply Rlt_le_trans with ``(Rmin x0 (b-a))``. -Assumption. -Apply Rmin_r. -Case (total_order x b); Intro. -Assert H6 : ``a<=x<=b``. -Split; Left; Assumption. -Assert H7 := (H0 ? H6); Unfold continuity_pt in H7; Unfold continue_in in H7; Unfold limit1_in in H7; Unfold limit_in in H7; Simpl in H7; Unfold R_dist in H7; Unfold continuity_pt; 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``. -Apply Rlt_Rminus; Assumption. -Assert H12 : ``0<b-x``. -Apply Rlt_Rminus; Assumption. -Exists (Rmin x0 (Rmin ``x-a`` ``b-x``)); Split. -Unfold Rmin; Case (total_order_Rle ``x-a`` ``b-x``); Intro. -Case (total_order_Rle x0 ``x-a``); Intro. -Assumption. -Assumption. -Case (total_order_Rle x0 ``b-x``); Intro. -Assumption. -Assumption. -Intros; Elim H13; Clear H13; Intros; Cut ``a<x1<b``. -Intro; Elim H15; Clear H15; Intros; Unfold h; Case (total_order_Rle x a); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)). -Case (total_order_Rle x b); Intro. -Case (total_order_Rle x1 a); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H15)). -Case (total_order_Rle x1 b); Intro. -Apply H10; Split. -Assumption. -Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``. -Assumption. -Apply Rmin_l. -Elim n1; Left; Assumption. -Elim n0; Left; Assumption. -Split. -Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x1-x))``. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu. -Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``. -Assumption. -Apply Rle_trans with ``(Rmin (x-a) (b-x))``. -Apply Rmin_r. -Apply Rmin_l. -Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x1-x))``. -Apply Rle_Rabsolu. -Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``. -Assumption. -Apply Rle_trans with ``(Rmin (x-a) (b-x))``; Apply Rmin_r. -Elim H5; Intro. -Assert H7 : ``a<=b<=b``. -Split; [Left; Assumption | Right; Reflexivity]. -Assert H8 := (H0 ? H7); Unfold continuity_pt in H8; Unfold continue_in in H8; Unfold limit1_in in H8; Unfold limit_in in H8; Simpl in H8; Unfold R_dist in H8; Unfold continuity_pt; 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; Case (total_order_Rle x0 ``b-a``); Intro. -Elim H10; Intros; Assumption. -Change ``0<b-a``; Apply Rlt_Rminus; Assumption. -Intros; Elim H11; Clear H11; Intros _ H11; Cut ``a<x1``. -Intro; Unfold h; Case (total_order_Rle x a); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)). -Case (total_order_Rle x1 a); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H12)). -Case (total_order_Rle x b); Intro. -Case (total_order_Rle x1 b); Intro. -Rewrite H6; Elim H10; Intros; Elim r0; Intro. -Apply H14; Split. -Unfold D_x no_cond; Split. -Trivial. -Red; Intro; Rewrite <- H16 in H15; Elim (Rlt_antirefl ? H15). -Rewrite H6 in H11; Apply Rlt_le_trans with ``(Rmin x0 (b-a))``. -Apply H11. -Apply Rmin_l. -Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Elim n1; Right; Assumption. -Rewrite H6 in H11; Apply Ropp_Rlt; Apply Rlt_anti_compatibility with b; Apply Rle_lt_trans with ``(Rabsolu (x1-b))``. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu. -Apply Rlt_le_trans with ``(Rmin x0 (b-a))``. -Assumption. -Apply Rmin_r. -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``; Apply Rlt_Rminus; Assumption. -Intros; Elim H8; Clear H8; Intros. -Assert H10 : ``b<x0``. -Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x0-x))``. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu. -Assumption. -Unfold h; Case (total_order_Rle x a); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)). -Case (total_order_Rle x b); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H6)). -Case (total_order_Rle x0 a); Intro. -Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H1 (Rlt_le_trans ? ? ? H10 r))). -Case (total_order_Rle x0 b); Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)). -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Intros; Elim H3; Intros; Unfold h; Case (total_order_Rle c a); Intro. -Elim r; Intro. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 H6)). -Rewrite H6; Reflexivity. -Case (total_order_Rle c b); Intro. -Reflexivity. -Elim n0; Assumption. -Exists [_:R](f0 a); Split. -Apply derivable_continuous; Apply (derivable_const (f0 a)). -Intros; Elim H2; Intros; Rewrite H1 in H3; Cut b==c. -Intro; Rewrite <- H5; Rewrite H1; Reflexivity. -Apply Rle_antisym; Assumption. +Lemma prolongement_C0 : + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + exists g : R -> R + | continuity g /\ (forall c:R, a <= c <= b -> g c = f c). +intros; elim H; intro. +pose + (h := + fun x:R => + match Rle_dec x a with + | left _ => f0 a + | right _ => + match Rle_dec x b with + | left _ => f0 x + | right _ => f0 b + end + end). +assert (H2 : 0 < b - a). +apply Rlt_Rminus; assumption. +exists h; split. +unfold continuity in |- *; intro; case (Rtotal_order x a); intro. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); + split. +change (0 < a - x) in |- *; apply Rlt_Rminus; assumption. +intros; elim H5; clear H5; intros _ H5; unfold h in |- *. +case (Rle_dec x a); intro. +case (Rle_dec x0 a); intro. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +elim n; left; apply Rplus_lt_reg_r with (- x); + do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)). +apply RRle_abs. +assumption. +elim n; left; assumption. +elim H3; intro. +assert (H5 : a <= a <= b). +split; [ right; reflexivity | left; assumption ]. +assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6; + unfold limit1_in in H6; unfold limit_in in H6; simpl in H6; + unfold R_dist in H6; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); + split. +unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. +elim H8; intros; assumption. +change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. +intros; elim H9; clear H9; intros _ H9; cut (x1 < b). +intro; unfold h in |- *; case (Rle_dec x a); intro. +case (Rle_dec x1 a); intro. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +case (Rle_dec x1 b); intro. +elim H8; intros; apply H12; split. +unfold D_x, no_cond in |- *; split. +trivial. +red in |- *; intro; elim n; right; symmetry in |- *; assumption. +apply Rlt_le_trans with (Rmin x0 (b - a)). +rewrite H4 in H9; apply H9. +apply Rmin_l. +elim n0; left; assumption. +elim n; right; assumption. +apply Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a)); + rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)). +apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (b - a)). +assumption. +apply Rmin_r. +case (Rtotal_order x b); intro. +assert (H6 : a <= x <= b). +split; left; assumption. +assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7; + unfold limit1_in in H7; unfold limit_in in H7; simpl in H7; + unfold R_dist in H7; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H7 _ H8); intros; elim H9; clear H9; + intros. +assert (H11 : 0 < x - a). +apply Rlt_Rminus; assumption. +assert (H12 : 0 < b - x). +apply Rlt_Rminus; assumption. +exists (Rmin x0 (Rmin (x - a) (b - x))); split. +unfold Rmin in |- *; case (Rle_dec (x - a) (b - x)); intro. +case (Rle_dec x0 (x - a)); intro. +assumption. +assumption. +case (Rle_dec x0 (b - x)); intro. +assumption. +assumption. +intros; elim H13; clear H13; intros; cut (a < x1 < b). +intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a); + intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). +case (Rle_dec x b); intro. +case (Rle_dec x1 a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)). +case (Rle_dec x1 b); intro. +apply H10; split. +assumption. +apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). +assumption. +apply Rmin_l. +elim n1; left; assumption. +elim n0; left; assumption. +split. +apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; + apply Rle_lt_trans with (Rabs (x1 - x)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). +assumption. +apply Rle_trans with (Rmin (x - a) (b - x)). +apply Rmin_r. +apply Rmin_l. +apply Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x)); + apply Rle_lt_trans with (Rabs (x1 - x)). +apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). +assumption. +apply Rle_trans with (Rmin (x - a) (b - x)); apply Rmin_r. +elim H5; intro. +assert (H7 : a <= b <= b). +split; [ left; assumption | right; reflexivity ]. +assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8; + unfold limit1_in in H8; unfold limit_in in H8; simpl in H8; + unfold R_dist in H8; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); + split. +unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. +elim H10; intros; assumption. +change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. +intros; elim H11; clear H11; intros _ H11; cut (a < x1). +intro; unfold h in |- *; case (Rle_dec x a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). +case (Rle_dec x1 a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)). +case (Rle_dec x b); intro. +case (Rle_dec x1 b); intro. +rewrite H6; elim H10; intros; elim r0; intro. +apply H14; split. +unfold D_x, no_cond in |- *; split. +trivial. +red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15). +rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)). +apply H11. +apply Rmin_l. +rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. +elim n1; right; assumption. +rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b; + apply Rle_lt_trans with (Rabs (x1 - b)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +apply Rlt_le_trans with (Rmin x0 (b - a)). +assumption. +apply Rmin_r. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); + split. +change (0 < x - b) in |- *; apply Rlt_Rminus; assumption. +intros; elim H8; clear H8; intros. +assert (H10 : b < x0). +apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; + apply Rle_lt_trans with (Rabs (x0 - x)). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. +assumption. +unfold h in |- *; case (Rle_dec x a); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). +case (Rle_dec x b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)). +case (Rle_dec x0 a); intro. +elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))). +case (Rle_dec x0 b); intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)). +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro. +elim r; intro. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)). +rewrite H6; reflexivity. +case (Rle_dec c b); intro. +reflexivity. +elim n0; assumption. +exists (fun _:R => f0 a); split. +apply derivable_continuous; apply (derivable_const (f0 a)). +intros; elim H2; intros; rewrite H1 in H3; cut (b = c). +intro; rewrite <- H5; rewrite H1; reflexivity. +apply Rle_antisym; assumption. Qed. (**********) -Lemma continuity_ab_maj : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT Mx : R | ((c:R)``a<=c<=b``->``(f c)<=(f Mx)``)/\``a<=Mx<=b``). -Intros; Cut (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f0 c))). -Intro HypProl. -Elim HypProl; Intros g Hcont_eq. -Elim Hcont_eq; Clear Hcont_eq; Intros Hcont Heq. -Assert H1 := (compact_P3 a b). -Assert H2 := (continuity_compact g [c:R]``a<=c<=b`` Hcont H1). -Assert H3 := (compact_P2 ? H2). -Assert H4 := (compact_P1 ? H2). -Cut (bound (image_dir g [c:R]``a <= c <= b``)). -Cut (ExT [x:R] ((image_dir g [c:R]``a <= c <= b``) x)). -Intros; Assert H7 := (complet ? H6 H5). -Elim H7; Clear H7; Intros M H7; Cut (image_dir g [c:R]``a <= c <= b`` M). -Intro; Unfold image_dir in H8; Elim H8; Clear H8; Intros Mxx H8; Elim H8; Clear H8; Intros; Exists Mxx; Split. -Intros; Rewrite <- (Heq c H10); Rewrite <- (Heq Mxx H9); Intros; Rewrite <- H8; Unfold is_lub in H7; Elim H7; Clear H7; Intros H7 _; Unfold is_upper_bound in H7; Apply H7; Unfold image_dir; Exists c; Split; [Reflexivity | Apply H10]. -Apply H9. -Elim (classic (image_dir g [c:R]``a <= c <= b`` M)); Intro. -Assumption. -Cut (EXT eps:posreal | (y:R)~(intersection_domain (disc M eps) (image_dir g [c:R]``a <= c <= b``) y)). -Intro; Elim H9; Clear H9; Intros eps H9; Unfold is_lub in H7; Elim H7; Clear H7; Intros; Cut (is_upper_bound (image_dir g [c:R]``a <= c <= b``) ``M-eps``). -Intro; Assert H12 := (H10 ? H11); Cut ``M-eps<M``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H12 H13)). -Pattern 2 M; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_O; Rewrite Ropp_Ropp; Apply (cond_pos eps). -Unfold is_upper_bound image_dir; Intros; Cut ``x<=M``. -Intro; Case (total_order_Rle x ``M-eps``); Intro. -Apply r. -Elim (H9 x); Unfold intersection_domain disc image_dir; Split. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right. -Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(M-x)`` with ``M-eps``. -Replace ``x-eps+eps`` with x. -Auto with real. -Ring. -Ring. -Apply Rge_minus; Apply Rle_sym1; Apply H12. -Apply H11. -Apply H7; Apply H11. -Cut (EXT V:R->Prop | (neighbourhood V M)/\((y:R)~(intersection_domain V (image_dir g [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; Intro; Elim (H11 y). -Unfold intersection_domain; Unfold intersection_domain in H13; Elim H13; Clear H13; Intros; Split. -Apply (H12 ? H13). -Apply H14. -Cut ~(point_adherent (image_dir g [c:R]``a <= c <= b``) M). -Intro; Unfold point_adherent in H9. -Assert H10 := (not_all_ex_not ? [V:R->Prop](neighbourhood V M) - ->(EXT y:R | - (intersection_domain V - (image_dir g [c:R]``a <= c <= b``) y)) H9). -Elim H10; Intros V0 H11; Exists V0; Assert H12 := (imply_to_and ? ? H11); Elim H12; Clear H12; Intros. -Split. -Apply H12. -Apply (not_ex_all_not ? ? H13). -Red; Intro; Cut (adherence (image_dir g [c:R]``a <= c <= b``) M). -Intro; Elim (closed_set_P1 (image_dir g [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; Exists a; Split. -Reflexivity. -Split; [Right; Reflexivity | Apply H]. -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. +Lemma continuity_ab_maj : + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + exists Mx : R | (forall c:R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b. +intros; + cut + ( exists g : R -> R + | continuity g /\ (forall c:R, a <= c <= b -> g c = f0 c)). +intro HypProl. +elim HypProl; intros g Hcont_eq. +elim Hcont_eq; clear Hcont_eq; intros Hcont Heq. +assert (H1 := compact_P3 a b). +assert (H2 := continuity_compact g (fun c:R => a <= c <= b) Hcont H1). +assert (H3 := compact_P2 _ H2). +assert (H4 := compact_P1 _ H2). +cut (bound (image_dir g (fun c:R => a <= c <= b))). +cut ( exists x : R | image_dir g (fun c:R => a <= c <= b) x). +intros; assert (H7 := completeness _ H6 H5). +elim H7; clear H7; intros M H7; cut (image_dir g (fun c:R => a <= c <= b) M). +intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8; + clear H8; intros; exists Mxx; split. +intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros; + rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; + intros H7 _; unfold is_upper_bound in H7; apply H7; + unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ]. +apply H9. +elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. +assumption. +cut + ( exists eps : posreal + | (forall y:R, + ~ + intersection_domain (disc M eps) + (image_dir g (fun c:R => a <= c <= b)) y)). +intro; elim H9; clear H9; intros eps H9; unfold is_lub in H7; elim H7; + clear H7; intros; + cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)). +intro; assert (H12 := H10 _ H11); cut (M - eps < M). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)). +pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; + apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0; + rewrite Ropp_involutive; apply (cond_pos eps). +unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M). +intro; case (Rle_dec x (M - eps)); intro. +apply r. +elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. +apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (M - x)) with (M - eps). +replace (x - eps + eps) with x. +auto with real. +ring. +ring. +apply Rge_minus; apply Rle_ge; apply H12. +apply H11. +apply H7; apply H11. +cut + ( exists V : R -> Prop + | neighbourhood V M /\ + (forall y:R, + ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)). +intro; elim H9; intros V H10; elim H10; clear H10; intros. +unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros; + red in |- *; intro; elim (H11 y). +unfold intersection_domain in |- *; unfold intersection_domain in H13; + elim H13; clear H13; intros; split. +apply (H12 _ H13). +apply H14. +cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M). +intro; unfold point_adherent in H9. +assert + (H10 := + not_all_ex_not _ + (fun V:R -> Prop => + neighbourhood V M -> + exists y : R + | intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y) H9). +elim H10; intros V0 H11; exists V0; assert (H12 := imply_to_and _ _ H11); + elim H12; clear H12; intros. +split. +apply H12. +apply (not_ex_all_not _ _ H13). +red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M). +intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b))); + intros H11 _; assert (H12 := H11 H3). +elim H8. +unfold eq_Dom in H12; elim H12; clear H12; intros. +apply (H13 _ H10). +apply H9. +exists (g a); unfold image_dir in |- *; exists a; split. +reflexivity. +split; [ right; reflexivity | apply H ]. +unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4; + elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *; + intros; elim (H4 _ H5); intros _ H6; apply H6. +apply prolongement_C0; assumption. Qed. (**********) -Lemma continuity_ab_min : (f:(R->R); a,b:R) ``a <= b``->((c:R)``a<=c<=b``->(continuity_pt f c))->(EXT mx:R | ((c:R)``a <= c <= b``->``(f mx) <= (f c)``)/\``a <= mx <= b``). -Intros. -Cut ((c:R)``a<=c<=b``->(continuity_pt (opp_fct f0) c)). -Intro; Assert H2 := (continuity_ab_maj (opp_fct f0) a b H H1); Elim H2; Intros x0 H3; Exists x0; Intros; Split. -Intros; Rewrite <- (Ropp_Ropp (f0 x0)); Rewrite <- (Ropp_Ropp (f0 c)); Apply Rle_Ropp1; Elim H3; Intros; Unfold opp_fct in H5; Apply H5; Apply H4. -Elim H3; Intros; Assumption. -Intros. -Assert H2 := (H0 ? H1). -Apply (continuity_pt_opp ? ? H2). +Lemma continuity_ab_min : + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + exists mx : R | (forall c:R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b. +intros. +cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c). +intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2; + intros x0 H3; exists x0; intros; split. +intros; rewrite <- (Ropp_involutive (f0 x0)); + rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; + elim H3; intros; unfold opp_fct in H5; apply H5; apply H4. +elim H3; intros; assumption. +intros. +assert (H2 := H0 _ H1). +apply (continuity_pt_opp _ _ H2). Qed. @@ -888,291 +1272,554 @@ Qed. (* Proof of Bolzano-Weierstrass theorem *) (********************************************************) -Definition ValAdh [un:nat->R;x:R] : Prop := (V:R->Prop;N:nat) (neighbourhood V x) -> (EX p:nat | (le N p)/\(V (un p))). - -Definition intersection_family [f:family] : R->Prop := [x:R](y:R)(ind f y)->(f y x). - -Lemma ValAdh_un_exists : (un:nat->R) let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in ((x:R)(EXT y:R | (f x y))->(D x)). -Intros; Elim H; Intros; Unfold f in H0; Unfold adherence in H0; Unfold point_adherent in H0; Assert H1 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0). -Unfold neighbourhood disc; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial. -Elim (H0 ? H1); Intros; Unfold intersection_domain in H2; Elim H2; Intros; Elim H4; Intros; Apply H6. +Definition ValAdh (un:nat -> R) (x:R) : Prop := + forall (V:R -> Prop) (N:nat), + neighbourhood V x -> exists p : nat | (N <= p)%nat /\ V (un p). + +Definition intersection_family (f:family) (x:R) : Prop := + forall y:R, ind f y -> f y x. + +Lemma ValAdh_un_exists : + forall (un:nat -> R) (D:=fun x:R => exists n : nat | x = INR n) + (f:= + fun x:R => + adherence + (fun y:R => ( exists p : nat | y = un p /\ x <= INR p) /\ D x)) + (x:R), ( exists y : R | f x y) -> D x. +intros; elim H; intros; unfold f in H0; unfold adherence in H0; + unfold point_adherent in H0; + assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). +unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1); + unfold included in |- *; trivial. +elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros; + elim H4; intros; apply H6. Qed. -Definition ValAdh_un [un:nat->R] : R->Prop := let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in (intersection_family (mkfamily D f (ValAdh_un_exists un))). - -Lemma ValAdh_un_prop : (un:nat->R;x:R) (ValAdh un x) <-> (ValAdh_un un x). -Intros; Split; Intro. -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; Intros; Unfold ValAdh_un in H; Unfold intersection_family in H; Simpl in H; Assert H1 : (adherence [y0:R](EX p:nat | ``y0 == (un p)``/\``(INR N) <= (INR p)``)/\(EX n:nat | ``(INR N) == (INR n)``) x). -Apply H; Exists N; Reflexivity. -Unfold adherence in H1; Unfold point_adherent in H1; Assert H2 := (H1 ? H0); Elim H2; Intros; Unfold intersection_domain in H3; Elim H3; Clear H3; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Exists x1; Split. -Apply (INR_le ? ? H6). -Rewrite H4 in H3; Apply H3. +Definition ValAdh_un (un:nat -> R) : R -> Prop := + let D := fun x:R => exists n : nat | x = INR n in + let f := + fun x:R => + adherence + (fun y:R => ( exists p : nat | y = un p /\ x <= INR p) /\ D x) in + intersection_family (mkfamily D f (ValAdh_un_exists un)). + +Lemma ValAdh_un_prop : + forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x. +intros; split; intro. +unfold ValAdh in H; unfold ValAdh_un in |- *; + unfold intersection_family in |- *; simpl in |- *; + intros; elim H0; intros N H1; unfold adherence in |- *; + unfold point_adherent in |- *; intros; elim (H V N H2); + intros; exists (un x0); unfold intersection_domain in |- *; + elim H3; clear H3; intros; split. +assumption. +split. +exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ]. +exists N; assumption. +unfold ValAdh in |- *; intros; unfold ValAdh_un in H; + unfold intersection_family in H; simpl in H; + assert + (H1 : + adherence + (fun y0:R => + ( exists p : nat | y0 = un p /\ INR N <= INR p) /\ + ( exists n : nat | INR N = INR n)) x). +apply H; exists N; reflexivity. +unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0); + elim H2; intros; unfold intersection_domain in H3; + elim H3; clear H3; intros; elim H4; clear H4; intros; + elim H4; clear H4; intros; elim H4; clear H4; intros; + exists x1; split. +apply (INR_le _ _ H6). +rewrite H4 in H3; apply H3. Qed. -Lemma adherence_P4 : (F,G:R->Prop) (included F G) -> (included (adherence F) (adherence G)). -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)]. +Lemma adherence_P4 : + forall F G:R -> Prop, included F G -> included (adherence F) (adherence G). +unfold adherence, included in |- *; unfold point_adherent in |- *; intros; + elim (H0 _ H1); unfold intersection_domain in |- *; + intros; elim H2; clear H2; intros; exists x0; split; + [ assumption | apply (H _ H3) ]. Qed. -Definition family_closed_set [f:family] : Prop := (x:R) (closed_set (f x)). +Definition family_closed_set (f:family) : Prop := + forall x:R, closed_set (f x). -Definition intersection_vide_in [D:R->Prop;f:family] : Prop := ((x:R)((ind f x)->(included (f x) D))/\~(EXT y:R | (intersection_family f y))). +Definition intersection_vide_in (D:R -> Prop) (f:family) : Prop := + forall x:R, + (ind f x -> included (f x) D) /\ + ~ ( exists y : R | intersection_family f y). -Definition intersection_vide_finite_in [D:R->Prop;f:family] : Prop := (intersection_vide_in D f)/\(family_finite f). +Definition intersection_vide_finite_in (D:R -> Prop) + (f:family) : Prop := intersection_vide_in D f /\ family_finite f. (**********) -Lemma compact_P6 : (X:R->Prop) (compact X) -> (EXT z:R | (X z)) -> ((g:family) (family_closed_set g) -> (intersection_vide_in X g) -> (EXT D:R->Prop | (intersection_vide_finite_in X (subfamily g D)))). -Intros X H Hyp g H0 H1. -Pose D' := (ind g). -Pose f' := [x:R][y:R](complementary (g x) y)/\(D' x). -Assert H2 : (x:R)(EXT y:R|(f' x y))->(D' x). -Intros; Elim H2; Intros; Unfold f' in H3; Elim H3; Intros; Assumption. -Pose f0 := (mkfamily D' f' H2). -Unfold compact in H; Assert H3 : (covering_open_set X f0). -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 ? [y:R](y0:R)(ind g y0)->(g y0 y) H5 x); Assert H7 := (not_all_ex_not ? [y0:R](ind g y0)->(g y0 x) H6); Elim H7; Intros; Exists x0; Elim (imply_to_and ? ? H8); Intros; Unfold f0; Simpl; Unfold f'; Split; [Apply H10 | Apply H9]. -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; Simpl; Unfold f'; Unfold eq_Dom; Split. -Unfold included; Intros; Split; [Apply H4 | Apply H3]. -Unfold included; Intros; Elim H4; Intros; Assumption. -Apply open_set_P6 with [_:R]False. -Apply open_set_P4. -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; 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 (EXT y:R | (intersection_domain (ind g) SF y))); Intro Hyp'. -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 _; Unfold covering in H4; Elim (H4 x0 H7); Intros; Simpl in H8; Unfold intersection_domain in H6; Cut (ind g x1)/\(SF x1). -Intro; Assert H10 := (H6 x1 H9); Elim H10; Clear H10; Intros H10 _; Elim H8; Clear H8; Intros H8 _; Unfold f' in H8; Unfold complementary in H8; Elim H8; Clear H8; Intros H8 _; Elim H8; Assumption. -Split. -Apply (cond_fam f0). -Exists x0; Elim H8; Intros; Assumption. -Elim H8; Intros; Assumption. -Unfold intersection_vide_in in H1; Elim Hyp'; Intros; Assert H8 := (H6 ? H7); Elim H8; Intros; Cut (ind g x1). -Intro; Elim (H1 x1); Intros; Apply H12. -Apply H11. -Apply H9. -Apply (cond_fam g); Exists x0; Assumption. -Unfold covering_finite in H4; Elim H4; Clear H4; Intros H4 _; Cut (EXT 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; 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; Unfold domain_finite; Elim H5; Clear H5; Intros l H5; Exists l; Intro; Elim (H5 x); Intros; Split; Intro; [Apply H6; Simpl; Simpl in H8; Apply H8 | Apply (H7 H8)]. +Lemma compact_P6 : + forall X:R -> Prop, + compact X -> + ( exists z : R | X z) -> + forall g:family, + family_closed_set g -> + intersection_vide_in X g -> + exists D : R -> Prop | intersection_vide_finite_in X (subfamily g D). +intros X H Hyp g H0 H1. +pose (D' := ind g). +pose (f' := fun x y:R => complementary (g x) y /\ D' x). +assert (H2 : forall x:R, ( exists y : R | f' x y) -> D' x). +intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption. +pose (f0 := mkfamily D' f' H2). +unfold compact in H; assert (H3 : covering_open_set X f0). +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; unfold intersection_vide_in in H1; + elim (H1 x); intros; unfold intersection_family in H5; + assert + (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x); + assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); + elim H7; intros; exists x0; elim (imply_to_and _ _ H8); + intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; + split; [ apply H10 | apply H9 ]. +unfold family_open_set in |- *; intro; elim (classic (D' x)); intro. +apply open_set_P6 with (complementary (g x)). +unfold family_closed_set in H0; unfold closed_set in H0; apply H0. +unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *; + split. +unfold included in |- *; intros; split; [ apply H4 | apply H3 ]. +unfold included in |- *; intros; elim H4; intros; assumption. +apply open_set_P6 with (fun _:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; unfold included in |- *; split; intros; + [ elim H4 + | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ]. +elim (H _ H3); intros SF H4; exists SF; + unfold intersection_vide_finite_in in |- *; split. +unfold intersection_vide_in in |- *; simpl in |- *; intros; split. +intros; unfold included in |- *; intros; unfold intersection_vide_in in H1; + elim (H1 x); intros; elim H6; intros; apply H7. +unfold intersection_domain in H5; elim H5; intros; assumption. +assumption. +elim (classic ( exists y : R | intersection_domain (ind g) SF y)); intro Hyp'. +red in |- *; intro; elim H5; intros; unfold intersection_family in H6; + simpl in H6. +cut (X x0). +intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _; + unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8; + unfold intersection_domain in H6; cut (ind g x1 /\ SF x1). +intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8; + clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; + elim H8; clear H8; intros H8 _; elim H8; assumption. +split. +apply (cond_fam f0). +exists x0; elim H8; intros; assumption. +elim H8; intros; assumption. +unfold intersection_vide_in in H1; elim Hyp'; intros; assert (H8 := H6 _ H7); + elim H8; intros; cut (ind g x1). +intro; elim (H1 x1); intros; apply H12. +apply H11. +apply H9. +apply (cond_fam g); exists x0; assumption. +unfold covering_finite in H4; elim H4; clear H4; intros H4 _; + cut ( exists z : R | X z). +intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5); + intros; simpl in H6; elim Hyp'; exists x1; elim H6; + intros; unfold intersection_domain in |- *; split. +apply (cond_fam f0); exists x0; apply H7. +apply H8. +apply Hyp. +unfold covering_finite in H4; elim H4; clear H4; intros; + unfold family_finite in H5; unfold domain_finite in H5; + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); + intros; split; intro; + [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ]. Qed. -Theorem Bolzano_Weierstrass : (un:nat->R;X:R->Prop) (compact X) -> ((n:nat)(X (un n))) -> (EXT l:R | (ValAdh un l)). -Intros; Cut (EXT l:R | (ValAdh_un un l)). -Intro; Elim H1; Intros; Exists x; Elim (ValAdh_un_prop un x); Intros; Apply (H4 H2). -Assert H1 : (EXT z:R | (X z)). -Exists (un O); Apply H0. -Pose D:=[x:R](EX n:nat | x==(INR n)). -Pose g:=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)). -Assert H2 : (x:R)(EXT y:R | (g x y))->(D x). -Intros; Elim H2; Intros; Unfold g in H3; Unfold adherence in H3; Unfold point_adherent in H3. -Assert H4 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0). -Unfold neighbourhood; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial. -Elim (H3 ? H4); Intros; Unfold intersection_domain in H5; Decompose [and] H5; Assumption. -Pose f0 := (mkfamily D g H2). -Assert H3 := (compact_P6 X H H1 f0). -Elim (classic (EXT l:R | (ValAdh_un un l))); Intro. -Assumption. -Cut (family_closed_set f0). -Intro; Cut (intersection_vide_in X f0). -Intro; Assert H7 := (H3 H5 H6). -Elim H7; Intros SF H8; Unfold intersection_vide_finite_in in H8; Elim H8; Clear H8; Intros; Unfold intersection_vide_in in H8; Elim (H8 R0); Intros _ H10; Elim H10; Unfold family_finite in H9; Unfold domain_finite in H9; Elim H9; Clear H9; Intros l H9; Pose r := (MaxRlist l); Cut (D r). -Intro; Unfold D in H11; Elim H11; Intros; Exists (un x); Unfold intersection_family; Simpl; Unfold intersection_domain; Intros; Split. -Unfold g; Apply adherence_P1; Split. -Exists x; Split; [Reflexivity | 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; Apply MaxRlist_P2; Cut (EXT z:R | (intersection_domain (ind f0) SF z)). -Intro; Elim H13; Intros; Elim (H9 x); Intros; Simpl in H15; Assert H17 := (H15 H14); Exists x; Apply H17. -Elim (classic (EXT z:R | (intersection_domain (ind f0) SF z))); Intro. -Assumption. -Elim (H8 R0); Intros _ H14; Elim H1; Intros; Assert H16 := (not_ex_all_not ? [y:R](intersection_family (subfamily f0 SF) y) H14); Assert H17 := (not_ex_all_not ? [z:R](intersection_domain (ind f0) SF z) H13); Assert H18 := (H16 x); Unfold intersection_family in H18; Simpl in H18; Assert H19 := (not_all_ex_not ? [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; Intros; Split. -Intro; Simpl in H6; Unfold f0; Simpl; Unfold g; Apply included_trans with (adherence X). -Apply adherence_P4. -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; Unfold f0; Simpl; Unfold g; Intro; Apply adherence_P3. +Theorem Bolzano_Weierstrass : + forall (un:nat -> R) (X:R -> Prop), + compact X -> (forall n:nat, X (un n)) -> exists l : R | ValAdh un l. +intros; cut ( exists l : R | ValAdh_un un l). +intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros; + apply (H4 H2). +assert (H1 : exists z : R | X z). +exists (un 0%nat); apply H0. +pose (D := fun x:R => exists n : nat | x = INR n). +pose + (g := + fun x:R => + adherence (fun y:R => ( exists p : nat | y = un p /\ x <= INR p) /\ D x)). +assert (H2 : forall x:R, ( exists y : R | g x y) -> D x). +intros; elim H2; intros; unfold g in H3; unfold adherence in H3; + unfold point_adherent in H3. +assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). +unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1); + unfold included in |- *; trivial. +elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5; + assumption. +pose (f0 := mkfamily D g H2). +assert (H3 := compact_P6 X H H1 f0). +elim (classic ( exists l : R | ValAdh_un un l)); intro. +assumption. +cut (family_closed_set f0). +intro; cut (intersection_vide_in X f0). +intro; assert (H7 := H3 H5 H6). +elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8; + clear H8; intros; unfold intersection_vide_in in H8; + elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9; + unfold domain_finite in H9; elim H9; clear H9; intros l H9; + pose (r := MaxRlist l); cut (D r). +intro; unfold D in H11; elim H11; intros; exists (un x); + unfold intersection_family in |- *; simpl in |- *; + unfold intersection_domain in |- *; intros; split. +unfold g in |- *; apply adherence_P1; split. +exists x; split; + [ reflexivity + | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros; + apply H14; simpl in |- *; apply H13 ]. +elim H13; intros; assumption. +elim H13; intros; assumption. +elim (H9 r); intros. +simpl in H12; unfold intersection_domain in H12; cut (In r l). +intro; elim (H12 H13); intros; assumption. +unfold r in |- *; apply MaxRlist_P2; + cut ( exists z : R | intersection_domain (ind f0) SF z). +intro; elim H13; intros; elim (H9 x); intros; simpl in H15; + assert (H17 := H15 H14); exists x; apply H17. +elim (classic ( exists z : R | intersection_domain (ind f0) SF z)); intro. +assumption. +elim (H8 0); intros _ H14; elim H1; intros; + assert + (H16 := + not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14); + assert + (H17 := + not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13); + assert (H18 := H16 x); unfold intersection_family in H18; + simpl in H18; + assert + (H19 := + not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y) + H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20); + elim (H17 x0); elim H21; intros; assumption. +unfold intersection_vide_in in |- *; intros; split. +intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *; + apply included_trans with (adherence X). +apply adherence_P4. +unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10; + intros; rewrite H11; apply H0. +apply adherence_P2; apply compact_P2; assumption. +apply H4. +unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *; + unfold g in |- *; intro; apply adherence_P3. Qed. (********************************************************) (* Proof of Heine's theorem *) (********************************************************) -Definition uniform_continuity [f:R->R;X:R->Prop] : Prop := (eps:posreal)(EXT delta:posreal | (x,y:R) (X x)->(X y)->``(Rabsolu (x-y))<delta`` ->``(Rabsolu ((f x)-(f y)))<eps``). +Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop := + forall eps:posreal, + exists delta : posreal + | (forall x y:R, + X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). -Lemma is_lub_u : (E:R->Prop;x,y:R) (is_lub E x) -> (is_lub E y) -> x==y. -Unfold is_lub; Intros; Elim H; Elim H0; Intros; Apply Rle_antisym; [Apply (H4 ? H1) | Apply (H2 ? H3)]. +Lemma is_lub_u : + forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y. +unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym; + [ apply (H4 _ H1) | apply (H2 _ H3) ]. Qed. -Lemma domain_P1 : (X:R->Prop) ~(EXT y:R | (X y))\/(EXT y:R | (X y)/\((x:R)(X x)->x==y))\/(EXT x:R | (EXT y:R | (X x)/\(X y)/\``x<>y``)). -Intro; Elim (classic (EXT y:R | (X y))); Intro. -Right; Elim H; Intros; Elim (classic (EXT y:R | (X y)/\``y<>x``)); Intro. -Right; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Intros. -Split; [Assumption | Split; [Assumption | Apply not_sym; Assumption]]. -Left; Exists x; Split. -Assumption. -Intros; Case (Req_EM x0 x); Intro. -Assumption. -Elim H1; Exists x0; Split; Assumption. -Left; Assumption. +Lemma domain_P1 : + forall X:R -> Prop, + ~ ( exists y : R | X y) \/ + ( exists y : R | X y /\ (forall x:R, X x -> x = y)) \/ + ( exists x : R | ( exists y : R | X x /\ X y /\ x <> y)). +intro; elim (classic ( exists y : R | X y)); intro. +right; elim H; intros; elim (classic ( exists y : R | X y /\ y <> x)); intro. +right; elim H1; intros; elim H2; intros; exists x; exists x0; intros. +split; + [ assumption + | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ]. +left; exists x; split. +assumption. +intros; case (Req_dec x0 x); intro. +assumption. +elim H1; exists x0; split; assumption. +left; assumption. Qed. -Theorem Heine : (f:R->R;X:R->Prop) (compact X) -> ((x:R)(X x)->(continuity_pt f x)) -> (uniform_continuity f X). -Intros f0 X H0 H; Elim (domain_P1 X); Intro Hyp. +Theorem Heine : + forall (f:R -> R) (X:R -> Prop), + compact X -> + (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X. +intros f0 X H0 H; elim (domain_P1 X); intro Hyp. (* X est vide *) -Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); Intros; Elim Hyp; Exists x; Assumption. -Elim Hyp; Clear Hyp; Intro Hyp. +unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + intros; elim Hyp; exists x; assumption. +elim Hyp; clear Hyp; intro Hyp. (* X possède un seul élément *) -Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); 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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps). +unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; + intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); + rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply (cond_pos eps). (* X possède au moins deux éléments distincts *) -Assert X_enc : (EXT m:R | (EXT M:R | ((x:R)(X x)->``m<=x<=M``)/\``m<M``)). -Assert H1 := (compact_P1 X H0); Unfold bounded in H1; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Split. -Apply H3. -Elim Hyp; Intros; Elim H4; Intros; Decompose [and] H5; Assert H10 := (H3 ? H6); Assert H11 := (H3 ? H8); Elim H10; Intros; Elim H11; Intros; Case (total_order_T x x0); Intro. -Elim s; Intro. -Assumption. -Rewrite b in H13; Rewrite b in H7; Elim H9; Apply Rle_antisym; Apply Rle_trans with x0; Assumption. -Elim (Rlt_antirefl ? (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; Intro; Assert H1 : (t:posreal)``0<t/2``. -Intro; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos t) | Apply Rlt_Rinv; Sup0]. -Pose g := [x:R][y:R](X x)/\(EXT del:posreal | ((z:R) ``(Rabsolu (z-x))<del``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``)/\(is_lub [zeta:R]``0<zeta<=M-m``/\((z:R) ``(Rabsolu (z-x))<zeta``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``) del)/\(disc x (mkposreal ``del/2`` (H1 del)) y)). -Assert H2 : (x:R)(EXT y:R | (g x y))->(X x). -Intros; Elim H2; Intros; Unfold g in H3; Elim H3; Clear H3; Intros H3 _; Apply H3. -Pose f' := (mkfamily X g H2); Unfold compact in H0; Assert H3 : (covering_open_set X f'). -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; Unfold limit1_in in H4; Unfold limit_in in H4; Simpl in H4; Unfold R_dist in H4; Elim (H4 ``eps/2`` (H1 eps)); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H6 : (bound E). -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 : (EXT x:R | (E x)). -Elim H5; Clear H5; Intros; Exists (Rmin x0 ``M-m``); Unfold E; Intros; Split. -Split. -Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro. -Apply H5. -Apply Rlt_Rminus; Apply Hyp. -Apply Rmin_r. -Intros; Case (Req_EM x z); Intro. -Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps). -Apply H7; Split. -Unfold D_x no_cond; Split; [Trivial | Assumption]. -Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H8 | Apply Rmin_l]. -Assert H8 := (complet ? H6 H7); Elim H8; Clear H8; Intros; Cut ``0<x1<=(M-m)``. -Intro; Elim H8; Clear H8; Intros; Exists (mkposreal ? H8); Split. -Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x1``/\(E alp)). -Intros; Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15. -Elim H12; Intros; Assumption. -Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x1``/\(E alp))); Intro. -Assumption. -Assert H12 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x1``/\(E alp) H11); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``). -Intro; Assert H16 := (H14 ? H15); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H16)). -Unfold is_upper_bound; Intros; Unfold is_upper_bound in H13; Assert H16 := (H13 ? H15); Case (total_order_Rle x2 ``(Rabsolu (z-x))``); Intro. -Assumption. -Elim (H12 x2); Split; [Split; [Auto with real | Assumption] | Assumption]. -Split. -Apply p. -Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Simpl; Unfold Rdiv; Apply Rmult_lt_pos; [Apply H8 | Apply Rlt_Rinv; Sup0]. -Elim H7; Intros; Unfold E in H8; Elim H8; Intros H9 _; Elim H9; Intros H10 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H12; Unfold is_upper_bound in H11; Split. -Apply Rlt_le_trans with x2; [Assumption | Apply (H11 ? H8)]. -Apply H12; Intros; Unfold E in H13; Elim H13; Intros; Elim H14; Intros; Assumption. -Unfold family_open_set; Intro; Simpl; Elim (classic (X x)); Intro. -Unfold g; Unfold open_set; Intros; Elim H4; Clear H4; Intros _ H4; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Unfold neighbourhood; Case (Req_EM x x0); Intro. -Exists (mkposreal ? (H1 x1)); Rewrite <- H6; Unfold included; Intros; Split. -Assumption. -Exists x1; Split. -Apply H4. -Split. -Elim H5; Intros; Apply H8. -Apply H7. -Pose d := ``x1/2-(Rabsolu (x0-x))``; Assert H7 : ``0<d``. -Unfold d; Apply Rlt_Rminus; Elim H5; Clear H5; Intros; Unfold disc in H7; Apply H7. -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; Simpl; Unfold disc in H10; Simpl in H10; Apply Rle_lt_trans with ``(Rabsolu (x2-x0))+(Rabsolu (x0-x))``. -Replace ``x2-x`` with ``(x2-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring]. -Replace ``x1/2`` with ``d+(Rabsolu (x0-x))``; [Idtac | Unfold d; Ring]. -Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility; Apply H8. -Apply open_set_P6 with [_:R]False. -Apply open_set_P4. -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; Intros; Unfold family_finite in H5; Unfold domain_finite in H5; Unfold covering in H4; Simpl in H4; Simpl in H5; Elim H5; Clear H5; Intros l H5; Unfold intersection_domain in H5; Cut (x:R)(In x l)->(EXT del:R | ``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``)). -Intros; Assert H7 := (Rlist_P1 l [x:R][del:R]``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``) H6); Elim H7; Clear H7; Intros l' H7; Elim H7; Clear H7; Intros; Pose D := (MinRlist l'); Cut ``0<D/2``. -Intro; Exists (mkposreal ? H9); Intros; Assert H13 := (H4 ? H10); Elim H13; Clear H13; Intros xi H13; Assert H14 : (In xi l). -Unfold g in H13; Decompose [and] H13; Elim (H5 xi); Intros; Apply H14; Split; Assumption. -Elim (pos_Rl_P2 l xi); Intros H15 _; Elim (H15 H14); Intros i H16; Elim H16; Intros; Apply Rle_lt_trans with ``(Rabsolu ((f0 x)-(f0 xi)))+(Rabsolu ((f0 xi)-(f0 y)))``. -Replace ``(f0 x)-(f0 y)`` with ``((f0 x)-(f0 xi))+((f0 xi)-(f0 y))``; [Apply Rabsolu_triang | Ring]. -Rewrite (double_var eps); Apply Rplus_lt. -Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Apply H20; Unfold included in H21; Apply Rlt_trans with ``(pos_Rl l' i)/2``. -Apply H21. -Elim H13; Clear H13; Intros; Assumption. -Unfold Rdiv; Apply Rlt_monotony_contra with ``2``. -Sup0. -Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Pattern 1 (pos_Rl l' i); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply H19. -DiscrR. -Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H20; Unfold included in H21; Elim H13; Intros; Assert H24 := (H21 x H22); Apply Rle_lt_trans with ``(Rabsolu (y-x))+(Rabsolu (x-xi))``. -Replace ``y-xi`` with ``(y-x)+(x-xi)``; [Apply Rabsolu_triang | Ring]. -Rewrite (double_var (pos_Rl l' i)); Apply Rplus_lt. -Apply Rlt_le_trans with ``D/2``. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H12. -Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony. -Left; Apply Rlt_Rinv; Sup0. -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; Apply Rmult_lt_pos; [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 | Apply Rlt_Rinv; Sup0]. -Intros; Elim (H5 x); Intros; Elim (H8 H6); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H11 : (bound E). -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 : (EXT 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; Intros; Split. -Split; [Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro; [Apply H12 | Apply Rlt_Rminus; Apply Hyp] | Apply Rmin_r]. -Intros; Case (Req_EM x z); Intro. -Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps). -Apply H14; Split; [Unfold D_x no_cond; Split; [Trivial | Assumption] | Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H15 | Apply Rmin_l]]. -Assert H13 := (complet ? H11 H12); Elim H13; Clear H13; Intros; Cut ``0<x0<=M-m``. -Intro; Elim H13; Clear H13; Intros; Exists x0; Split. -Assumption. -Split. -Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x0``/\(E alp)). -Intros; Elim H16; Intros; Elim H17; Clear H17; Intros; Unfold E in H18; Elim H18; Intros; Apply H20; Elim H17; Intros; Assumption. -Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x0``/\(E alp))); Intro. -Assumption. -Assert H17 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x0``/\(E alp) H16); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``). -Intro; Assert H21 := (H19 ? H20); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H15 H21)). -Unfold is_upper_bound; Intros; Unfold is_upper_bound in H18; Assert H21 := (H18 ? H20); Case (total_order_Rle x1 ``(Rabsolu (z-x))``); Intro. -Assumption. -Elim (H17 x1); Split. -Split; [Auto with real | Assumption]. -Assumption. -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. -Apply p. -Apply H21. -Elim H12; Intros; Unfold E in H13; Elim H13; Intros H14 _; Elim H14; Intros H15 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H16; Unfold is_upper_bound in H17; Split. -Apply Rlt_le_trans with x1; [Assumption | Apply (H16 ? H13)]. -Apply H17; Intros; Unfold E in H18; Elim H18; Intros; Elim H19; Intros; Assumption. -Qed. +assert + (X_enc : + exists m : R | ( exists M : R | (forall x:R, X x -> m <= x <= M) /\ m < M)). +assert (H1 := compact_P1 X H0); unfold bounded in H1; elim H1; intros; + elim H2; intros; exists x; exists x0; split. +apply H3. +elim Hyp; intros; elim H4; intros; decompose [and] H5; + assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); + elim H10; intros; elim H11; intros; case (total_order_T x x0); + intro. +elim s; intro. +assumption. +rewrite b in H13; rewrite b in H7; elim H9; apply Rle_antisym; + apply Rle_trans with x0; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)). +elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc; + intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp; + unfold uniform_continuity in |- *; intro; + assert (H1 : forall t:posreal, 0 < t / 2). +intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ]. +pose + (g := + fun x y:R => + X x /\ + ( exists del : posreal + | (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + is_lub + (fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)) + del /\ disc x (mkposreal (del / 2) (H1 del)) y)). +assert (H2 : forall x:R, ( exists y : R | g x y) -> X x). +intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _; + apply H3. +pose (f' := mkfamily X g H2); unfold compact in H0; + assert (H3 : covering_open_set X f'). +unfold covering_open_set in |- *; split. +unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *; + split. +assumption. +assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; + unfold limit1_in in H4; unfold limit_in in H4; simpl in H4; + unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps)); + intros; + pose + (E := + fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); + assert (H6 : bound E). +unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; + unfold E in |- *; intros; elim H6; clear H6; intros H6 _; + elim H6; clear H6; intros _ H6; apply H6. +assert (H7 : exists x : R | E x). +elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros; + split. +split. +unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro. +apply H5. +apply Rlt_Rminus; apply Hyp. +apply Rmin_r. +intros; case (Req_dec x z); intro. +rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (H1 eps). +apply H7; split. +unfold D_x, no_cond in |- *; split; [ trivial | assumption ]. +apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ]. +assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros; + cut (0 < x1 <= M - m). +intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split. +intros; cut ( exists alp : R | Rabs (z - x) < alp <= x1 /\ E alp). +intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13; + elim H13; intros; apply H15. +elim H12; intros; assumption. +elim (classic ( exists alp : R | Rabs (z - x) < alp <= x1 /\ E alp)); intro. +assumption. +assert + (H12 := + not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11); + unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). +intro; assert (H16 := H14 _ H15); + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)). +unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13; + assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); + intro. +assumption. +elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ]. +split. +apply p. +unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ]. +elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _; + unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12; + unfold is_upper_bound in H11; split. +apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ]. +apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros; + assumption. +unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x)); + intro. +unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4; + intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; + intros; unfold neighbourhood in |- *; case (Req_dec x x0); + intro. +exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros; + split. +assumption. +exists x1; split. +apply H4. +split. +elim H5; intros; apply H8. +apply H7. +pose (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d). +unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros; + unfold disc in H7; apply H7. +exists (mkposreal _ H7); unfold included in |- *; intros; split. +assumption. +exists x1; split. +apply H4. +elim H5; intros; split. +assumption. +unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *; + unfold disc in H10; simpl in H10; + apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)). +replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. +replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ]. +do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l; + apply H8. +apply open_set_P6 with (fun _:R => False). +apply open_set_P4. +unfold eq_Dom in |- *; unfold included in |- *; intros; split. +intros; elim H4. +intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4. +elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4; + intros; unfold family_finite in H5; unfold domain_finite in H5; + unfold covering in H4; simpl in H4; simpl in H5; elim H5; + clear H5; intros l H5; unfold intersection_domain in H5; + cut + (forall x:R, + In x l -> + exists del : R + | 0 < del /\ + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + included (g x) (fun z:R => Rabs (z - x) < del / 2)). +intros; + assert + (H7 := + Rlist_P1 l + (fun x del:R => + 0 < del /\ + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); + elim H7; clear H7; intros l' H7; elim H7; clear H7; + intros; pose (D := MinRlist l'); cut (0 < D / 2). +intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13; + clear H13; intros xi H13; assert (H14 : In xi l). +unfold g in H13; decompose [and] H13; elim (H5 xi); intros; apply H14; split; + assumption. +elim (pos_Rl_P2 l xi); intros H15 _; elim (H15 H14); intros i H16; elim H16; + intros; apply Rle_lt_trans with (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)). +replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y)); + [ apply Rabs_triang | ring ]. +rewrite (double_var eps); apply Rplus_lt_compat. +assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; + elim H20; clear H20; intros; apply H20; unfold included in H21; + apply Rlt_trans with (pos_Rl l' i / 2). +apply H21. +elim H13; clear H13; intros; assumption. +unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. +prove_sup0. +rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply H19. +discrR. +assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; + elim H20; clear H20; intros; rewrite <- Rabs_Ropp; + rewrite Ropp_minus_distr; apply H20; unfold included in H21; + elim H13; intros; assert (H24 := H21 x H22); + apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)). +replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ]. +rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat. +apply Rlt_le_trans with (D / 2). +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12. +unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; prove_sup0. +unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i)); + intros; apply H26; exists i; split; + [ rewrite <- H7; assumption | reflexivity ]. +assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros; + elim (H10 H9); intros; elim H12; intros; rewrite H14; + rewrite <- H7 in H13; elim (H8 x H13); intros; + apply H15 + | apply Rinv_0_lt_compat; prove_sup0 ]. +intros; elim (H5 x); intros; elim (H8 H6); intros; + pose + (E := + fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); + assert (H11 : bound E). +unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; + unfold E in |- *; intros; elim H11; clear H11; intros H11 _; + elim H11; clear H11; intros _ H11; apply H11. +assert (H12 : exists x : R | E x). +assert (H13 := H _ H9); unfold continuity_pt in H13; + unfold continue_in in H13; unfold limit1_in in H13; + unfold limit_in in H13; simpl in H13; unfold R_dist in H13; + elim (H13 _ (H1 eps)); intros; elim H12; clear H12; + intros; exists (Rmin x0 (M - m)); unfold E in |- *; + intros; split. +split; + [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro; + [ apply H12 | apply Rlt_Rminus; apply Hyp ] + | apply Rmin_r ]. +intros; case (Req_dec x z); intro. +rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (H1 eps). +apply H14; split; + [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ] + | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ]. +assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros; + cut (0 < x0 <= M - m). +intro; elim H13; clear H13; intros; exists x0; split. +assumption. +split. +intros; cut ( exists alp : R | Rabs (z - x) < alp <= x0 /\ E alp). +intros; elim H16; intros; elim H17; clear H17; intros; unfold E in H18; + elim H18; intros; apply H20; elim H17; intros; assumption. +elim (classic ( exists alp : R | Rabs (z - x) < alp <= x0 /\ E alp)); intro. +assumption. +assert + (H17 := + not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16); + unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). +intro; assert (H21 := H19 _ H20); + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)). +unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18; + assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); + intro. +assumption. +elim (H17 x1); split. +split; [ auto with real | assumption ]. +assumption. +unfold included, g in |- *; intros; elim H15; intros; elim H17; intros; + decompose [and] H18; cut (x0 = x2). +intro; rewrite H20; apply H22. +unfold E in p; eapply is_lub_u. +apply p. +apply H21. +elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14; + intros H15 _; unfold is_lub in p; elim p; intros; + unfold is_upper_bound in H16; unfold is_upper_bound in H17; + split. +apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ]. +apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros; + assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v index ae23fd8a6..60f07f610 100644 --- a/theories/Reals/Rtrigo.v +++ b/theories/Reals/Rtrigo.v @@ -8,1104 +8,1700 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. +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 ZArith_base. -Require Zcomplements. -Require Classical_Prop. -V7only [Import nat_scope. Import Z_scope. Import R_scope.]. +Require Import ZArith_base. +Require Import Zcomplements. +Require Import Classical_Prop. Open Local Scope nat_scope. Open Local Scope R_scope. (** sin_PI2 is the only remaining axiom **) -Axiom sin_PI2 : ``(sin (PI/2))==1``. +Axiom sin_PI2 : sin (PI / 2) = 1. (**********) -Lemma PI_neq0 : ~``PI==0``. -Red; Intro; Assert H0 := PI_RGT_0; Rewrite H in H0; Elim (Rlt_antirefl ? H0). +Lemma PI_neq0 : PI <> 0. +red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0; + elim (Rlt_irrefl _ H0). Qed. (**********) -Lemma cos_minus : (x,y:R) ``(cos (x-y))==(cos x)*(cos y)+(sin x)*(sin y)``. -Intros; Unfold Rminus; Rewrite cos_plus. -Rewrite <- cos_sym; Rewrite sin_antisym; Ring. +Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y. +intros; unfold Rminus in |- *; rewrite cos_plus. +rewrite <- cos_sym; rewrite sin_antisym; ring. Qed. (**********) -Lemma sin2_cos2 : (x:R) ``(Rsqr (sin x)) + (Rsqr (cos x))==1``. -Intro; Unfold Rsqr; Rewrite Rplus_sym; Rewrite <- (cos_minus x x); Unfold Rminus; Rewrite Rplus_Ropp_r; Apply cos_0. +Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1. +intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x); + unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0. Qed. -Lemma cos2 : (x:R) ``(Rsqr (cos x))==1-(Rsqr (sin x))``. -Intro x; Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Unfold Rminus; Rewrite <- (Rplus_sym (Rsqr (cos x))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Symmetry; Apply Rplus_Or. +Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x). +intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1; + unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x))); + rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *; + apply Rplus_0_r. Qed. (**********) -Lemma cos_PI2 : ``(cos (PI/2))==0``. -Apply Rsqr_eq_0; Rewrite cos2; Rewrite sin_PI2; Rewrite Rsqr_1; Unfold Rminus; Apply Rplus_Ropp_r. +Lemma cos_PI2 : cos (PI / 2) = 0. +apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1; + unfold Rminus in |- *; apply Rplus_opp_r. Qed. (**********) -Lemma cos_PI : ``(cos PI)==-1``. -Replace ``PI`` with ``PI/2+PI/2``. -Rewrite cos_plus. -Rewrite sin_PI2; Rewrite cos_PI2. -Ring. -Symmetry; Apply double_var. +Lemma cos_PI : cos PI = -1. +replace PI with (PI / 2 + PI / 2). +rewrite cos_plus. +rewrite sin_PI2; rewrite cos_PI2. +ring. +symmetry in |- *; apply double_var. Qed. -Lemma sin_PI : ``(sin PI)==0``. -Assert H := (sin2_cos2 PI). -Rewrite cos_PI in H. -Rewrite <- Rsqr_neg in H. -Rewrite Rsqr_1 in H. -Cut (Rsqr (sin PI))==R0. -Intro; Apply (Rsqr_eq_0 ? H0). -Apply r_Rplus_plus with R1. -Rewrite Rplus_Or; Rewrite Rplus_sym; Exact H. +Lemma sin_PI : sin PI = 0. +assert (H := sin2_cos2 PI). +rewrite cos_PI in H. +rewrite <- Rsqr_neg in H. +rewrite Rsqr_1 in H. +cut (Rsqr (sin PI) = 0). +intro; apply (Rsqr_eq_0 _ H0). +apply Rplus_eq_reg_l with 1. +rewrite Rplus_0_r; rewrite Rplus_comm; exact H. Qed. (**********) -Lemma neg_cos : (x:R) ``(cos (x+PI))==-(cos x)``. -Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring. +Lemma neg_cos : forall x:R, cos (x + PI) = - cos x. +intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring. Qed. (**********) -Lemma sin_cos : (x:R) ``(sin x)==-(cos (PI/2+x))``. -Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring. +Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x). +intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. (**********) -Lemma sin_plus : (x,y:R) ``(sin (x+y))==(sin x)*(cos y)+(cos x)*(sin y)``. -Intros. -Rewrite (sin_cos ``x+y``). -Replace ``PI/2+(x+y)`` with ``(PI/2+x)+y``; [Rewrite cos_plus | Ring]. -Rewrite (sin_cos ``PI/2+x``). -Replace ``PI/2+(PI/2+x)`` with ``x+PI``. -Rewrite neg_cos. -Replace (cos ``PI/2+x``) with ``-(sin x)``. -Ring. -Rewrite sin_cos; Rewrite Ropp_Ropp; Reflexivity. -Pattern 1 PI; Rewrite (double_var PI); Ring. +Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y. +intros. +rewrite (sin_cos (x + y)). +replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ]. +rewrite (sin_cos (PI / 2 + x)). +replace (PI / 2 + (PI / 2 + x)) with (x + PI). +rewrite neg_cos. +replace (cos (PI / 2 + x)) with (- sin x). +ring. +rewrite sin_cos; rewrite Ropp_involutive; reflexivity. +pattern PI at 1 in |- *; rewrite (double_var PI); ring. Qed. -Lemma sin_minus : (x,y:R) ``(sin (x-y))==(sin x)*(cos y)-(cos x)*(sin y)``. -Intros; Unfold Rminus; Rewrite sin_plus. -Rewrite <- cos_sym; Rewrite sin_antisym; Ring. +Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y. +intros; unfold Rminus in |- *; rewrite sin_plus. +rewrite <- cos_sym; rewrite sin_antisym; ring. Qed. (**********) -Definition tan [x:R] : R := ``(sin x)/(cos x)``. - -Lemma tan_plus : (x,y:R) ~``(cos x)==0`` -> ~``(cos y)==0`` -> ~``(cos (x+y))==0`` -> ~``1-(tan x)*(tan y)==0`` -> ``(tan (x+y))==((tan x)+(tan y))/(1-(tan x)*(tan y))``. -Intros; Unfold tan; Rewrite sin_plus; Rewrite cos_plus; Unfold Rdiv; 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_Rmult. -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_Rplus_distrl; Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc; Repeat Rewrite (Rmult_sym ``(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; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Apply Rplus_plus_r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``(sin x)``); Rewrite (Rmult_sym ``(cos y)``); Rewrite <- Ropp_mul3; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite (Rmult_sym (sin x)); Rewrite <- Ropp_mul3; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r; Rewrite (Rmult_sym ``/(cos y)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Apply Rmult_1r. -Assumption. -Assumption. +Definition tan (x:R) : R := sin x / cos x. + +Lemma tan_plus : + forall x y:R, + cos x <> 0 -> + cos y <> 0 -> + cos (x + y) <> 0 -> + 1 - tan x * tan y <> 0 -> + tan (x + y) = (tan x + tan y) / (1 - tan x * tan y). +intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus; + unfold Rdiv in |- *; + replace (cos x * cos y - sin x * sin y) with + (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))). +rewrite Rinv_mult_distr. +repeat rewrite <- Rmult_assoc; + replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with + (sin x * / cos x + sin y * / cos y). +reflexivity. +rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr. +repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x)); + repeat rewrite <- Rmult_assoc. +repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ]. +assumption. +assumption. +apply prod_neq_R0; assumption. +assumption. +unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y)); + rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite (Rmult_comm (sin x)); + rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc; + apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); + rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +apply Rmult_1_r. +assumption. +assumption. Qed. (*******************************************************) (* Some properties of cos, sin and tan *) (*******************************************************) -Lemma sin2 : (x:R) ``(Rsqr (sin x))==1-(Rsqr (cos x))``. -Intro x; Generalize (cos2 x); Intro H1; Rewrite -> H1. -Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Symmetry; Apply Ropp_Ropp. +Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x). +intro x; generalize (cos2 x); intro H1; rewrite H1. +unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry in |- *; + apply Ropp_involutive. Qed. -Lemma sin_2a : (x:R) ``(sin (2*x))==2*(sin x)*(cos x)``. -Intro x; Rewrite double; Rewrite sin_plus. -Rewrite <- (Rmult_sym (sin x)); Symmetry; Rewrite Rmult_assoc; Apply double. +Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x. +intro x; rewrite double; rewrite sin_plus. +rewrite <- (Rmult_comm (sin x)); symmetry in |- *; rewrite Rmult_assoc; + apply double. Qed. -Lemma cos_2a : (x:R) ``(cos (2*x))==(cos x)*(cos x)-(sin x)*(sin x)``. -Intro x; Rewrite double; Apply cos_plus. +Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x. +intro x; rewrite double; apply cos_plus. Qed. -Lemma cos_2a_cos : (x:R) ``(cos (2*x))==2*(cos x)*(cos x)-1``. -Intro x; Rewrite double; Unfold Rminus; Rewrite Rmult_assoc; Rewrite cos_plus; Generalize (sin2_cos2 x); Rewrite double; Intro H1; Rewrite <- H1; SqRing. +Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1. +intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc; + rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; + intro H1; rewrite <- H1; ring_Rsqr. Qed. -Lemma cos_2a_sin : (x:R) ``(cos (2*x))==1-2*(sin x)*(sin x)``. -Intro x; Rewrite Rmult_assoc; Unfold Rminus; Repeat Rewrite double. -Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Rewrite cos_plus; SqRing. +Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x. +intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double. +generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus; + ring_Rsqr. Qed. -Lemma tan_2a : (x:R) ~``(cos x)==0`` -> ~``(cos (2*x))==0`` -> ~``1-(tan x)*(tan x)==0`` ->``(tan (2*x))==(2*(tan x))/(1-(tan x)*(tan x))``. -Repeat Rewrite double; Intros; Repeat Rewrite double; Rewrite double in H0; Apply tan_plus; Assumption. +Lemma tan_2a : + forall x:R, + cos x <> 0 -> + cos (2 * x) <> 0 -> + 1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x). +repeat rewrite double; intros; repeat rewrite double; rewrite double in H0; + apply tan_plus; assumption. Qed. -Lemma sin_neg : (x:R) ``(sin (-x))==-(sin x)``. -Apply sin_antisym. +Lemma sin_neg : forall x:R, sin (- x) = - sin x. +apply sin_antisym. Qed. -Lemma cos_neg : (x:R) ``(cos (-x))==(cos x)``. -Intro; Symmetry; Apply cos_sym. +Lemma cos_neg : forall x:R, cos (- x) = cos x. +intro; symmetry in |- *; apply cos_sym. Qed. -Lemma tan_0 : ``(tan 0)==0``. -Unfold tan; Rewrite -> sin_0; Rewrite -> cos_0. -Unfold Rdiv; Apply Rmult_Ol. +Lemma tan_0 : tan 0 = 0. +unfold tan in |- *; rewrite sin_0; rewrite cos_0. +unfold Rdiv in |- *; apply Rmult_0_l. Qed. -Lemma tan_neg : (x:R) ``(tan (-x))==-(tan x)``. -Intros x; Unfold tan; Rewrite sin_neg; Rewrite cos_neg; Unfold Rdiv. -Apply Ropp_mul1. +Lemma tan_neg : forall x:R, tan (- x) = - tan x. +intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg; + unfold Rdiv in |- *. +apply Ropp_mult_distr_l_reverse. Qed. -Lemma tan_minus : (x,y:R) ~``(cos x)==0`` -> ~``(cos y)==0`` -> ~``(cos (x-y))==0`` -> ~``1+(tan x)*(tan y)==0`` -> ``(tan (x-y))==((tan x)-(tan y))/(1+(tan x)*(tan y))``. -Intros; Unfold Rminus; Rewrite tan_plus. -Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Reflexivity. -Assumption. -Rewrite cos_neg; Assumption. -Assumption. -Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Assumption. +Lemma tan_minus : + forall x y:R, + cos x <> 0 -> + cos y <> 0 -> + cos (x - y) <> 0 -> + 1 + tan x * tan y <> 0 -> + tan (x - y) = (tan x - tan y) / (1 + tan x * tan y). +intros; unfold Rminus in |- *; rewrite tan_plus. +rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; + rewrite Rmult_opp_opp; reflexivity. +assumption. +rewrite cos_neg; assumption. +assumption. +rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; + rewrite Rmult_opp_opp; assumption. Qed. -Lemma cos_3PI2 : ``(cos (3*(PI/2)))==0``. -Replace ``3*(PI/2)`` with ``PI+(PI/2)``. -Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI2; Ring. -Pattern 1 PI; Rewrite (double_var PI). -Ring. +Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0. +replace (3 * (PI / 2)) with (PI + PI / 2). +rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring. +pattern PI at 1 in |- *; rewrite (double_var PI). +ring. Qed. -Lemma sin_2PI : ``(sin (2*PI))==0``. -Rewrite -> sin_2a; Rewrite -> sin_PI; Ring. +Lemma sin_2PI : sin (2 * PI) = 0. +rewrite sin_2a; rewrite sin_PI; ring. Qed. -Lemma cos_2PI : ``(cos (2*PI))==1``. -Rewrite -> cos_2a; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring. +Lemma cos_2PI : cos (2 * PI) = 1. +rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. Qed. -Lemma neg_sin : (x:R) ``(sin (x+PI))==-(sin x)``. -Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring. +Lemma neg_sin : forall x:R, sin (x + PI) = - sin x. +intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring. Qed. -Lemma sin_PI_x : (x:R) ``(sin (PI-x))==(sin x)``. -Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI; Rewrite -> cos_PI; Rewrite Rmult_Ol; Unfold Rminus; Rewrite Rplus_Ol; Rewrite Ropp_mul1; Rewrite Ropp_Ropp; Apply Rmult_1l. +Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x. +intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l; + unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse; + rewrite Ropp_involutive; apply Rmult_1_l. Qed. -Lemma sin_period : (x:R)(k:nat) ``(sin (x+2*(INR k)*PI))==(sin x)``. -Intros x k; Induction k. -Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring]. -Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> sin_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring]. +Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x. +intros x k; induction k as [| k Hreck]. +cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. +replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); + [ rewrite sin_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck + | rewrite S_INR; ring ]. Qed. -Lemma cos_period : (x:R)(k:nat) ``(cos (x+2*(INR k)*PI))==(cos x)``. -Intros x k; Induction k. -Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring]. -Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> cos_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring]. +Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x. +intros x k; induction k as [| k Hreck]. +cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. +replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); + [ rewrite cos_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck + | rewrite S_INR; ring ]. Qed. -Lemma sin_shift : (x:R) ``(sin (PI/2-x))==(cos x)``. -Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring. +Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x. +intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. -Lemma cos_shift : (x:R) ``(cos (PI/2-x))==(sin x)``. -Intro x; Rewrite -> cos_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring. +Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x. +intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. -Lemma cos_sin : (x:R) ``(cos x)==(sin (PI/2+x))``. -Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring. +Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x). +intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. -Lemma PI2_RGT_0 : ``0<PI/2``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup]. +Lemma PI2_RGT_0 : 0 < PI / 2. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ]. Qed. -Lemma SIN_bound : (x:R) ``-1<=(sin x)<=1``. -Intro; Case (total_order_Rle ``-1`` (sin x)); Intro. -Case (total_order_Rle (sin x) ``1``); Intro. -Split; Assumption. -Cut ``1<(sin x)``. -Intro; Generalize (Rsqr_incrst_1 ``1`` (sin x) H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` (sin x) (Rlt_trans ``0`` ``1`` (sin x) Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)). -Auto with real. -Cut ``(sin x)< -1``. -Intro; Generalize (Rlt_Ropp (sin x) ``-1`` H); Rewrite Ropp_Ropp; Clear H; Intro; Generalize (Rsqr_incrst_1 ``1`` ``-(sin x)`` H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` ``-(sin x)`` (Rlt_trans ``0`` ``1`` ``-(sin x)`` Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite <- Rsqr_neg in H0; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)). -Auto with real. -Qed. - -Lemma COS_bound : (x:R) ``-1<=(cos x)<=1``. -Intro; Rewrite <- sin_shift; Apply SIN_bound. -Qed. - -Lemma cos_sin_0 : (x:R) ~(``(cos x)==0``/\``(sin x)==0``). -Intro; Red; Intro; Elim H; Intros; Generalize (sin2_cos2 x); Intro; Rewrite H0 in H2; Rewrite H1 in H2; Repeat Rewrite Rsqr_O in H2; Rewrite Rplus_Or in H2; Generalize Rlt_R0_R1; Intro; Rewrite <- H2 in H3; Elim (Rlt_antirefl ``0`` H3). +Lemma SIN_bound : forall x:R, -1 <= sin x <= 1. +intro; case (Rle_dec (-1) (sin x)); intro. +case (Rle_dec (sin x) 1); intro. +split; assumption. +cut (1 < sin x). +intro; + generalize + (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1) + (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); + rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0; + generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; + generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). +auto with real. +cut (sin x < -1). +intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H); + rewrite Ropp_involutive; clear H; intro; + generalize + (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1) + (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H))); + rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; + rewrite sin2 in H0; unfold Rminus in H0; + generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; + generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). +auto with real. +Qed. + +Lemma COS_bound : forall x:R, -1 <= cos x <= 1. +intro; rewrite <- sin_shift; apply SIN_bound. +Qed. + +Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). +intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro; + rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2; + rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; + rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3). Qed. -Lemma cos_sin_0_var : (x:R) ~``(cos x)==0``\/~``(sin x)==0``. -Intro; Apply not_and_or; Apply cos_sin_0. +Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0. +intro; apply not_and_or; apply cos_sin_0. 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 : (a:R) ``0<a``->``a<=PI/2``->``0<(sin_lb a)``. -Intros. -Unfold sin_lb; Unfold sin_approx; Unfold sin_term. -Pose Un := [i:nat]``(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``. -Replace (sum_f_R0 [i:nat] ``(pow ( -1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))`` (S (S (S O)))) with (sum_f_R0 [i:nat]``(pow (-1) i)*(Un i)`` (3)); [Idtac | Apply sum_eq; Intros; Unfold Un; Reflexivity]. -Cut (n:nat)``(Un (S n))<(Un n)``. -Intro; Simpl. -Repeat Rewrite Rmult_1l; Repeat Rewrite Rmult_1r; Replace ``-1*(Un (S O))`` with ``-(Un (S O))``; [Idtac | Ring]; Replace ``-1* -1*(Un (S (S O)))`` with ``(Un (S (S O)))``; [Idtac | Ring]; Replace ``-1*( -1* -1)*(Un (S (S (S O))))`` with ``-(Un (S (S (S O))))``; [Idtac | Ring]; Replace ``(Un O)+ -(Un (S O))+(Un (S (S O)))+ -(Un (S (S (S O))))`` with ``((Un O)-(Un (S O)))+((Un (S (S O)))-(Un (S (S (S O)))))``; [Idtac | Ring]. -Apply gt0_plus_gt0_is_gt0. -Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S O)); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S O))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1. -Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S (S (S O)))); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S (S (S O))))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1. -Intro; Unfold Un. -Cut (plus (mult (2) (S n)) (S O)) = (plus (plus (mult (2) n) (S O)) (2)). -Intro; Rewrite H1. -Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rlt_monotony. -Apply pow_lt; Assumption. -Rewrite <- H1; Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) n) (S O)))). -Apply lt_INR_0; Apply neq_O_lt. -Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))). -Red; Intro; Elim H2; Symmetry; Assumption. -Rewrite <- Rinv_r_sym. -Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) (S n)) (S O)))). -Apply lt_INR_0; Apply neq_O_lt. -Assert H2 := (fact_neq_0 (plus (mult (2) (S n)) (1))). -Red; Intro; Elim H2; Symmetry; Assumption. -Rewrite (Rmult_sym (INR (fact (plus (mult (S (S O)) (S n)) (S O))))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Do 2 Rewrite Rmult_1r; Apply Rle_lt_trans with ``(INR (fact (plus (mult (S (S O)) n) (S O))))*4``. -Apply Rle_monotony. -Replace R0 with (INR O); [Idtac | Reflexivity]; Apply le_INR; Apply le_O_n. -Simpl; Rewrite Rmult_1r; Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing]; Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity]; Apply Rsqr_incr_1. -Apply Rle_trans with ``PI/2``; [Assumption | Unfold Rdiv; Apply Rle_monotony_contra with ``2``; [ Sup0 | Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m; [Replace ``2*2`` with ``4``; [Apply PI_4 | Ring] | DiscrR]]]. -Left; Assumption. -Left; Sup0. -Rewrite H1; Replace (plus (plus (mult (S (S O)) n) (S O)) (S (S O))) with (S (S (plus (mult (S (S O)) n) (S O)))). -Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR. -Repeat Rewrite <- Rmult_assoc. -Rewrite <- (Rmult_sym (INR (fact (plus (mult (S (S O)) n) (S O))))). -Rewrite Rmult_assoc. -Apply Rlt_monotony. -Apply lt_INR_0; Apply neq_O_lt. -Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))). -Red; Intro; Elim H2; Symmetry; Assumption. -Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Pose x := (INR n); Unfold INR. -Replace ``(2*x+1+1+1)*(2*x+1+1)`` with ``4*x*x+10*x+6``; [Idtac | Ring]. -Apply Rlt_anti_compatibility with ``-4``; Rewrite Rplus_Ropp_l; Replace ``-4+(4*x*x+10*x+6)`` with ``(4*x*x+10*x)+2``; [Idtac | Ring]. -Apply ge0_plus_gt0_is_gt0. -Cut ``0<=x``. -Intro; Apply ge0_plus_ge0_is_ge0; Repeat Apply Rmult_le_pos; Assumption Orelse Left; Sup. -Unfold x; Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Sup0. -Apply INR_eq; Do 2 Rewrite S_INR; Do 3 Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Qed. - -Lemma SIN : (a:R) ``0<=a`` -> ``a<=PI`` -> ``(sin_lb a)<=(sin a)<=(sin_ub a)``. -Intros; Unfold sin_lb sin_ub; Apply (sin_bound a (S O) H H0). -Qed. - -Lemma COS : (a:R) ``-PI/2<=a`` -> ``a<=PI/2`` -> ``(cos_lb a)<=(cos a)<=(cos_ub a)``. -Intros; Unfold cos_lb cos_ub; Apply (cos_bound a (S O) H H0). +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. +intros. +unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *. +pose (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; pose (x := INR n); + unfold INR in |- *. +replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6); + [ idtac | ring ]. +apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l; + replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2); + [ idtac | ring ]. +apply Rplus_le_lt_0_compat. +cut (0 <= x). +intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos; + assumption || left; prove_sup. +unfold x in |- *; replace 0 with (INR 0); + [ apply le_INR; apply le_O_n | reflexivity ]. +prove_sup0. +apply INR_eq; do 2 rewrite S_INR; do 3 rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite mult_INR; + repeat rewrite S_INR; ring. +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``. -Rewrite <- Ropp_O; Apply Rlt_Ropp1; Apply PI2_RGT_0. +Lemma _PI2_RLT_0 : - (PI / 2) < 0. +rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0. Qed. -Lemma PI4_RLT_PI2 : ``PI/4<PI/2``. -Unfold Rdiv; Apply Rlt_monotony. -Apply PI_RGT_0. -Apply Rinv_lt. -Apply Rmult_lt_pos; Sup0. -Pattern 1 ``2``; Rewrite <- Rplus_Or. -Replace ``4`` with ``2+2``; [Apply Rlt_compatibility; Sup0 | Ring]. +Lemma PI4_RLT_PI2 : PI / 4 < PI / 2. +unfold Rdiv in |- *; apply Rmult_lt_compat_l. +apply PI_RGT_0. +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat; prove_sup0. +pattern 2 at 1 in |- *; rewrite <- Rplus_0_r. +replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ]. Qed. -Lemma PI2_Rlt_PI : ``PI/2<PI``. -Unfold Rdiv; Pattern 2 PI; Rewrite <- Rmult_1r. -Apply Rlt_monotony. -Apply PI_RGT_0. -Pattern 3 R1; Rewrite <- Rinv_R1; Apply Rinv_lt. -Rewrite Rmult_1l; Sup0. -Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1. +Lemma PI2_Rlt_PI : PI / 2 < PI. +unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r. +apply Rmult_lt_compat_l. +apply PI_RGT_0. +pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar. +rewrite Rmult_1_l; prove_sup0. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + apply Rlt_0_1. Qed. (********************************************) (* Increasing and decreasing of COS and SIN *) (********************************************) -Theorem sin_gt_0 : (x:R) ``0<x`` -> ``x<PI`` -> ``0<(sin x)``. -Intros; Elim (SIN x (Rlt_le R0 x H) (Rlt_le x PI H0)); Intros H1 _; Case (total_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_R0_R1. -Rewrite <- sin_PI_x; Generalize (Rgt_Ropp x ``PI/2`` H3); Intro H4; Generalize (Rlt_compatibility PI (Ropp x) (Ropp ``PI/2``) H4). -Replace ``PI+(-x)`` with ``PI-x``. -Replace ``PI+ -(PI/2)`` with ``PI/2``. -Intro H5; Generalize (Rlt_Ropp x PI H0); Intro H6; Change ``-PI < -x`` in H6; Generalize (Rlt_compatibility PI (Ropp PI) (Ropp x) H6). -Rewrite Rplus_Ropp_r. -Replace ``PI+ -x`` with ``PI-x``. -Intro H7; Elim (SIN ``PI-x`` (Rlt_le R0 ``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 2 PI; Rewrite double_var; Ring. -Reflexivity. -Qed. - -Theorem cos_gt_0 : (x:R) ``-(PI/2)<x`` -> ``x<PI/2`` -> ``0<(cos x)``. -Intros; Rewrite cos_sin; Generalize (Rlt_compatibility ``PI/2`` ``-(PI/2)`` x H). -Rewrite Rplus_Ropp_r; Intro H1; Generalize (Rlt_compatibility ``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 : (x:R) ``0<=x`` -> ``x<=PI`` -> ``0<=(sin x)``. -Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (sin_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply sin_PI ] | Rewrite <- H3; Right; Symmetry; Apply sin_0]. -Qed. - -Lemma cos_ge_0 : (x:R) ``-(PI/2)<=x`` -> ``x<=PI/2`` -> ``0<=(cos x)``. -Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (cos_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply cos_PI2 ] | Rewrite <- H3; Rewrite cos_neg; Right; Symmetry; Apply cos_PI2 ]. -Qed. - -Lemma sin_le_0 : (x:R) ``PI<=x`` -> ``x<=2*PI`` -> ``(sin x)<=0``. -Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rle_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_ge_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring]. -Qed. - -Lemma cos_le_0 : (x:R) ``PI/2<=x``->``x<=3*(PI/2)``->``(cos x)<=0``. -Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rle_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``. -Rewrite cos_period; Apply cos_ge_0. -Replace ``-(PI/2)`` with ``-PI+(PI/2)``. -Unfold Rminus; Rewrite (Rplus_sym x); Apply Rle_compatibility; Assumption. -Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. -Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``. -Apply Rle_compatibility; Assumption. -Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. -Unfold INR; Ring. -Qed. - -Lemma sin_lt_0 : (x:R) ``PI<x`` -> ``x<2*PI`` -> ``(sin x)<0``. -Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rlt_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_gt_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring]. -Qed. - -Lemma sin_lt_0_var : (x:R) ``-PI<x`` -> ``x<0`` -> ``(sin x)<0``. -Intros; Generalize (Rlt_compatibility ``2*PI`` ``-PI`` x H); Replace ``2*PI+(-PI)`` with ``PI``; [Intro H1; Rewrite Rplus_sym in H1; Generalize (Rlt_compatibility ``2*PI`` x ``0`` H0); Intro H2; Rewrite (Rplus_sym ``2*PI``) in H2; Rewrite <- (Rplus_sym R0) in H2; Rewrite Rplus_Ol in H2; Rewrite <- (sin_period x (1)); Unfold INR; Replace ``2*1*PI`` with ``2*PI``; [Apply (sin_lt_0 ``x+2*PI`` H1 H2) | Ring] | Ring]. -Qed. - -Lemma cos_lt_0 : (x:R) ``PI/2<x`` -> ``x<3*(PI/2)``-> ``(cos x)<0``. -Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rlt_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``. -Rewrite cos_period; Apply cos_gt_0. -Replace ``-(PI/2)`` with ``-PI+(PI/2)``. -Unfold Rminus; Rewrite (Rplus_sym x); Apply Rlt_compatibility; Assumption. -Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. -Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``. -Apply Rlt_compatibility; Assumption. -Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. -Unfold INR; Ring. -Qed. - -Lemma tan_gt_0 : (x:R) ``0<x`` -> ``x<PI/2`` -> ``0<(tan x)``. -Intros x H1 H2; Unfold tan; Generalize _PI2_RLT_0; Generalize (Rlt_trans R0 x ``PI/2`` H1 H2); Intros; Generalize (Rlt_trans ``-(PI/2)`` R0 x H0 H1); Intro H5; Generalize (Rlt_trans x ``PI/2`` PI H2 PI2_Rlt_PI); Intro H7; Unfold Rdiv; Apply Rmult_lt_pos. -Apply sin_gt_0; Assumption. -Apply Rlt_Rinv; Apply cos_gt_0; Assumption. -Qed. - -Lemma tan_lt_0 : (x:R) ``-(PI/2)<x``->``x<0``->``(tan x)<0``. -Intros x H1 H2; Unfold tan; Generalize (cos_gt_0 x H1 (Rlt_trans x ``0`` ``PI/2`` H2 PI2_RGT_0)); Intro H3; Rewrite <- Ropp_O; Replace ``(sin x)/(cos x)`` with ``- ((-(sin x))/(cos x))``. -Rewrite <- sin_neg; Apply Rgt_Ropp; Change ``0<(sin (-x))/(cos x)``; Unfold Rdiv; Apply Rmult_lt_pos. -Apply sin_gt_0. -Rewrite <- Ropp_O; Apply Rgt_Ropp; Assumption. -Apply Rlt_trans with ``PI/2``. -Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rgt_Ropp; Assumption. -Apply PI2_Rlt_PI. -Apply Rlt_Rinv; Assumption. -Unfold Rdiv; Ring. -Qed. - -Lemma cos_ge_0_3PI2 : (x:R) ``3*(PI/2)<=x``->``x<=2*PI``->``0<=(cos x)``. -Intros; Rewrite <- cos_neg; Rewrite <- (cos_period ``-x`` (1)); Unfold INR; Replace ``-x+2*1*PI`` with ``2*PI-x``. -Generalize (Rle_Ropp x ``2*PI`` H0); Intro H1; Generalize (Rle_sym2 ``-(2*PI)`` ``-x`` H1); Clear H1; Intro H1; Generalize (Rle_compatibility ``2*PI`` ``-(2*PI)`` ``-x`` H1). -Rewrite Rplus_Ropp_r. -Intro H2; Generalize (Rle_Ropp ``3*(PI/2)`` x H); Intro H3; Generalize (Rle_sym2 ``-x`` ``-(3*(PI/2))`` H3); Clear H3; Intro H3; Generalize (Rle_compatibility ``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 2 3 PI; Rewrite double_var; Ring. -Ring. -Qed. - -Lemma form1 : (p,q:R) ``(cos p)+(cos q)==2*(cos ((p-q)/2))*(cos ((p+q)/2))``. -Intros p q; Pattern 1 p; 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 3 q; Rewrite double_var; Unfold Rdiv; Ring. -Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring. -Qed. - -Lemma form2 : (p,q:R) ``(cos p)-(cos q)==-2*(sin ((p-q)/2))*(sin ((p+q)/2))``. -Intros p q; Pattern 1 p; 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 3 q; Rewrite double_var; Unfold Rdiv; Ring. -Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring. -Qed. - -Lemma form3 : (p,q:R) ``(sin p)+(sin q)==2*(cos ((p-q)/2))*(sin ((p+q)/2))``. -Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``. -Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``. -Rewrite sin_plus; Rewrite sin_minus; Ring. -Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring. -Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring. -Qed. - -Lemma form4 : (p,q:R) ``(sin p)-(sin q)==2*(cos ((p+q)/2))*(sin ((p-q)/2))``. -Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``. -Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``. -Rewrite sin_plus; Rewrite sin_minus; Ring. -Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring. -Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring. - -Qed. - -Lemma sin_increasing_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<(sin y)``->``x<y``. -Intros; Cut ``(sin ((x-y)/2))<0``. -Intro H4; Case (total_order ``(x-y)/2`` ``0``); Intro H5. -Assert Hyp : ``0<2``. -Sup0. -Generalize (Rlt_monotony ``2`` ``(x-y)/2`` ``0`` Hyp H5). -Unfold Rdiv. -Rewrite <- Rmult_assoc. -Rewrite Rinv_r_simpl_m. -Rewrite Rmult_Or. -Clear H5; Intro H5; Apply Rminus_lt; Assumption. -DiscrR. -Elim H5; Intro H6. -Rewrite H6 in H4; Rewrite sin_0 in H4; Elim (Rlt_antirefl ``0`` H4). -Change ``0<(x-y)/2`` in H6; Generalize (Rle_Ropp ``-(PI/2)`` y H1). -Rewrite Ropp_Ropp. -Intro H7; Generalize (Rle_sym2 ``-y`` ``PI/2`` H7); Clear H7; Intro H7; Generalize (Rplus_le x ``PI/2`` ``-y`` ``PI/2`` H0 H7). -Rewrite <- double_var. -Intro H8. -Assert Hyp : ``0<2``. -Sup0. -Generalize (Rle_monotony ``(Rinv 2)`` ``x-y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H8). -Repeat Rewrite (Rmult_sym ``/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_antirefl ``(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 x ``PI/2`` y ``PI/2`` H0 H2). -Rewrite <- double_var. -Assert Hyp : ``0<2``. -Sup0. -Intro H4; Generalize (Rle_monotony ``(Rinv 2)`` ``x+y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H4). -Repeat Rewrite (Rmult_sym ``/2``). -Clear H4; Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` y H H1); Replace ``-(PI/2)+(-(PI/2))`` with ``-PI``. -Intro H5; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``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 (Rlt_monotony ``2`` ``0`` ``(cos ((x+y)/2))`` Hyp H6). -Rewrite Rmult_Or. -Clear H6; Intro H6; Case (case_Rabsolu ``(sin ((x-y)/2))``); Intro H7. -Assumption. -Generalize (Rle_sym2 ``0`` ``(sin ((x-y)/2))`` 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_antirefl ``0`` H9). -Rewrite <- H50 in H3; Rewrite cos_neg in H3; Rewrite cos_PI2 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3). -Unfold Rdiv in H3. -Rewrite H40 in H3; Assert H50 := cos_PI2; Unfold Rdiv in H50; Rewrite H50 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3). -Unfold Rdiv. -Rewrite <- Ropp_mul1. -Apply Rmult_sym. -Unfold Rdiv; Apply Rmult_sym. -Pattern 1 PI; Rewrite double_var. -Rewrite Ropp_distr1. -Reflexivity. -Qed. - -Lemma sin_increasing_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<y``->``(sin x)<(sin y)``. -Intros; Generalize (Rlt_compatibility ``x`` ``x`` ``y`` H3); Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` x H H); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``. -Assert Hyp : ``0<2``. -Sup0. -Intro H5; Generalize (Rle_lt_trans ``-PI`` ``x+x`` ``x+y`` H5 H4); Intro H6; Generalize (Rlt_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_Rinv ``2`` Hyp) H6); Replace ``/2*(-PI)`` with ``-(PI/2)``. -Replace ``/2*(x+y)`` with ``(x+y)/2``. -Clear H4 H5 H6; Intro H4; Generalize (Rlt_compatibility ``y`` ``x`` ``y`` H3); Intro H5; Rewrite Rplus_sym in H5; Generalize (Rplus_le 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 (Rlt_monotony ``(Rinv 2)`` ``x+y`` PI (Rlt_Rinv ``2`` Hyp) H7); Replace ``/2*PI`` with ``PI/2``. -Replace ``/2*(x+y)`` with ``(x+y)/2``. -Clear H5 H6 H7; Intro H5; Generalize (Rle_Ropp ``-(PI/2)`` y H1); Rewrite Ropp_Ropp; Clear H1; Intro H1; Generalize (Rle_sym2 ``-y`` ``PI/2`` H1); Clear H1; Intro H1; Generalize (Rle_Ropp y ``PI/2`` H2); Clear H2; Intro H2; Generalize (Rle_sym2 ``-(PI/2)`` ``-y`` H2); Clear H2; Intro H2; Generalize (Rlt_compatibility ``-y`` x y H3); Replace ``-y+x`` with ``x-y``. -Rewrite Rplus_Ropp_l. -Intro H6; Generalize (Rlt_monotony ``(Rinv 2)`` ``x-y`` ``0`` (Rlt_Rinv ``2`` Hyp) H6); Rewrite Rmult_Or; Replace ``/2*(x-y)`` with ``(x-y)/2``. -Clear H6; Intro H6; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` ``-y`` H H2); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``. -Replace `` x+ -y`` with ``x-y``. -Intro H7; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x-y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``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_pos ``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 (Rlt_anti_monotony ``(sin ((x-y)/2))`` ``0`` ``2*(cos ((x+y)/2))`` H10 H8); Intro H11; Rewrite Rmult_Or in H11; Rewrite Rmult_sym; Assumption. -Apply Rlt_Ropp; Apply PI2_Rlt_PI. -Unfold Rdiv; Apply Rmult_sym. -Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_sym. -Reflexivity. -Pattern 1 PI; Rewrite double_var. -Rewrite Ropp_distr1. -Reflexivity. -Unfold Rdiv; Apply Rmult_sym. -Unfold Rminus; Apply Rplus_sym. -Unfold Rdiv; Apply Rmult_sym. -Unfold Rdiv; Apply Rmult_sym. -Unfold Rdiv; Apply Rmult_sym. -Unfold Rdiv. -Rewrite <- Ropp_mul1. -Apply Rmult_sym. -Pattern 1 PI; Rewrite double_var. -Rewrite Ropp_distr1. -Reflexivity. -Qed. - -Lemma sin_decreasing_0 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``(sin x)<(sin y)`` -> ``y<x``. -Intros; Rewrite <- (sin_PI_x x) in H3; Rewrite <- (sin_PI_x y) in H3; Generalize (Rlt_Ropp ``(sin (PI-x))`` ``(sin (PI-y))`` H3); Repeat Rewrite <- sin_neg; Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-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 Rlt_anti_compatibility with ``-PI``; Rewrite Rplus_sym; Replace ``y+ (-PI)`` with ``y-PI``. -Rewrite Rplus_sym; Replace ``x+ (-PI)`` with ``x-PI``. -Apply (sin_increasing_0 ``y-PI`` ``x-PI`` H4 H5 H6 H7 H8). -Reflexivity. -Reflexivity. -Unfold Rminus; Rewrite Ropp_distr1. -Rewrite Ropp_Ropp. -Apply Rplus_sym. -Unfold Rminus; Rewrite Ropp_distr1. -Rewrite Ropp_Ropp. -Apply Rplus_sym. -Pattern 2 PI; Rewrite double_var. -Rewrite Ropp_distr1. -Ring. -Unfold Rminus; Apply Rplus_sym. -Pattern 2 PI; Rewrite double_var. -Rewrite Ropp_distr1. -Ring. -Unfold Rminus; Apply Rplus_sym. -Qed. - -Lemma sin_decreasing_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<y`` -> ``(sin y)<(sin x)``. -Intros; Rewrite <- (sin_PI_x x); Rewrite <- (sin_PI_x y); Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-PI`` ``PI/2`` y H2); Generalize (Rlt_compatibility ``-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_Rlt; 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; Rewrite Ropp_distr1. -Rewrite Ropp_Ropp. -Apply Rplus_sym. -Unfold Rminus; Rewrite Ropp_distr1. -Rewrite Ropp_Ropp. -Apply Rplus_sym. -Unfold Rminus; Apply Rplus_sym. -Pattern 2 PI; Rewrite double_var; Ring. -Unfold Rminus; Apply Rplus_sym. -Pattern 2 PI; Rewrite double_var; Ring. -Qed. - -Lemma cos_increasing_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<(cos y)`` -> ``x<y``. -Intros x y H1 H2 H3 H4; Rewrite <- (cos_neg x); Rewrite <- (cos_neg y); Rewrite <- (cos_period ``-x`` (1)); Rewrite <- (cos_period ``-y`` (1)); Unfold INR; 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 (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-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 Rlt_anti_compatibility 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. -Rewrite Ropp_mul1. -Apply Rplus_sym. -Unfold Rminus. -Rewrite Ropp_mul1. -Apply Rplus_sym. -Pattern 3 PI; Rewrite double_var. -Ring. -Rewrite double; Pattern 3 4 PI; Rewrite double_var. -Ring. -Unfold Rminus. -Rewrite Ropp_mul1. -Apply Rplus_sym. -Unfold Rminus. -Rewrite Ropp_mul1. -Apply Rplus_sym. -Rewrite Rmult_1r. -Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var. -Ring. -Rewrite Rmult_1r. -Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var. -Ring. -Qed. - -Lemma cos_increasing_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<y`` -> ``(cos x)<(cos y)``. -Intros x y H1 H2 H3 H4 H5; Generalize (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-3*(PI/2)`` y ``2*PI`` H4); Generalize (Rlt_compatibility ``-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; 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_1r. -Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var. -Ring. -Rewrite Rmult_1r. -Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var. -Ring. -Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var. -Ring. -Pattern 3 PI; Rewrite double_var; Ring. -Unfold Rminus. -Rewrite <- Ropp_mul1. -Apply Rplus_sym. -Unfold Rminus. -Rewrite <- Ropp_mul1. -Apply Rplus_sym. -Qed. - -Lemma cos_decreasing_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<(cos y)``->``y<x``. -Intros; Generalize (Rlt_Ropp (cos x) (cos y) H3); Repeat Rewrite <- neg_cos; Intro H4; Change ``(cos (y+PI))<(cos (x+PI))`` in H4; Rewrite (Rplus_sym x) in H4; Rewrite (Rplus_sym y) in H4; Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or. -Rewrite <- double. -Clear H H0 H1 H2 H3; Intros; Apply Rlt_anti_compatibility with ``PI``; Apply (cos_increasing_0 ``PI+y`` ``PI+x`` H0 H H2 H1 H4). -Qed. - -Lemma cos_decreasing_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<y``->``(cos y)<(cos x)``. -Intros; Apply Ropp_Rlt; Repeat Rewrite <- neg_cos; Rewrite (Rplus_sym x); Rewrite (Rplus_sym y); Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or. -Rewrite <- double. -Generalize (Rlt_compatibility 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 : (x,y:R) ~``(cos x)==0``->~``(cos y)==0``->``(tan x)-(tan y)==(sin (x-y))/((cos x)*(cos y))``. -Intros; Unfold tan;Rewrite sin_minus. -Unfold Rdiv. -Unfold Rminus. -Rewrite Rmult_Rplus_distrl. -Rewrite Rinv_Rmult. -Repeat Rewrite (Rmult_sym (sin x)). -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym (cos y)). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Rewrite (Rmult_sym (sin x)). -Apply Rplus_plus_r. -Rewrite <- Ropp_mul1. -Rewrite <- Ropp_mul3. -Rewrite (Rmult_sym ``/(cos x)``). -Repeat Rewrite Rmult_assoc. -Rewrite (Rmult_sym (cos x)). -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Reflexivity. -Assumption. -Assumption. -Assumption. -Assumption. -Qed. - -Lemma tan_increasing_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<(tan y)``->``x<y``. -Intros; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``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_sym ``0`` (cos x) (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_sym ``0`` (cos y) (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 (Rle_Ropp ``-(PI/4)`` y H1); Rewrite Ropp_Ropp; Intro H10; Generalize (Rle_sym2 ``-y`` ``PI/4`` H10); Clear H10; Intro H10; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(PI/4)`` x ``-(PI/4)`` ``-y`` H H11); Generalize (Rplus_le 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 (total_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_antirefl ``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_antirefl ``0`` H9). -Apply Rminus_lt; Assumption. -Pattern 1 PI; Rewrite double_var. -Unfold Rdiv. -Rewrite Rmult_Rplus_distrl. -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_Rmult. -Rewrite Ropp_distr1. -Replace ``2*2`` with ``4``. -Reflexivity. -Ring. -DiscrR. -DiscrR. -Pattern 1 PI; Rewrite double_var. -Unfold Rdiv. -Rewrite Rmult_Rplus_distrl. -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_Rmult. -Replace ``2*2`` with ``4``. -Reflexivity. -Ring. -DiscrR. -DiscrR. -Reflexivity. -Case (case_Rabsolu ``(sin (x-y))``); Intro H9. -Assumption. -Generalize (Rle_sym2 ``0`` ``(sin (x-y))`` H9); Clear H9; Intro H9; Generalize (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (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_antirefl ``0`` (Rle_lt_trans ``0`` ``(sin (x-y))*/((cos x)*(cos y))`` ``0`` H13 H3)). -Rewrite Rinv_Rmult. -Reflexivity. -Assumption. -Assumption. -Qed. - -Lemma tan_increasing_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<y``->``(tan x)<(tan y)``. -Intros; Apply Rminus_lt; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``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_sym ``0`` (cos x) (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_sym ``0`` (cos y) (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 (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (cos y)) H10 H11); Replace ``/(cos x)*/(cos y)`` with ``/((cos x)*(cos y))``. -Clear H10 H11; Intro H8; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(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 (Rlt_Ropp ``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 (Rlt_anti_monotony ``(sin (x-y))`` ``0`` ``/((cos x)*(cos y))`` H2 H8); Rewrite Rmult_Or; Intro H4; Assumption. -Pattern 1 PI; Rewrite double_var. -Unfold Rdiv. -Rewrite Rmult_Rplus_distrl. -Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_Rmult. -Replace ``2*2`` with ``4``. -Rewrite Ropp_distr1. -Reflexivity. -Ring. -DiscrR. -DiscrR. -Reflexivity. -Apply Rinv_Rmult; Assumption. -Qed. - -Lemma sin_incr_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<=(sin y)``->``x<=y``. -Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl (sin y) H8)]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]]. -Qed. - -Lemma sin_incr_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<=y``->``(sin x)<=(sin y)``. -Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]]. -Qed. - -Lemma sin_decr_0 : (x,y:R) ``x<=3*(PI/2)``->``PI/2<=x``->``y<=3*(PI/2)``->``PI/2<=y``-> ``(sin x)<=(sin y)`` -> ``y<=x``. -Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (sin_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (sin y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]]. -Qed. - -Lemma sin_decr_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<=y`` -> ``(sin y)<=(sin x)``. -Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]]. -Qed. - -Lemma cos_incr_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<=(cos y)`` -> ``x<=y``. -Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl (cos y) H8)]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]]. -Qed. - -Lemma cos_incr_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<=y`` -> ``(cos x)<=(cos y)``. -Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]]. -Qed. - -Lemma cos_decr_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<=(cos y)`` -> ``y<=x``. -Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (cos_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (cos y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]]. -Qed. - -Lemma cos_decr_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<=y``->``(cos y)<=(cos x)``. -Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]]. -Qed. - -Lemma tan_incr_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<=(tan y)``->``x<=y``. -Intros; Case (total_order (tan x) (tan y)); Intro H4; [Left; Apply (tan_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl (tan y) H8)]] | Elim (Rlt_antirefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5))]]. -Qed. - -Lemma tan_incr_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<=y``->``(tan x)<=(tan y)``. -Intros; Case (total_order x y); Intro H4; [Left; Apply (tan_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]]. +Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x. +intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _; + case (Rtotal_order x (PI / 2)); intro H2. +apply Rlt_le_trans with (sin_lb x). +apply sin_lb_gt_0; [ assumption | left; assumption ]. +assumption. +elim H2; intro H3. +rewrite H3; rewrite sin_PI2; apply Rlt_0_1. +rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3); + intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4). +replace (PI + - x) with (PI - x). +replace (PI + - (PI / 2)) with (PI / 2). +intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6; + change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6). +rewrite Rplus_opp_r. +replace (PI + - x) with (PI - x). +intro H7; + elim + (SIN (PI - x) (Rlt_le 0 (PI - x) H7) + (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI))); + intros H8 _; + generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); + intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8). +reflexivity. +pattern PI at 2 in |- *; rewrite double_var; ring. +reflexivity. +Qed. + +Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x. +intros; rewrite cos_sin; + generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H). +rewrite Rplus_opp_r; intro H1; + generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); + rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2). +Qed. + +Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x. +intros x H1 H2; elim H1; intro H3; + [ elim H2; intro H4; + [ left; apply (sin_gt_0 x H3 H4) + | rewrite H4; right; symmetry in |- *; apply sin_PI ] + | rewrite <- H3; right; symmetry in |- *; apply sin_0 ]. +Qed. + +Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x. +intros x H1 H2; elim H1; intro H3; + [ elim H2; intro H4; + [ left; apply (cos_gt_0 x H3 H4) + | rewrite H4; right; symmetry in |- *; apply cos_PI2 ] + | rewrite <- H3; rewrite cos_neg; right; symmetry in |- *; apply cos_PI2 ]. +Qed. + +Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0. +intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; + rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar; + rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI); + [ rewrite (sin_period (x - PI) 1); apply sin_ge_0; + [ replace (x - PI) with (x + - PI); + [ rewrite Rplus_comm; replace 0 with (- PI + PI); + [ apply Rplus_le_compat_l; assumption | ring ] + | ring ] + | replace (x - PI) with (x + - PI); rewrite Rplus_comm; + [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); + [ apply Rplus_le_compat_l; assumption | ring ] + | ring ] ] + | unfold INR in |- *; ring ]. +Qed. + +Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0. +intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; + rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar; + rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI). +rewrite cos_period; apply cos_ge_0. +replace (- (PI / 2)) with (- PI + PI / 2). +unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l; + assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold Rminus in |- *; rewrite Rplus_comm; + replace (PI / 2) with (- PI + 3 * (PI / 2)). +apply Rplus_le_compat_l; assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold INR in |- *; ring. +Qed. + +Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0. +intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x)); + apply Ropp_lt_gt_contravar; rewrite <- neg_sin; + replace (x + PI) with (x - PI + 2 * INR 1 * PI); + [ rewrite (sin_period (x - PI) 1); apply sin_gt_0; + [ replace (x - PI) with (x + - PI); + [ rewrite Rplus_comm; replace 0 with (- PI + PI); + [ apply Rplus_lt_compat_l; assumption | ring ] + | ring ] + | replace (x - PI) with (x + - PI); rewrite Rplus_comm; + [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); + [ apply Rplus_lt_compat_l; assumption | ring ] + | ring ] ] + | unfold INR in |- *; ring ]. +Qed. + +Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0. +intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H); + replace (2 * PI + - PI) with PI; + [ intro H1; rewrite Rplus_comm in H1; + generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); + intro H2; rewrite (Rplus_comm (2 * PI)) in H2; + rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2; + rewrite <- (sin_period x 1); unfold INR in |- *; + replace (2 * 1 * PI) with (2 * PI); + [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ] + | ring ]. +Qed. + +Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0. +intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x)); + apply Ropp_lt_gt_contravar; rewrite <- neg_cos; + replace (x + PI) with (x - PI + 2 * INR 1 * PI). +rewrite cos_period; apply cos_gt_0. +replace (- (PI / 2)) with (- PI + PI / 2). +unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l; + assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold Rminus in |- *; rewrite Rplus_comm; + replace (PI / 2) with (- PI + 3 * (PI / 2)). +apply Rplus_lt_compat_l; assumption. +pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. +unfold INR in |- *; ring. +Qed. + +Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x. +intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0; + generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros; + generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5; + generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); + intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply sin_gt_0; assumption. +apply Rinv_0_lt_compat; apply cos_gt_0; assumption. +Qed. + +Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0. +intros x H1 H2; unfold tan in |- *; + generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); + intro H3; rewrite <- Ropp_0; + replace (sin x / cos x) with (- (- sin x / cos x)). +rewrite <- sin_neg; apply Ropp_gt_lt_contravar; + change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. +apply sin_gt_0. +rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption. +apply Rlt_trans with (PI / 2). +rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption. +apply PI2_Rlt_PI. +apply Rinv_0_lt_compat; assumption. +unfold Rdiv in |- *; ring. +Qed. + +Lemma cos_ge_0_3PI2 : + forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x. +intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1); + unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x). +generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1; + generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; + intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1). +rewrite Rplus_opp_r. +intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3; + generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; + intro H3; + generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3). +replace (2 * PI + - (3 * (PI / 2))) with (PI / 2). +intro H4; + apply + (cos_ge_0 (2 * PI - x) + (Rlt_le (- (PI / 2)) (2 * PI - x) + (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4). +rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring. +ring. +Qed. + +Lemma form1 : + forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). +rewrite cos_plus; rewrite cos_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +Qed. + +Lemma form2 : + forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). +rewrite cos_plus; rewrite cos_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +Qed. + +Lemma form3 : + forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). +rewrite sin_plus; rewrite sin_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +Qed. + +Lemma form4 : + forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2). +intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). +pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). +rewrite sin_plus; rewrite sin_minus; ring. +pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. +pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + +Qed. + +Lemma sin_increasing_0 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y. +intros; cut (sin ((x - y) / 2) < 0). +intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5. +assert (Hyp : 0 < 2). +prove_sup0. +generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5). +unfold Rdiv in |- *. +rewrite <- Rmult_assoc. +rewrite Rinv_r_simpl_m. +rewrite Rmult_0_r. +clear H5; intro H5; apply Rminus_lt; assumption. +discrR. +elim H5; intro H6. +rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4). +change (0 < (x - y) / 2) in H6; + generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1). +rewrite Ropp_involutive. +intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7; + generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7). +rewrite <- double_var. +intro H8. +assert (Hyp : 0 < 2). +prove_sup0. +generalize + (Rmult_le_compat_l (/ 2) (x - y) PI + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8). +repeat rewrite (Rmult_comm (/ 2)). +intro H9; + generalize + (sin_gt_0 ((x - y) / 2) H6 + (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); + intro H10; + elim + (Rlt_irrefl (sin ((x - y) / 2)) + (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)). +generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3; + rewrite form4 in H3; + generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2). +rewrite <- double_var. +assert (Hyp : 0 < 2). +prove_sup0. +intro H4; + generalize + (Rmult_le_compat_l (/ 2) (x + y) PI + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4). +repeat rewrite (Rmult_comm (/ 2)). +clear H4; intro H4; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1); + replace (- (PI / 2) + - (PI / 2)) with (- PI). +intro H5; + generalize + (Rmult_le_compat_l (/ 2) (- PI) (x + y) + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5). +replace (/ 2 * (x + y)) with ((x + y) / 2). +replace (/ 2 * - PI) with (- (PI / 2)). +clear H5; intro H5; elim H4; intro H40. +elim H5; intro H50. +generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6; + generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6). +rewrite Rmult_0_r. +clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7. +assumption. +generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7; + generalize + (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2)) + (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8; + generalize + (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3); + intro H9; elim (Rlt_irrefl 0 H9). +rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3; + rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + elim (Rlt_irrefl 0 H3). +unfold Rdiv in H3. +rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50; + rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + elim (Rlt_irrefl 0 H3). +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rmult_comm. +unfold Rdiv in |- *; apply Rmult_comm. +pattern PI at 1 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +reflexivity. +Qed. + +Lemma sin_increasing_1 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y. +intros; generalize (Rplus_lt_compat_l x x y H3); intro H4; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H); + replace (- (PI / 2) + - (PI / 2)) with (- PI). +assert (Hyp : 0 < 2). +prove_sup0. +intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6; + generalize + (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6); + replace (/ 2 * - PI) with (- (PI / 2)). +replace (/ 2 * (x + y)) with ((x + y) / 2). +clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5; + rewrite Rplus_comm in H5; + generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2). +rewrite <- double_var. +intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7; + generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7); + replace (/ 2 * PI) with (PI / 2). +replace (/ 2 * (x + y)) with ((x + y) / 2). +clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1); + rewrite Ropp_involutive; clear H1; intro H1; + generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1; + generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; + intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); + clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3); + replace (- y + x) with (x - y). +rewrite Rplus_opp_l. +intro H6; + generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6); + rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2). +clear H6; intro H6; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2); + replace (- (PI / 2) + - (PI / 2)) with (- PI). +replace (x + - y) with (x - y). +intro H7; + generalize + (Rmult_le_compat_l (/ 2) (- PI) (x - y) + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7); + replace (/ 2 * - PI) with (- (PI / 2)). +replace (/ 2 * (x - y)) with ((x - y) / 2). +clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4; + generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8; + generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); + clear H8; intro H8; cut (- PI < - (PI / 2)). +intro H9; + generalize + (sin_lt_0_var ((x - y) / 2) + (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); + intro H10; + generalize + (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 ( + 2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11; + rewrite Rmult_comm; assumption. +apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm. +reflexivity. +pattern PI at 1 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +reflexivity. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rminus in |- *; apply Rplus_comm. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *; apply Rmult_comm. +unfold Rdiv in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rmult_comm. +pattern PI at 1 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +reflexivity. +Qed. + +Lemma sin_decreasing_0 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x. +intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3; + generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3); + repeat rewrite <- sin_neg; + generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); + generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); + generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); + generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); + replace (- PI + x) with (x - PI). +replace (- PI + PI / 2) with (- (PI / 2)). +replace (- PI + y) with (y - PI). +replace (- PI + 3 * (PI / 2)) with (PI / 2). +replace (- (PI - x)) with (x - PI). +replace (- (PI - y)) with (y - PI). +intros; change (sin (y - PI) < sin (x - PI)) in H8; + apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm; + replace (y + - PI) with (y - PI). +rewrite Rplus_comm; replace (x + - PI) with (x - PI). +apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8). +reflexivity. +reflexivity. +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +ring. +unfold Rminus in |- *; apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var. +rewrite Ropp_plus_distr. +ring. +unfold Rminus in |- *; apply Rplus_comm. +Qed. + +Lemma sin_decreasing_1 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x. +intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y); + generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); + generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); + generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); + generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); + generalize (Rplus_lt_compat_l (- PI) x y H3); + replace (- PI + PI / 2) with (- (PI / 2)). +replace (- PI + y) with (y - PI). +replace (- PI + 3 * (PI / 2)) with (PI / 2). +replace (- PI + x) with (x - PI). +intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg; + replace (- (PI - x)) with (x - PI). +replace (- (PI - y)) with (y - PI). +apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4). +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +unfold Rminus in |- *; rewrite Ropp_plus_distr. +rewrite Ropp_involutive. +apply Rplus_comm. +unfold Rminus in |- *; apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var; ring. +unfold Rminus in |- *; apply Rplus_comm. +pattern PI at 2 in |- *; rewrite double_var; ring. +Qed. + +Lemma cos_increasing_0 : + forall x y:R, + PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y. +intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y); + rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); + unfold INR in |- *; + replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). +replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). +repeat rewrite cos_shift; intro H5; + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4). +replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). +replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). +replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). +replace (-3 * (PI / 2) + PI) with (- (PI / 2)). +clear H1 H2 H3 H4; intros H1 H2 H3 H4; + apply Rplus_lt_reg_r with (-3 * (PI / 2)); + replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). +replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). +apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5). +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +pattern PI at 3 in |- *; rewrite double_var. +ring. +rewrite double; pattern PI at 3 4 in |- *; rewrite double_var. +ring. +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +unfold Rminus in |- *. +rewrite Ropp_mult_distr_l_reverse. +apply Rplus_comm. +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +Qed. + +Lemma cos_increasing_1 : + forall x y:R, + PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y. +intros x y H1 H2 H3 H4 H5; + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4); + generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5); + rewrite <- (cos_neg x); rewrite <- (cos_neg y); + rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); + unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). +replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). +replace (-3 * (PI / 2) + PI) with (- (PI / 2)). +replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). +clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5; + replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). +replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). +repeat rewrite cos_shift; + apply + (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1). +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +rewrite Rmult_1_r. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. +ring. +pattern PI at 3 in |- *; rewrite double_var; ring. +unfold Rminus in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rplus_comm. +unfold Rminus in |- *. +rewrite <- Ropp_mult_distr_l_reverse. +apply Rplus_comm. +Qed. + +Lemma cos_decreasing_0 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x. +intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3); + repeat rewrite <- neg_cos; intro H4; + change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4; + rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H); + generalize (Rplus_le_compat_l PI x PI H0); + generalize (Rplus_le_compat_l PI 0 y H1); + generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. +rewrite <- double. +clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI; + apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4). +Qed. + +Lemma cos_decreasing_1 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x. +intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos; + rewrite (Rplus_comm x); rewrite (Rplus_comm y); + generalize (Rplus_le_compat_l PI 0 x H); + generalize (Rplus_le_compat_l PI x PI H0); + generalize (Rplus_le_compat_l PI 0 y H1); + generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. +rewrite <- double. +generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros; + apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H). +Qed. + +Lemma tan_diff : + forall x y:R, + cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y). +intros; unfold tan in |- *; rewrite sin_minus. +unfold Rdiv in |- *. +unfold Rminus in |- *. +rewrite Rmult_plus_distr_r. +rewrite Rinv_mult_distr. +repeat rewrite (Rmult_comm (sin x)). +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (cos y)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +rewrite (Rmult_comm (sin x)). +apply Rplus_eq_compat_l. +rewrite <- Ropp_mult_distr_l_reverse. +rewrite <- Ropp_mult_distr_r_reverse. +rewrite (Rmult_comm (/ cos x)). +repeat rewrite Rmult_assoc. +rewrite (Rmult_comm (cos x)). +repeat rewrite Rmult_assoc. +rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +reflexivity. +assumption. +assumption. +assumption. +assumption. +Qed. + +Lemma tan_increasing_0 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y. +intros; generalize PI4_RLT_PI2; intro H4; + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + intro H5; change (- (PI / 2) < - (PI / 4)) in H5; + generalize + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; + generalize + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos x) + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + intro H6; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos y) + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + intro H7; generalize (tan_diff x y H6 H7); intro H8; + generalize (Rlt_minus (tan x) (tan y) H3); clear H3; + intro H3; rewrite H8 in H3; cut (sin (x - y) < 0). +intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1); + rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10); + clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + clear H11; intro H11; + generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); + generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10); + replace (x + - y) with (x - y). +replace (PI / 4 + PI / 4) with (PI / 2). +replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). +intros; case (Rtotal_order 0 (x - y)); intro H14. +generalize + (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI)); + intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)). +elim H14; intro H15. +rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). +apply Rminus_lt; assumption. +pattern PI at 1 in |- *; rewrite double_var. +unfold Rdiv in |- *. +rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +rewrite Ropp_plus_distr. +replace 4 with 4. +reflexivity. +ring. +discrR. +discrR. +pattern PI at 1 in |- *; rewrite double_var. +unfold Rdiv in |- *. +rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +replace 4 with 4. +reflexivity. +ring. +discrR. +discrR. +reflexivity. +case (Rcase_abs (sin (x - y))); intro H9. +assumption. +generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9; + generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; + generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; + generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); + replace (/ cos x * / cos y) with (/ (cos x * cos y)). +intro H12; + generalize + (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9 + (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13; + elim + (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)). +rewrite Rinv_mult_distr. +reflexivity. +assumption. +assumption. +Qed. + +Lemma tan_increasing_1 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y. +intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4; + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + intro H5; change (- (PI / 2) < - (PI / 4)) in H5; + generalize + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; + generalize + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos x) + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + intro H6; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos y) + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + intro H7; rewrite (tan_diff x y H6 H7); + generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; + generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; + generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); + replace (/ cos x * / cos y) with (/ (cos x * cos y)). +clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + clear H11; intro H11; + generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); + replace (x + - y) with (x - y). +replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). +clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3; + clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; + intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); + clear H1; intro H1; + generalize + (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3); + intro H2; + generalize + (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8); + rewrite Rmult_0_r; intro H4; assumption. +pattern PI at 1 in |- *; rewrite double_var. +unfold Rdiv in |- *. +rewrite Rmult_plus_distr_r. +repeat rewrite Rmult_assoc. +rewrite <- Rinv_mult_distr. +replace 4 with 4. +rewrite Ropp_plus_distr. +reflexivity. +ring. +discrR. +discrR. +reflexivity. +apply Rinv_mult_distr; assumption. +Qed. + +Lemma sin_incr_0 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y. +intros; case (Rtotal_order (sin x) (sin y)); intro H4; + [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ] + | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. +Qed. + +Lemma sin_incr_1 : + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (sin x) (sin y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma sin_decr_0 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> + y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x. +intros; case (Rtotal_order (sin x) (sin y)); intro H4; + [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. +Qed. + +Lemma sin_decr_1 : + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> + y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (sin x) (sin y)); intro H6; + [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma cos_incr_0 : + forall x y:R, + PI <= x -> + x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y. +intros; case (Rtotal_order (cos x) (cos y)); intro H4; + [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ] + | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. +Qed. + +Lemma cos_incr_1 : + forall x y:R, + PI <= x -> + x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (cos x) (cos y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma cos_decr_0 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x. +intros; case (Rtotal_order (cos x) (cos y)); intro H4; + [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. +Qed. + +Lemma cos_decr_1 : + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (cos x) (cos y)); intro H6; + [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. +Qed. + +Lemma tan_incr_0 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y. +intros; case (Rtotal_order (tan x) (tan y)); intro H4; + [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ] + | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ]. +Qed. + +Lemma tan_incr_1 : + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y. +intros; case (Rtotal_order x y); intro H4; + [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (tan x) (tan y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. (**********) -Lemma sin_eq_0_1 : (x:R) (EXT k:Z | x==(Rmult (IZR k) PI)) -> (sin x)==R0. -Intros. -Elim H; Intros. -Apply (Zcase_sign x0). -Intro. -Rewrite H1 in H0. -Simpl in H0. -Rewrite H0; Rewrite Rmult_Ol; Apply sin_0. -Intro. -Cut `0<=x0`. -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. -Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``). -Rewrite sin_period. -Apply sin_0. -Rewrite H5. -Rewrite S_INR; Rewrite mult_INR. -Simpl. -Rewrite Rmult_Rplus_distrl. -Rewrite Rmult_1l; Rewrite sin_plus. -Rewrite sin_PI. -Rewrite Rmult_Or. -Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``). -Rewrite sin_period. -Rewrite sin_0; Ring. -Apply le_IZR. -Left; Apply IZR_lt. -Assert H2 := Zgt_iff_lt. -Elim (H2 x0 `0`); Intros. -Apply H3; Assumption. -Intro. -Rewrite H0. -Replace ``(sin ((IZR x0)*PI))`` with ``-(sin (-(IZR x0)*PI))``. -Cut `0<=-x0`. -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. -Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``). -Rewrite sin_period. -Rewrite sin_0; Ring. -Rewrite H5. -Rewrite S_INR; Rewrite mult_INR. -Simpl. -Rewrite Rmult_Rplus_distrl. -Rewrite Rmult_1l; Rewrite sin_plus. -Rewrite sin_PI. -Rewrite Rmult_Or. -Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``). -Rewrite sin_period. -Rewrite sin_0; Ring. -Apply le_IZR. -Apply Rle_anti_compatibility with ``(IZR x0)``. -Rewrite Rplus_Or. -Rewrite Ropp_Ropp_IZR. -Rewrite Rplus_Ropp_r. -Left; Replace R0 with (IZR `0`); [Apply IZR_lt | Reflexivity]. -Assumption. -Rewrite <- sin_neg. -Rewrite Ropp_mul1. -Rewrite Ropp_Ropp. -Reflexivity. -Qed. - -Lemma sin_eq_0_0 : (x:R) (sin x)==R0 -> (EXT k:Z | x==(Rmult (IZR k) PI)). -Intros. -Assert H0 := (euclidian_division x PI PI_neq0). -Elim H0; Intros q H1. -Elim H1; Intros r H2. -Exists q. -Cut r==R0. -Intro. -Elim H2; Intros H4 _; Rewrite H4; Rewrite H3. -Apply Rplus_Or. -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_Ol in H. -Rewrite Rplus_Ol in H. -Assert H6 := (without_div_Od ? ? H). -Elim H6; Intro. -Assert H8 := (sin2_cos2 ``(IZR q)*PI``). -Rewrite H5 in H8; Rewrite H7 in H8. -Rewrite Rsqr_O in H8. -Rewrite Rplus_Or in H8. -Elim R1_neq_R0; Symmetry; Assumption. -Cut r==R0\/``0<r<PI``. -Intro; Elim H8; Intro. -Assumption. -Elim H9; Intros. -Assert H12 := (sin_gt_0 ? H10 H11). -Rewrite H7 in H12; Elim (Rlt_antirefl ? H12). -Rewrite Rabsolu_right in H4. -Elim H4; Intros. -Case (total_order R0 r); Intro. -Right; Split; Assumption. -Elim H10; Intro. -Left; Symmetry; Assumption. -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 H11)). -Apply Rle_sym1. -Left; Apply PI_RGT_0. -Apply sin_eq_0_1. -Exists q; Reflexivity. -Qed. - -Lemma cos_eq_0_0 : (x:R) (cos x)==R0 -> (EXT k : Z | ``x==(IZR k)*PI+PI/2``). -Intros x H; Rewrite -> cos_sin in H; Generalize (sin_eq_0_0 (Rplus (Rdiv PI (INR (2))) x) H); Intro H2; Elim H2; Intros x0 H3; Exists (Zminus x0 (inject_nat (S O))); Rewrite <- Z_R_minus; Ring; Rewrite Rmult_sym; Rewrite <- H3; Unfold INR. -Rewrite (double_var ``-PI``); Unfold Rdiv; Ring. -Qed. - -Lemma cos_eq_0_1 : (x:R) (EXT k : Z | ``x==(IZR k)*PI+PI/2``) -> ``(cos x)==0``. -Intros x H1; Rewrite cos_sin; Elim H1; Intros x0 H2; Rewrite H2; Replace ``PI/2+((IZR x0)*PI+PI/2)`` with ``(IZR x0)*PI+PI``. -Rewrite neg_sin; Rewrite <- Ropp_O. -Apply eq_Ropp; Apply sin_eq_0_1; Exists x0; Reflexivity. -Pattern 2 PI; Rewrite (double_var PI); Ring. -Qed. - -Lemma sin_eq_O_2PI_0 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``(sin x)==0`` -> ``x==0``\/``x==PI``\/``x==2*PI``. -Intros; Generalize (sin_eq_0_0 x H1); Intro. -Elim H2; Intros k0 H3. -Case (total_order PI x); Intro. -Rewrite H3 in H4; Rewrite H3 in H0. -Right; Right. -Generalize (Rlt_monotony_r ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv ``PI`` PI_RGT_0) H4); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``(IZR k0)*PI`` ``2*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H0); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym. -Repeat Rewrite Rmult_1r; Intro; Generalize (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H5); Rewrite <- plus_IZR. -Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``. -Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``2`` H6); Rewrite <- plus_IZR. -Replace ``(IZR (NEG (xO xH)))+2`` with ``0``. -Intro; Cut ``-1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``. -Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H9); Intro. -Cut k0=`2`. -Intro; Rewrite H11 in H3; Rewrite H3; Simpl. -Reflexivity. -Rewrite <- (Zplus_inverse_l `2`) in H10; Generalize (Zsimpl_plus_l `-2` k0 `2` H10); Intro; Assumption. -Split. -Assumption. -Apply Rle_lt_trans with ``0``. -Assumption. -Apply Rlt_R0_R1. -Simpl; Ring. -Simpl; Ring. -Apply PI_neq0. -Apply PI_neq0. -Elim H4; Intro. -Right; Left. -Symmetry; Assumption. -Left. -Rewrite H3 in H5; Rewrite H3 in H; Generalize (Rlt_monotony_r ``/PI`` ``(IZR k0)*PI`` PI (Rlt_Rinv ``PI`` PI_RGT_0) H5); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``0`` ``(IZR k0)*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Rewrite Rmult_Ol; Intro. -Cut ``-1 < (IZR (k0)) < 1``. -Intro; Generalize (one_IZR_lt1 k0 H8); Intro; Rewrite H9 in H3; Rewrite H3; Simpl; Apply Rmult_Ol. -Split. -Apply Rlt_le_trans with ``0``. -Rewrite <- Ropp_O; Apply Rgt_Ropp; Apply Rlt_R0_R1. -Assumption. -Assumption. -Apply PI_neq0. -Apply PI_neq0. -Qed. - -Lemma sin_eq_O_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==0``\/``x==PI``\/``x==2*PI`` -> ``(sin x)==0``. -Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> sin_0; Reflexivity | Elim H4; Intro H5; [Rewrite H5; Rewrite -> sin_PI; Reflexivity | Rewrite H5; Rewrite -> sin_2PI; Reflexivity]]. -Qed. - -Lemma cos_eq_0_2PI_0 : (x:R) ``R0<=x`` -> ``x<=2*PI`` -> ``(cos x)==0`` -> ``x==(PI/2)``\/``x==3*(PI/2)``. -Intros; Case (total_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 (Rle_compatibility ``PI/2`` ``0`` x H); Rewrite Rplus_Or; Rewrite H6; Intro. -Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``PI/2`` ``0`` PI2_RGT_0 H7)). -Left. -Generalize (Rplus_plus_r ``-(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 3 PI; Rewrite (double_var PI); Ring. -Ring. -Right. -Generalize (Rplus_plus_r ``-(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 3 4 PI; Rewrite (double_var PI); Ring. -Ring. -Left; Replace ``2*PI`` with ``PI/2+3*(PI/2)``. -Apply Rlt_compatibility; Assumption. -Rewrite (double PI); Pattern 3 4 PI; Rewrite (double_var PI); Ring. -Apply ge0_plus_ge0_is_ge0. -Left; Unfold Rdiv; Apply Rmult_lt_pos. -Apply PI_RGT_0. -Apply Rlt_Rinv; 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 (Rlt_compatibility ``-(PI/2)`` ``3*PI/2`` ``(IZR k0)*PI+PI/2`` H3); Generalize (Rle_compatibility ``-(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 (Rlt_monotony ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv PI PI_RGT_0) H7); Generalize (Rle_monotony ``/PI`` ``(IZR k0)*PI`` ``3*(PI/2)`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv 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 (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H9); Rewrite <- plus_IZR. -Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``. -Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``3*/2`` H8); Rewrite <- plus_IZR. -Replace ``(IZR (NEG (xO xH)))+2`` with ``0``. -Intro; Cut `` -1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``. -Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H12); Intro. -Cut k0=`2`. -Intro; Rewrite H14 in H8. -Assert Hyp : ``0<2``. -Sup0. -Generalize (Rle_monotony ``2`` ``(IZR (POS (xO xH)))`` ``3*/2`` (Rlt_le ``0`` ``2`` Hyp) H8); Simpl. -Replace ``2*2`` with ``4``. -Replace ``2*(3*/2)`` with ``3``. -Intro; Cut ``3<4``. -Intro; Elim (Rlt_antirefl ``3`` (Rlt_le_trans ``3`` ``4`` ``3`` H16 H15)). -Generalize (Rlt_compatibility ``3`` ``0`` ``1`` Rlt_R0_R1); Rewrite Rplus_Or. -Replace ``3+1`` with ``4``. -Intro; Assumption. -Ring. -Symmetry; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m. -DiscrR. -Ring. -Rewrite <- (Zplus_inverse_l `2`) in H13; Generalize (Zsimpl_plus_l `-2` k0 `2` H13); Intro; Assumption. -Split. -Assumption. -Apply Rle_lt_trans with ``(IZR (NEG (xO xH)))+3*/2``. -Assumption. -Simpl; Replace ``-2+3*/2`` with ``-(1*/2)``. -Apply Rlt_trans with ``0``. -Rewrite <- Ropp_O; Apply Rlt_Ropp. -Apply Rmult_lt_pos; [Apply Rlt_R0_R1 | Apply Rlt_Rinv; Sup0]. -Apply Rlt_R0_R1. -Rewrite Rmult_1l; Apply r_Rmult_mult with ``2``. -Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym. -Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m. -Ring. -DiscrR. -DiscrR. -DiscrR. -Simpl; Ring. -Simpl; Ring. -Apply PI_neq0. -Unfold Rdiv; Pattern 1 ``3``; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Apply Rmult_sym. -Apply PI_neq0. -Symmetry; Rewrite (Rmult_sym ``/PI``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Apply Rmult_1r. -Apply PI_neq0. -Rewrite double; Pattern 3 4 PI; Rewrite double_var; Ring. -Ring. -Pattern 1 PI; Rewrite double_var; Ring. -Qed. - -Lemma cos_eq_0_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==PI/2``\/``x==3*(PI/2)`` -> ``(cos x)==0``. -Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> cos_PI2; Reflexivity | Rewrite H4; Rewrite -> cos_3PI2; Reflexivity ]. -Qed. +Lemma sin_eq_0_1 : forall x:R, ( exists k : Z | x = IZR k * PI) -> sin x = 0. +intros. +elim H; intros. +apply (Zcase_sign x0). +intro. +rewrite H1 in H0. +simpl in H0. +rewrite H0; rewrite Rmult_0_l; apply sin_0. +intro. +cut (0 <= x0)%Z. +intro. +elim (IZN x0 H2); intros. +rewrite H3 in H0. +rewrite <- INR_IZR_INZ in H0. +rewrite H0. +elim (even_odd_cor x1); intros. +elim H4; intro. +rewrite H5. +rewrite mult_INR. +simpl in |- *. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +apply sin_0. +rewrite H5. +rewrite S_INR; rewrite mult_INR. +simpl in |- *. +rewrite Rmult_plus_distr_r. +rewrite Rmult_1_l; rewrite sin_plus. +rewrite sin_PI. +rewrite Rmult_0_r. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +rewrite sin_0; ring. +apply le_IZR. +left; apply IZR_lt. +assert (H2 := Zorder.Zgt_iff_lt). +elim (H2 x0 0%Z); intros. +apply H3; assumption. +intro. +rewrite H0. +replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)). +cut (0 <= - x0)%Z. +intro. +rewrite <- Ropp_Ropp_IZR. +elim (IZN (- x0) H2); intros. +rewrite H3. +rewrite <- INR_IZR_INZ. +elim (even_odd_cor x1); intros. +elim H4; intro. +rewrite H5. +rewrite mult_INR. +simpl in |- *. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +rewrite sin_0; ring. +rewrite H5. +rewrite S_INR; rewrite mult_INR. +simpl in |- *. +rewrite Rmult_plus_distr_r. +rewrite Rmult_1_l; rewrite sin_plus. +rewrite sin_PI. +rewrite Rmult_0_r. +rewrite <- (Rplus_0_l (2 * INR x2 * PI)). +rewrite sin_period. +rewrite sin_0; ring. +apply le_IZR. +apply Rplus_le_reg_l with (IZR x0). +rewrite Rplus_0_r. +rewrite Ropp_Ropp_IZR. +rewrite Rplus_opp_r. +left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ]. +assumption. +rewrite <- sin_neg. +rewrite Ropp_mult_distr_l_reverse. +rewrite Ropp_involutive. +reflexivity. +Qed. + +Lemma sin_eq_0_0 : forall x:R, sin x = 0 -> exists k : Z | x = IZR k * PI. +intros. +assert (H0 := euclidian_division x PI PI_neq0). +elim H0; intros q H1. +elim H1; intros r H2. +exists q. +cut (r = 0). +intro. +elim H2; intros H4 _; rewrite H4; rewrite H3. +apply Rplus_0_r. +elim H2; intros. +rewrite H3 in H. +rewrite sin_plus in H. +cut (sin (IZR q * PI) = 0). +intro. +rewrite H5 in H. +rewrite Rmult_0_l in H. +rewrite Rplus_0_l in H. +assert (H6 := Rmult_integral _ _ H). +elim H6; intro. +assert (H8 := sin2_cos2 (IZR q * PI)). +rewrite H5 in H8; rewrite H7 in H8. +rewrite Rsqr_0 in H8. +rewrite Rplus_0_r in H8. +elim R1_neq_R0; symmetry in |- *; assumption. +cut (r = 0 \/ 0 < r < PI). +intro; elim H8; intro. +assumption. +elim H9; intros. +assert (H12 := sin_gt_0 _ H10 H11). +rewrite H7 in H12; elim (Rlt_irrefl _ H12). +rewrite Rabs_right in H4. +elim H4; intros. +case (Rtotal_order 0 r); intro. +right; split; assumption. +elim H10; intro. +left; symmetry in |- *; assumption. +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)). +apply Rle_ge. +left; apply PI_RGT_0. +apply sin_eq_0_1. +exists q; reflexivity. +Qed. + +Lemma cos_eq_0_0 : + forall x:R, cos x = 0 -> exists k : Z | x = IZR k * PI + PI / 2. +intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H); + intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z; + rewrite <- Z_R_minus; ring; rewrite Rmult_comm; rewrite <- H3; + unfold INR in |- *. +rewrite (double_var (- PI)); unfold Rdiv in |- *; ring. +Qed. + +Lemma cos_eq_0_1 : + forall x:R, ( exists k : Z | x = IZR k * PI + PI / 2) -> cos x = 0. +intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2; + replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI). +rewrite neg_sin; rewrite <- Ropp_0. +apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity. +pattern PI at 2 in |- *; rewrite (double_var PI); ring. +Qed. + +Lemma sin_eq_O_2PI_0 : + forall x:R, + 0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI. +intros; generalize (sin_eq_0_0 x H1); intro. +elim H2; intros k0 H3. +case (Rtotal_order PI x); intro. +rewrite H3 in H4; rewrite H3 in H0. +right; right. +generalize + (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4); + rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; intro; + generalize + (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0); + repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +repeat rewrite Rmult_1_r; intro; + generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); + rewrite <- plus_IZR. +replace (IZR (-2) + 1) with (-1). +intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6); + rewrite <- plus_IZR. +replace (IZR (-2) + 2) with 0. +intro; cut (-1 < IZR (-2 + k0) < 1). +intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro. +cut (k0 = 2%Z). +intro; rewrite H11 in H3; rewrite H3; simpl in |- *. +reflexivity. +rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10); + intro; assumption. +split. +assumption. +apply Rle_lt_trans with 0. +assumption. +apply Rlt_0_1. +simpl in |- *; ring. +simpl in |- *; ring. +apply PI_neq0. +apply PI_neq0. +elim H4; intro. +right; left. +symmetry in |- *; assumption. +left. +rewrite H3 in H5; rewrite H3 in H; + generalize + (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0) + H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; intro; + generalize + (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H); + repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; rewrite Rmult_0_l; intro. +cut (-1 < IZR k0 < 1). +intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3; + simpl in |- *; apply Rmult_0_l. +split. +apply Rlt_le_trans with 0. +rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1. +assumption. +assumption. +apply PI_neq0. +apply PI_neq0. +Qed. + +Lemma sin_eq_O_2PI_1 : + forall x:R, + 0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0. +intros x H1 H2 H3; elim H3; intro H4; + [ rewrite H4; rewrite sin_0; reflexivity + | elim H4; intro H5; + [ rewrite H5; rewrite sin_PI; reflexivity + | rewrite H5; rewrite sin_2PI; reflexivity ] ]. +Qed. + +Lemma cos_eq_0_2PI_0 : + forall x:R, + 0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2). +intros; case (Rtotal_order x (3 * (PI / 2))); intro. +rewrite cos_sin in H1. +cut (0 <= PI / 2 + x). +cut (PI / 2 + x <= 2 * PI). +intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros. +decompose [or] H5. +generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6; + intro. +elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)). +left. +generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7). +replace (- (PI / 2) + (PI / 2 + x)) with x. +replace (- (PI / 2) + PI) with (PI / 2). +intro; assumption. +pattern PI at 3 in |- *; rewrite (double_var PI); ring. +ring. +right. +generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7). +replace (- (PI / 2) + (PI / 2 + x)) with x. +replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). +intro; assumption. +rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. +ring. +left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)). +apply Rplus_lt_compat_l; assumption. +rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. +apply Rplus_le_le_0_compat. +left; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply PI_RGT_0. +apply Rinv_0_lt_compat; prove_sup0. +assumption. +elim H2; intro. +right; assumption. +generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5. +rewrite H5 in H3; rewrite H5 in H0; + generalize + (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3); + generalize + (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0). +replace (- (PI / 2) + 3 * (PI / 2)) with PI. +replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI). +replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). +intros; + generalize + (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) + H7); + generalize + (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2)) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6). +replace (/ PI * (IZR k0 * PI)) with (IZR k0). +replace (/ PI * (3 * (PI / 2))) with (3 * / 2). +rewrite <- Rinv_l_sym. +intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9); + rewrite <- plus_IZR. +replace (IZR (-2) + 1) with (-1). +intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8); + rewrite <- plus_IZR. +replace (IZR (-2) + 2) with 0. +intro; cut (-1 < IZR (-2 + k0) < 1). +intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro. +cut (k0 = 2%Z). +intro; rewrite H14 in H8. +assert (Hyp : 0 < 2). +prove_sup0. +generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8); + simpl in |- *. +replace 4 with 4. +replace (2 * (3 * / 2)) with 3. +intro; cut (3 < 4). +intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)). +generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r. +replace (3 + 1) with 4. +intro; assumption. +ring. +symmetry in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +discrR. +ring. +rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13); + intro; assumption. +split. +assumption. +apply Rle_lt_trans with (IZR (-2) + 3 * / 2). +assumption. +simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)). +apply Rlt_trans with 0. +rewrite <- Ropp_0; apply Ropp_lt_gt_contravar. +apply Rmult_lt_0_compat; + [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ]. +apply Rlt_0_1. +rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2. +rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym. +rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. +ring. +discrR. +discrR. +discrR. +simpl in |- *; ring. +simpl in |- *; ring. +apply PI_neq0. +unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; apply Rmult_comm. +apply PI_neq0. +symmetry in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +apply Rmult_1_r. +apply PI_neq0. +rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring. +ring. +pattern PI at 1 in |- *; rewrite double_var; ring. +Qed. + +Lemma cos_eq_0_2PI_1 : + forall x:R, + 0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0. +intros x H1 H2 H3; elim H3; intro H4; + [ rewrite H4; rewrite cos_PI2; reflexivity + | rewrite H4; rewrite cos_3PI2; reflexivity ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v index 4fdc39106..c1ffc68ea 100644 --- a/theories/Reals/Rtrigo_alt.v +++ b/theories/Reals/Rtrigo_alt.v @@ -8,287 +8,419 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo_def. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_def. Open Local Scope R_scope. (*****************************************************************) (* Using series definitions of cos and sin *) (*****************************************************************) -Definition sin_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``. +Definition sin_term (a:R) (i:nat) : R := + (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1))). -Definition cos_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (mult (S (S O)) i))/(INR (fact (mult (S (S O)) i)))``. +Definition cos_term (a:R) (i:nat) : R := + (-1) ^ i * (a ^ (2 * i) / INR (fact (2 * i))). -Definition sin_approx [a:R;n:nat] : R := (sum_f_R0 (sin_term a) n). +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). +Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n. (**********) -Lemma PI_4 : ``PI<=4``. -Assert H0 := (PI_ineq O). -Elim H0; Clear H0; Intros _ H0. -Unfold tg_alt PI_tg in H0; Simpl in H0. -Rewrite Rinv_R1 in H0; Rewrite Rmult_1r in H0; Unfold Rdiv in H0. -Apply Rle_monotony_contra with ``/4``. -Apply Rlt_Rinv; Sup0. -Rewrite <- Rinv_l_sym; [Rewrite Rmult_sym; Assumption | DiscrR]. +Lemma PI_4 : PI <= 4. +assert (H0 := PI_ineq 0). +elim H0; clear H0; intros _ H0. +unfold tg_alt, PI_tg in H0; simpl in H0. +rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0. +apply Rmult_le_reg_l with (/ 4). +apply Rinv_0_lt_compat; prove_sup0. +rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ]. Qed. (**********) -Theorem sin_bound : (a:R; n:nat) ``0 <= a``->``a <= PI``->``(sin_approx a (plus (mult (S (S O)) n) (S O))) <= (sin a)<= (sin_approx a (mult (S (S O)) (plus n (S O))))``. -Intros; Case (Req_EM a R0); Intro Hyp_a. -Rewrite Hyp_a; Rewrite sin_0; Split; Right; Unfold sin_approx; Apply sum_eq_R0 Orelse (Symmetry; Apply sum_eq_R0); Intros; Unfold sin_term; Rewrite pow_add; Simpl; Unfold Rdiv; Rewrite Rmult_Ol; Ring. -Unfold sin_approx; Cut ``0<a``. -Intro Hyp_a_pos. -Rewrite (decomp_sum (sin_term a) (plus (mult (S (S O)) n) (S O))). -Rewrite (decomp_sum (sin_term a) (mult (S (S O)) (plus n (S O)))). -Replace (sin_term a O) with a. -Cut (Rle (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O)))) ``(sin a)-a``)/\(Rle ``(sin a)-a`` (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O)))))) -> (Rle (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O))))) (sin a))/\(Rle (sin a) (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O))))))). -Intro; Apply H1. -Pose Un := [n:nat]``(pow a (plus (mult (S (S O)) (S n)) (S O)))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))``. -Replace (pred (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) n). -Replace (pred (mult (S (S O)) (plus n (S O)))) with (S (mult (S (S O)) n)). -Replace (sum_f_R0 [i:nat](sin_term a (S i)) (mult (S (S O)) n)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``. -Replace (sum_f_R0 [i:nat](sin_term a (S i)) (S (mult (S (S O)) n))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``. -Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))<=a-(sin a)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n)) <= (sin a)-a <= -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``. -Intro; Apply H2. -Apply alternated_series_ineq. -Unfold Un_decreasing Un; Intro; Cut (plus (mult (S (S O)) (S (S n0))) (S O))=(S (S (plus (mult (S (S O)) (S n0)) (S O)))). -Intro; Rewrite H3. -Replace ``(pow a (S (S (plus (mult (S (S O)) (S n0)) (S O)))))`` with ``(pow a (plus (mult (S (S O)) (S n0)) (S O)))*(a*a)``. -Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply pow_lt; Assumption. -Apply Rle_monotony_contra with ``(INR (fact (S (S (plus (mult (S (S O)) (S n0)) (S O))))))``. -Rewrite <- H3; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H5 := (sym_eq ? ? ? H4); Elim (fact_neq_0 ? H5). -Rewrite <- H3; Rewrite (Rmult_sym ``(INR (fact (plus (mult (S (S O)) (S (S n0))) (S O))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite H3; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r. -Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Simpl; Replace ``((0+1+1)*((INR n0)+1)+(0+1)+1+1)*((0+1+1)*((INR n0)+1)+(0+1)+1)`` with ``4*(INR n0)*(INR n0)+18*(INR n0)+20``; [Idtac | Ring]. -Apply Rle_trans with ``20``. -Apply Rle_trans with ``16``. -Replace ``16`` with ``(Rsqr 4)``; [Idtac | SqRing]. -Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity]. -Apply Rsqr_incr_1. -Apply Rle_trans with PI; [Assumption | Apply PI_4]. -Assumption. -Left; Sup0. -Rewrite <- (Rplus_Or ``16``); Replace ``20`` with ``16+4``; [Apply Rle_compatibility; Left; Sup0 | Ring]. -Rewrite <- (Rplus_sym ``20``); Pattern 1 ``20``; Rewrite <- Rplus_Or; Apply Rle_compatibility. -Apply ge0_plus_ge0_is_ge0. -Repeat Apply Rmult_le_pos. -Left; Sup0. -Left; Sup0. -Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Apply Rmult_le_pos. -Left; Sup0. -Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Simpl; Ring. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Assert H3 := (cv_speed_pow_fact a); Unfold Un; 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 (plus (mult (2) (S n0)) (1)) with (S (mult (2) (S n0))). -Unfold ge; Apply le_trans with (mult (2) (S n0)). -Apply le_trans with (mult (2) (S N)). -Apply le_trans with (mult (2) N). -Apply le_n_2n. -Apply mult_le; Apply le_n_Sn. -Apply mult_le; Apply le_n_S; Assumption. -Apply le_n_Sn. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Reflexivity. -Assert X := (exist_sin (Rsqr a)); Elim X; Intros. -Cut ``x==(sin a)/a``. -Intro; Rewrite H3 in p; Unfold sin_in in p; Unfold infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros. -Cut ``0<eps/(Rabsolu a)``. -Intro; Elim (p ? H5); Intros N H6. -Exists N; Intros. -Replace (sum_f_R0 (tg_alt Un) n0) with (Rmult a (Rminus R1 (sum_f_R0 [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)))). -Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym a); Rewrite (Rplus_sym ``-a``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rlt_monotony_contra with ``/(Rabsolu a)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Pattern 1 ``/(Rabsolu a)``; Rewrite <- (Rabsolu_Rinv a Hyp_a). -Rewrite <- Rabsolu_mult; Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l | Assumption]; Rewrite (Rmult_sym ``/a``); Rewrite (Rmult_sym ``/(Rabsolu a)``); Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus Rdiv in H6; Apply H6; Unfold ge; Apply le_trans with n0; [Exact H7 | Apply le_n_Sn]. -Rewrite (decomp_sum [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)). -Replace (sin_n O) with R1. -Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Rewrite scal_sum; Apply sum_eq. -Intros; Unfold sin_n Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``. -Replace ``(pow a (plus (mult (S (S O)) (S i)) (S O)))`` with ``(Rsqr a)*(pow (Rsqr a) i)*a``. -Unfold Rdiv; Ring. -Rewrite pow_add; Rewrite pow_Rsqr; Simpl; Ring. -Simpl; Ring. -Unfold sin_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity. -Apply lt_O_Sn. -Unfold Rdiv; Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Unfold sin; Case (exist_sin (Rsqr a)). -Intros; Cut x==x0. -Intro; Rewrite H3; Unfold Rdiv. -Symmetry; Apply Rinv_r_simpl_m; Assumption. -Unfold sin_in in p; Unfold sin_in in s; EApply unicity_sum. -Apply p. -Apply s. -Intros; Elim H2; Intros. -Replace ``(sin a)-a`` with ``-(a-(sin a))``; [Idtac | Ring]. -Split; Apply Rle_Ropp1; Assumption. -Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``; [Rewrite scal_sum | Ring]. -Apply sum_eq; Intros; Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``. -Unfold Rdiv; Ring. -Reflexivity. -Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``; [Rewrite scal_sum | Ring]. -Apply sum_eq; Intros. -Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``. -Unfold Rdiv; Ring. -Reflexivity. -Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))). -Reflexivity. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)). -Reflexivity. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Intro; Elim H1; Intros. -Split. -Apply Rle_anti_compatibility with ``-a``. -Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H2. -Apply Rle_anti_compatibility with ``-a``. -Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H3. -Unfold sin_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring. -Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))). -Apply lt_O_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)). -Apply lt_O_Sn. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Inversion H; [Assumption | Elim Hyp_a; Symmetry; Assumption]. +Theorem sin_bound : + forall (a:R) (n:nat), + 0 <= a -> + a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)). +intros; case (Req_dec a 0); intro Hyp_a. +rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *; + apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0); + intros; unfold sin_term in |- *; rewrite pow_add; + simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; + ring. +unfold sin_approx in |- *; cut (0 < a). +intro Hyp_a_pos. +rewrite (decomp_sum (sin_term a) (2 * n + 1)). +rewrite (decomp_sum (sin_term a) (2 * (n + 1))). +replace (sin_term a 0) with a. +cut + (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\ + sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) -> + a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\ + sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))). +intro; apply H1. +pose (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))). +replace (pred (2 * n + 1)) with (2 * n)%nat. +replace (pred (2 * (n + 1))) with (S (2 * n)). +replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with + (- sum_f_R0 (tg_alt Un) (2 * n)). +replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with + (- sum_f_R0 (tg_alt Un) (S (2 * n))). +cut + (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <= + sum_f_R0 (tg_alt Un) (2 * n) -> + - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <= + - sum_f_R0 (tg_alt Un) (S (2 * n))). +intro; apply H2. +apply alternated_series_ineq. +unfold Un_decreasing, Un in |- *; intro; + cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))). +intro; rewrite H3. +replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +left; apply pow_lt; assumption. +apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))). +rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5). +rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1)))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r. +do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + simpl in |- *; + replace + (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) * + ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with + (4 * INR n0 * INR n0 + 18 * INR n0 + 20); [ idtac | ring ]. +apply Rle_trans with 20. +apply Rle_trans with 16. +replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ]. +replace (a * a) with (Rsqr a); [ idtac | reflexivity ]. +apply Rsqr_incr_1. +apply Rle_trans with PI; [ assumption | apply PI_4 ]. +assumption. +left; prove_sup0. +rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4); + [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. +rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +apply Rplus_le_le_0_compat. +repeat apply Rmult_le_pos. +left; prove_sup0. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply Rmult_le_pos. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; + do 2 rewrite mult_INR; repeat rewrite S_INR; ring. +assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3; + unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; + intros; elim (H3 eps H4); intros N H5. +exists N; intros; apply H5. +replace (2 * S n0 + 1)%nat with (S (2 * S n0)). +unfold ge in |- *; apply le_trans with (2 * S n0)%nat. +apply le_trans with (2 * S N)%nat. +apply le_trans with (2 * N)%nat. +apply le_n_2n. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. +apply le_n_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; reflexivity. +assert (X := exist_sin (Rsqr a)); elim X; intros. +cut (x = sin a / a). +intro; rewrite H3 in p; unfold sin_in in p; unfold infinit_sum in p; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + intros. +cut (0 < eps / Rabs a). +intro; elim (p _ H5); intros N H6. +exists N; intros. +replace (sum_f_R0 (tg_alt Un) n0) with + (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))). +unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + repeat rewrite Rplus_assoc; rewrite (Rplus_comm a); + rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a). +rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ]; + rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a)); + rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *; + apply le_trans with n0; [ exact H7 | apply le_n_Sn ]. +rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)). +replace (sin_n 0) with 1. +simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse; + rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; + apply sum_eq. +intros; unfold sin_n, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (- (-1) ^ i). +replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a). +unfold Rdiv in |- *; ring. +rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring. +simpl in |- *; ring. +unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; reflexivity. +apply lt_O_Sn. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +unfold sin in |- *; case (exist_sin (Rsqr a)). +intros; cut (x = x0). +intro; rewrite H3; unfold Rdiv in |- *. +symmetry in |- *; apply Rinv_r_simpl_m; assumption. +unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum. +apply p. +apply s. +intros; elim H2; intros. +replace (sin a - a) with (- (a - sin a)); [ idtac | ring ]. +split; apply Ropp_le_contravar; assumption. +replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with + (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ]. +apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (- sum_f_R0 (tg_alt Un) (2 * n)) with + (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ]. +apply sum_eq; intros. +unfold sin_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (2 * (n + 1))%nat with (S (S (2 * n))). +reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n + 1)%nat with (S (2 * n)). +reflexivity. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +intro; elim H1; intros. +split. +apply Rplus_le_reg_l with (- a). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (- a)); apply H2. +apply Rplus_le_reg_l with (- a). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (- a)); apply H3. +unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; + ring. +replace (2 * (n + 1))%nat with (S (S (2 * n))). +apply lt_O_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n + 1)%nat with (S (2 * n)). +apply lt_O_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ]. Qed. (**********) -Lemma cos_bound : (a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``. -Cut ((a:R; n:nat) ``0 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``) -> ((a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``). -Intros H a n; Apply H. -Intros; Unfold cos_approx. -Rewrite (decomp_sum (cos_term a0) (plus (mult (S (S O)) n0) (S O))). -Rewrite (decomp_sum (cos_term a0) (mult (S (S O)) (plus n0 (S O)))). -Replace (cos_term a0 O) with R1. -Cut (Rle (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O)))) ``(cos a0)-1``)/\(Rle ``(cos a0)-1`` (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O)))))) -> (Rle (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O))))) (cos a0))/\(Rle (cos a0) (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O))))))). -Intro; Apply H2. -Pose Un := [n:nat]``(pow a0 (mult (S (S O)) (S n)))/(INR (fact (mult (S (S O)) (S n))))``. -Replace (pred (plus (mult (S (S O)) n0) (S O))) with (mult (S (S O)) n0). -Replace (pred (mult (S (S O)) (plus n0 (S O)))) with (S (mult (S (S O)) n0)). -Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (mult (S (S O)) n0)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``. -Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (S (mult (S (S O)) n0))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``. -Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))<=1-(cos a0)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0)) <= (cos a0)-1 <= -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``. -Intro; Apply H3. -Apply alternated_series_ineq. -Unfold Un_decreasing; Intro; Unfold Un. -Cut (mult (S (S O)) (S (S n1)))=(S (S (mult (S (S O)) (S n1)))). -Intro; Rewrite H4; Replace ``(pow a0 (S (S (mult (S (S O)) (S n1)))))`` with ``(pow a0 (mult (S (S O)) (S n1)))*(a0*a0)``. -Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony. -Apply pow_le; Assumption. -Apply Rle_monotony_contra with ``(INR (fact (S (S (mult (S (S O)) (S n1))))))``. -Rewrite <- H4; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H6 := (sym_eq ? ? ? H5); Elim (fact_neq_0 ? H6). -Rewrite <- H4; Rewrite (Rmult_sym ``(INR (fact (mult (S (S O)) (S (S n1)))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite H4; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Do 2 Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; 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]. -Apply Rle_trans with ``12``. -Apply Rle_trans with ``4``. -Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing]. -Replace ``a0*a0`` with (Rsqr a0); [Idtac | Reflexivity]. -Apply Rsqr_incr_1. -Apply Rle_trans with ``PI/2``. -Assumption. -Unfold Rdiv; Apply Rle_monotony_contra with ``2``. -Sup0. -Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m. -Replace ``2*2`` with ``4``; [Apply PI_4 | Ring]. -DiscrR. -Assumption. -Left; Sup0. -Pattern 1 ``4``; Rewrite <- Rplus_Or; Replace ``12`` with ``4+8``; [Apply Rle_compatibility; Left; Sup0 | Ring]. -Rewrite <- (Rplus_sym ``12``); Pattern 1 ``12``; Rewrite <- Rplus_Or; Apply Rle_compatibility. -Apply ge0_plus_ge0_is_ge0. -Repeat Apply Rmult_le_pos. -Left; Sup0. -Left; Sup0. -Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Apply Rmult_le_pos. -Left; Sup0. -Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity]. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Simpl; Ring. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Assert H4 := (cv_speed_pow_fact a0); Unfold Un; 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; Apply le_trans with (mult (2) (S N)). -Apply le_trans with (mult (2) N). -Apply le_n_2n. -Apply mult_le; Apply le_n_Sn. -Apply mult_le; Apply le_n_S; Assumption. -Assert X := (exist_cos (Rsqr a0)); Elim X; Intros. -Cut ``x==(cos a0)``. -Intro; Rewrite H4 in p; Unfold cos_in in p; Unfold infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros. -Elim (p ? H5); Intros N H6. -Exists N; Intros. -Replace (sum_f_R0 (tg_alt Un) n1) with (Rminus R1 (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1))). -Unfold Rminus; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym R1); Rewrite (Rplus_sym ``-1``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus in H6; Apply H6. -Unfold ge; Apply le_trans with n1. -Exact H7. -Apply le_n_Sn. -Rewrite (decomp_sum [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1)). -Replace (cos_n O) with R1. -Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Replace (Ropp (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)) with (Rmult ``-1`` (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)); [Idtac | Ring]; Rewrite scal_sum; Apply sum_eq; Intros; Unfold cos_n Un tg_alt. -Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``. -Replace ``(pow a0 (mult (S (S O)) (S i)))`` with ``(Rsqr a0)*(pow (Rsqr a0) i)``. -Unfold Rdiv; Ring. -Rewrite pow_Rsqr; Reflexivity. -Simpl; Ring. -Unfold cos_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity. -Apply lt_O_Sn. -Unfold cos; Case (exist_cos (Rsqr a0)); Intros; Unfold cos_in in p; Unfold cos_in in c; EApply unicity_sum. -Apply p. -Apply c. -Intros; Elim H3; Intros; Replace ``(cos a0)-1`` with ``-(1-(cos a0))``; [Idtac | Ring]. -Split; Apply Rle_Ropp1; Assumption. -Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``; [Rewrite scal_sum | Ring]. -Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``. -Unfold Rdiv; Ring. -Reflexivity. -Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``; [Rewrite scal_sum | Ring]; Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``. -Unfold Rdiv; Ring. -Reflexivity. -Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))). -Reflexivity. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring. -Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)). -Reflexivity. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Intro; Elim H2; Intros; Split. -Apply Rle_anti_compatibility with ``-1``. -Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H3. -Apply Rle_anti_compatibility with ``-1``. -Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H4. -Unfold cos_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring. -Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))). -Apply lt_O_Sn. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring. -Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)). -Apply lt_O_Sn. -Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Intros; Case (total_order_T R0 a); Intro. -Elim s; Intro. -Apply H; [Left; Assumption | Assumption]. -Apply H; [Right; Assumption | Assumption]. -Cut ``0< -a``. -Intro; Cut (x:R;n:nat) (cos_approx x n)==(cos_approx ``-x`` n). -Intro; Rewrite H3; Rewrite (H3 a (mult (S (S O)) (plus n (S O)))); Rewrite cos_sym; Apply H. -Left; Assumption. -Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rle_Ropp1; Unfold Rdiv; Unfold Rdiv in H0; Rewrite <- Ropp_mul1; 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 Rgt_RO_Ropp; Assumption. -Qed. +Lemma cos_bound : + forall (a:R) (n:nat), + - PI / 2 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). +cut + ((forall (a:R) (n:nat), + 0 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) -> + forall (a:R) (n:nat), + - PI / 2 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))). +intros H a n; apply H. +intros; unfold cos_approx in |- *. +rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)). +rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))). +replace (cos_term a0 0) with 1. +cut + (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\ + cos a0 - 1 <= + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) -> + 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\ + cos a0 <= + 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))). +intro; apply H2. +pose (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))). +replace (pred (2 * n0 + 1)) with (2 * n0)%nat. +replace (pred (2 * (n0 + 1))) with (S (2 * n0)). +replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with + (- sum_f_R0 (tg_alt Un) (2 * n0)). +replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with + (- sum_f_R0 (tg_alt Un) (S (2 * n0))). +cut + (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <= + sum_f_R0 (tg_alt Un) (2 * n0) -> + - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <= + - sum_f_R0 (tg_alt Un) (S (2 * n0))). +intro; apply H3. +apply alternated_series_ineq. +unfold Un_decreasing in |- *; intro; unfold Un in |- *. +cut ((2 * S (S n1))%nat = S (S (2 * S n1))). +intro; rewrite H4; + replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)). +unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. +apply pow_le; assumption. +apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))). +rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6). +rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1))))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR; + simpl in |- *; + replace + (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1)) + with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ]. +apply Rle_trans with 12. +apply Rle_trans with 4. +replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. +replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ]. +apply Rsqr_incr_1. +apply Rle_trans with (PI / 2). +assumption. +unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. +prove_sup0. +rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. +replace 4 with 4; [ apply PI_4 | ring ]. +discrR. +assumption. +left; prove_sup0. +pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8); + [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. +rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. +apply Rplus_le_le_0_compat. +repeat apply Rmult_le_pos. +left; prove_sup0. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply Rmult_le_pos. +left; prove_sup0. +replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4; + unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; + intros; elim (H4 eps H5); intros N H6; exists N; intros. +apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat. +apply le_trans with (2 * N)%nat. +apply le_n_2n. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. +apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. +assert (X := exist_cos (Rsqr a0)); elim X; intros. +cut (x = cos a0). +intro; rewrite H4 in p; unfold cos_in in p; unfold infinit_sum in p; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + intros. +elim (p _ H5); intros N H6. +exists N; intros. +replace (sum_f_R0 (tg_alt Un) n1) with + (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). +unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1); + rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + unfold Rminus in H6; apply H6. +unfold ge in |- *; apply le_trans with n1. +exact H7. +apply le_n_Sn. +rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). +replace (cos_n 0) with 1. +simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_l; + replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1) + with + (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1); + [ idtac | ring ]; rewrite scal_sum; apply sum_eq; + intros; unfold cos_n, Un, tg_alt in |- *. +replace ((-1) ^ S i) with (- (-1) ^ i). +replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i). +unfold Rdiv in |- *; ring. +rewrite pow_Rsqr; reflexivity. +simpl in |- *; ring. +unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; reflexivity. +apply lt_O_Sn. +unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p; + unfold cos_in in c; eapply uniqueness_sum. +apply p. +apply c. +intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0)); + [ idtac | ring ]. +split; apply Ropp_le_contravar; assumption. +replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with + (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ]. +apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with + (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ]; + apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). +unfold Rdiv in |- *; ring. +reflexivity. +replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). +reflexivity. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n0 + 1)%nat with (S (2 * n0)). +reflexivity. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +intro; elim H2; intros; split. +apply Rplus_le_reg_l with (-1). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (-1)); apply H3. +apply Rplus_le_reg_l with (-1). +rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (-1)); apply H4. +unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; + ring. +replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). +apply lt_O_Sn. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; + repeat rewrite S_INR; ring. +replace (2 * n0 + 1)%nat with (S (2 * n0)). +apply lt_O_Sn. +apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; + repeat rewrite S_INR; ring. +intros; case (total_order_T 0 a); intro. +elim s; intro. +apply H; [ left; assumption | assumption ]. +apply H; [ right; assumption | assumption ]. +cut (0 < - a). +intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n). +intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H. +left; assumption. +rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar; + unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse; + exact H0. +intros; unfold cos_approx in |- *; apply sum_eq; intros; + unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg; + unfold Rdiv in |- *; reflexivity. +apply Ropp_0_gt_lt_contravar; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v index 8ede9fc1c..28cb27a58 100644 --- a/theories/Reals/Rtrigo_calc.v +++ b/theories/Reals/Rtrigo_calc.v @@ -8,343 +8,427 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require R_sqrt. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import R_sqrt. Open Local Scope R_scope. -Lemma tan_PI : ``(tan PI)==0``. -Unfold tan; Rewrite sin_PI; Rewrite cos_PI; Unfold Rdiv; Apply Rmult_Ol. -Qed. - -Lemma sin_3PI2 : ``(sin (3*(PI/2)))==(-1)``. -Replace ``3*(PI/2)`` with ``PI+(PI/2)``. -Rewrite sin_plus; Rewrite sin_PI; Rewrite cos_PI; Rewrite sin_PI2; Ring. -Pattern 1 PI; Rewrite (double_var PI); Ring. -Qed. - -Lemma tan_2PI : ``(tan (2*PI))==0``. -Unfold tan; Rewrite sin_2PI; Unfold Rdiv; Apply Rmult_Ol. -Qed. - -Lemma sin_cos_PI4 : ``(sin (PI/4)) == (cos (PI/4))``. -Proof with Trivial. -Rewrite cos_sin. -Replace ``PI/2+PI/4`` with ``-(PI/4)+PI``. -Rewrite neg_sin; Rewrite sin_neg; Ring. -Cut ``PI==PI/2+PI/2``; [Intro | Apply double_var]. -Pattern 2 3 PI; Rewrite H; Pattern 2 3 PI; Rewrite H. -Assert H0 : ``2<>0``; [DiscrR | Unfold Rdiv; Rewrite Rinv_Rmult; Try Ring]. -Qed. - -Lemma sin_PI3_cos_PI6 : ``(sin (PI/3))==(cos (PI/6))``. -Proof with Trivial. -Replace ``PI/6`` with ``(PI/2)-(PI/3)``. -Rewrite cos_shift. -Assert H0 : ``6<>0``; [DiscrR | Idtac]. -Assert H1 : ``3<>0``; [DiscrR | Idtac]. -Assert H2 : ``2<>0``; [DiscrR | Idtac]. -Apply r_Rmult_mult with ``6``. -Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``). -Unfold Rdiv; Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Ring. -Qed. - -Lemma sin_PI6_cos_PI3 : ``(cos (PI/3))==(sin (PI/6))``. -Proof with Trivial. -Replace ``PI/6`` with ``(PI/2)-(PI/3)``. -Rewrite sin_shift. -Assert H0 : ``6<>0``; [DiscrR | Idtac]. -Assert H1 : ``3<>0``; [DiscrR | Idtac]. -Assert H2 : ``2<>0``; [DiscrR | Idtac]. -Apply r_Rmult_mult with ``6``. -Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``). -Unfold Rdiv; Repeat Rewrite Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Ring. -Qed. - -Lemma PI6_RGT_0 : ``0<PI/6``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0]. -Qed. - -Lemma PI6_RLT_PI2 : ``PI/6<PI/2``. -Unfold Rdiv; Apply Rlt_monotony. -Apply PI_RGT_0. -Apply Rinv_lt; Sup. -Qed. - -Lemma sin_PI6 : ``(sin (PI/6))==1/2``. -Proof with Trivial. -Assert H : ``2<>0``; [DiscrR | Idtac]. -Apply r_Rmult_mult with ``2*(cos (PI/6))``. -Replace ``2*(cos (PI/6))*(sin (PI/6))`` with ``2*(sin (PI/6))*(cos (PI/6))``. -Rewrite <- sin_2a; Replace ``2*(PI/6)`` with ``PI/3``. -Rewrite sin_PI3_cos_PI6. -Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Unfold Rdiv; Rewrite Rinv_Rmult. -Rewrite (Rmult_sym ``/2``); Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -DiscrR. -Ring. -Apply prod_neq_R0. -Cut ``0<(cos (PI/6))``; [Intro H1; Auto with real | Apply cos_gt_0; [Apply (Rlt_trans ``-(PI/2)`` ``0`` ``PI/6`` _PI2_RLT_0 PI6_RGT_0) | Apply PI6_RLT_PI2]]. -Qed. - -Lemma sqrt2_neq_0 : ~``(sqrt 2)==0``. -Assert Hyp:``0<2``; [Sup0 | 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. - -Lemma R1_sqrt2_neq_0 : ~``1/(sqrt 2)==0``. -Generalize (Rinv_neq_R0 ``(sqrt 2)`` sqrt2_neq_0); Intro H; Generalize (prod_neq_R0 ``1`` ``(Rinv (sqrt 2))`` R1_neq_R0 H); Intro H0; Assumption. -Qed. - -Lemma sqrt3_2_neq_0 : ~``2*(sqrt 3)==0``. -Apply prod_neq_R0; [DiscrR | Assert Hyp:``0<3``; [Sup0 | 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. - -Lemma Rlt_sqrt2_0 : ``0<(sqrt 2)``. -Assert Hyp:``0<2``; [Sup0 | Generalize (sqrt_positivity ``2`` (Rlt_le ``0`` ``2`` Hyp)); Intro H1; Elim H1; Intro H2; [Assumption | Absurd ``0 == (sqrt 2)``; [Apply not_sym; Apply sqrt2_neq_0 | Assumption]]]. -Qed. - -Lemma Rlt_sqrt3_0 : ``0<(sqrt 3)``. -Cut ~(O=(1)); [Intro H0; Assert Hyp:``0<2``; [Sup0 | Generalize (Rlt_le ``0`` ``2`` Hyp); Intro H1; Assert Hyp2:``0<3``; [Sup0 | Generalize (Rlt_le ``0`` ``3`` Hyp2); Intro H2; Generalize (lt_INR_0 (1) (neq_O_lt (1) H0)); Unfold INR; Intro H3; Generalize (Rlt_compatibility ``2`` ``0`` ``1`` H3); Rewrite Rplus_sym; Rewrite Rplus_Ol; Replace ``2+1`` with ``3``; [Intro H4; Generalize (sqrt_lt_1 ``2`` ``3`` H1 H2 H4); Clear H3; Intro H3; Apply (Rlt_trans ``0`` ``(sqrt 2)`` ``(sqrt 3)`` Rlt_sqrt2_0 H3) | Ring]]] | Discriminate]. -Qed. - -Lemma PI4_RGT_0 : ``0<PI/4``. -Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0]. -Qed. - -Lemma cos_PI4 : ``(cos (PI/4))==1/(sqrt 2)``. -Proof with Trivial. -Apply Rsqr_inj. -Apply cos_ge_0. -Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/4`` _PI2_RLT_0 PI4_RGT_0). -Left; Apply PI4_RLT_PI2. -Left; Apply (Rmult_lt_pos R1 ``(Rinv (sqrt 2))``). -Sup. -Apply Rlt_Rinv; Apply Rlt_sqrt2_0. -Rewrite Rsqr_div. -Rewrite Rsqr_1; Rewrite Rsqr_sqrt. -Assert H : ``2<>0``; [DiscrR | Idtac]. -Unfold Rsqr; Pattern 1 ``(cos (PI/4))``; 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_1r. -Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rinv_Rmult. -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Unfold Rdiv; Rewrite Rmult_1l; Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Left; Sup. -Apply sqrt2_neq_0. -Qed. - -Lemma sin_PI4 : ``(sin (PI/4))==1/(sqrt 2)``. -Rewrite sin_cos_PI4; Apply cos_PI4. -Qed. - -Lemma tan_PI4 : ``(tan (PI/4))==1``. -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; Rewrite Ropp_mul1. -Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR]. -Qed. - -Lemma sin3PI4 : ``(sin (3*(PI/4)))==1/(sqrt 2)``. -Proof with Trivial. -Replace ``3*(PI/4)`` with ``(PI/2)-(-(PI/4))``. -Rewrite sin_shift; Rewrite cos_neg; Rewrite cos_PI4. -Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR]. -Qed. - -Lemma cos_PI6 : ``(cos (PI/6))==(sqrt 3)/2``. -Proof with Trivial. -Apply Rsqr_inj. -Apply cos_ge_0. -Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/6`` _PI2_RLT_0 PI6_RGT_0). -Left; Apply PI6_RLT_PI2. -Left; Apply (Rmult_lt_pos ``(sqrt 3)`` ``(Rinv 2)``). -Apply Rlt_sqrt3_0. -Apply Rlt_Rinv; Sup0. -Assert H : ``2<>0``; [DiscrR | Idtac]. -Assert H1 : ``4<>0``; [Apply prod_neq_R0 | Idtac]. -Rewrite Rsqr_div. -Rewrite cos2; Unfold Rsqr; Rewrite sin_PI6; Rewrite sqrt_def. -Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``. -Rewrite Rminus_distr; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite Rmult_1r. -Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- Rinv_r_sym. -Ring. -Left; Sup0. -Qed. - -Lemma tan_PI6 : ``(tan (PI/6))==1/(sqrt 3)``. -Unfold tan; Rewrite sin_PI6; Rewrite cos_PI6; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Rewrite (Rmult_sym ``/2``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Apply Rmult_1r. -DiscrR. -DiscrR. -Red; Intro; Assert H1 := Rlt_sqrt3_0; Rewrite H in H1; Elim (Rlt_antirefl ``0`` H1). -Apply Rinv_neq_R0; DiscrR. -Qed. - -Lemma sin_PI3 : ``(sin (PI/3))==(sqrt 3)/2``. -Rewrite sin_PI3_cos_PI6; Apply cos_PI6. -Qed. - -Lemma cos_PI3 : ``(cos (PI/3))==1/2``. -Rewrite sin_PI6_cos_PI3; Apply sin_PI6. -Qed. - -Lemma tan_PI3 : ``(tan (PI/3))==(sqrt 3)``. -Unfold tan; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rinv_Rinv. -Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Apply Rmult_1r. -DiscrR. -DiscrR. -Qed. - -Lemma sin_2PI3 : ``(sin (2*(PI/3)))==(sqrt 3)/2``. -Rewrite double; Rewrite sin_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc; Rewrite double_var; Reflexivity. -Qed. - -Lemma cos_2PI3 : ``(cos (2*(PI/3)))==-1/2``. -Proof with Trivial. -Assert H : ``2<>0``; [DiscrR | Idtac]. -Assert H0 : ``4<>0``; [Apply prod_neq_R0 | Idtac]. -Rewrite double; Rewrite cos_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``. -Rewrite Rminus_distr; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``). -Repeat Rewrite Rmult_assoc; Rewrite <- (Rinv_l_sym). -Rewrite Rmult_1r; Rewrite <- Rinv_r_sym. -Pattern 4 ``2``; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite Ropp_mul3; Rewrite Rmult_1r. -Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite (Rmult_sym ``2``); Rewrite (Rmult_sym ``/2``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Rewrite sqrt_def. -Ring. -Left; Sup. -Qed. - -Lemma tan_2PI3 : ``(tan (2*(PI/3)))==-(sqrt 3)``. -Proof with Trivial. -Assert H : ``2<>0``; [DiscrR | Idtac]. -Unfold tan; Rewrite sin_2PI3; Rewrite cos_2PI3; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite <- Ropp_Rinv. -Rewrite Rinv_Rinv. -Rewrite Rmult_assoc; Rewrite Ropp_mul3; Rewrite <- Rinv_l_sym. -Ring. -Apply Rinv_neq_R0. -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; Rewrite Ropp_mul1. -Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; 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; Rewrite Ropp_mul1. -Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; Try Ring]. -Qed. - -Lemma sin_cos5PI4 : ``(cos (5*(PI/4)))==(sin (5*(PI/4)))``. -Rewrite cos_5PI4; Rewrite sin_5PI4; Reflexivity. -Qed. - -Lemma Rgt_3PI2_0 : ``0<3*(PI/2)``. -Apply Rmult_lt_pos; [Sup0 | Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0]]. -Qed. - -Lemma Rgt_2PI_0 : ``0<2*PI``. -Apply Rmult_lt_pos; [Sup0 | Apply PI_RGT_0]. -Qed. - -Lemma Rlt_PI_3PI2 : ``PI<3*(PI/2)``. -Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility PI ``0`` ``PI/2`` H1); Replace ``PI+(PI/2)`` with ``3*(PI/2)``. -Rewrite Rplus_Or; Intro H2; Assumption. -Pattern 2 PI; Rewrite double_var; Ring. +Lemma tan_PI : tan PI = 0. +unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *; + apply Rmult_0_l. +Qed. + +Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1. +replace (3 * (PI / 2)) with (PI + PI / 2). +rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring. +pattern PI at 1 in |- *; rewrite (double_var PI); ring. +Qed. + +Lemma tan_2PI : tan (2 * PI) = 0. +unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l. +Qed. + +Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4). +Proof with trivial. +rewrite cos_sin... +replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)... +rewrite neg_sin; rewrite sin_neg; ring... +cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]... +pattern PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H... +assert (H0 : 2 <> 0); + [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]... +Qed. + +Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6). +Proof with trivial. +replace (PI / 6) with (PI / 2 - PI / 3)... +rewrite cos_shift... +assert (H0 : 6 <> 0); [ discrR | idtac ]... +assert (H1 : 3 <> 0); [ discrR | idtac ]... +assert (H2 : 2 <> 0); [ discrR | idtac ]... +apply Rmult_eq_reg_l with 6... +rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... +unfold Rdiv in |- *; repeat rewrite Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... +pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... +ring... +Qed. + +Lemma sin_PI6_cos_PI3 : cos (PI / 3) = sin (PI / 6). +Proof with trivial. +replace (PI / 6) with (PI / 2 - PI / 3)... +rewrite sin_shift... +assert (H0 : 6 <> 0); [ discrR | idtac ]... +assert (H1 : 3 <> 0); [ discrR | idtac ]... +assert (H2 : 2 <> 0); [ discrR | idtac ]... +apply Rmult_eq_reg_l with 6... +rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... +unfold Rdiv in |- *; repeat rewrite Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... +pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... +ring... +Qed. + +Lemma PI6_RGT_0 : 0 < PI / 6. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +Lemma PI6_RLT_PI2 : PI / 6 < PI / 2. +unfold Rdiv in |- *; apply Rmult_lt_compat_l. +apply PI_RGT_0. +apply Rinv_lt_contravar; prove_sup. +Qed. + +Lemma sin_PI6 : sin (PI / 6) = 1 / 2. +Proof with trivial. +assert (H : 2 <> 0); [ discrR | idtac ]... +apply Rmult_eq_reg_l with (2 * cos (PI / 6))... +replace (2 * cos (PI / 6) * sin (PI / 6)) with + (2 * sin (PI / 6) * cos (PI / 6))... +rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)... +rewrite sin_PI3_cos_PI6... +unfold Rdiv in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc; + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym... +rewrite Rmult_1_r... +unfold Rdiv in |- *; rewrite Rinv_mult_distr... +rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r... +discrR... +ring... +apply prod_neq_R0... +cut (0 < cos (PI / 6)); + [ intro H1; auto with real + | apply cos_gt_0; + [ apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0) + | apply PI6_RLT_PI2 ] ]... +Qed. + +Lemma sqrt2_neq_0 : sqrt 2 <> 0. +assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2; + generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0); + [ discrR | assumption ] ]. +Qed. + +Lemma R1_sqrt2_neq_0 : 1 / sqrt 2 <> 0. +generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H; + generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); + intro H0; assumption. +Qed. + +Lemma sqrt3_2_neq_0 : 2 * sqrt 3 <> 0. +apply prod_neq_R0; + [ discrR + | assert (Hyp : 0 < 3); + [ prove_sup0 + | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2; + generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0); + [ discrR | assumption ] ] ]. +Qed. + +Lemma Rlt_sqrt2_0 : 0 < sqrt 2. +assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1; + intro H2; + [ assumption + | absurd (0 = sqrt 2); + [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. +Qed. + +Lemma Rlt_sqrt3_0 : 0 < sqrt 3. +cut (0%nat <> 1%nat); + [ intro H0; assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3); + [ prove_sup0 + | generalize (Rlt_le 0 3 Hyp2); intro H2; + generalize (lt_INR_0 1 (neq_O_lt 1 H0)); + unfold INR in |- *; intro H3; + generalize (Rplus_lt_compat_l 2 0 1 H3); + rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3; + [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3; + apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3) + | ring ] ] ] + | discriminate ]. +Qed. + +Lemma PI4_RGT_0 : 0 < PI / 4. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. +Qed. + +Lemma cos_PI4 : cos (PI / 4) = 1 / sqrt 2. +Proof with trivial. +apply Rsqr_inj... +apply cos_ge_0... +left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)... +left; apply PI4_RLT_PI2... +left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))... +prove_sup... +apply Rinv_0_lt_compat; apply Rlt_sqrt2_0... +rewrite Rsqr_div... +rewrite Rsqr_1; rewrite Rsqr_sqrt... +assert (H : 2 <> 0); [ discrR | idtac ]... +unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *; + rewrite <- sin_cos_PI4; + replace (sin (PI / 4) * cos (PI / 4)) with + (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))... +rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)... +rewrite sin_PI2... +apply Rmult_1_r... +unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr... +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r... +unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite Rmult_1_l... +left; prove_sup... +apply sqrt2_neq_0... +Qed. + +Lemma sin_PI4 : sin (PI / 4) = 1 / sqrt 2. +rewrite sin_cos_PI4; apply cos_PI4. +Qed. + +Lemma tan_PI4 : tan (PI / 4) = 1. +unfold tan in |- *; rewrite sin_cos_PI4. +unfold Rdiv in |- *; apply Rinv_r. +change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0. +Qed. + +Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2. +Proof with trivial. +replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... +rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4... +unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse... +unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; + [ ring | discrR | discrR ]... +Qed. + +Lemma sin3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2. +Proof with trivial. +replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... +rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4... +unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; + [ ring | discrR | discrR ]... +Qed. + +Lemma cos_PI6 : cos (PI / 6) = sqrt 3 / 2. +Proof with trivial. +apply Rsqr_inj... +apply cos_ge_0... +left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)... +left; apply PI6_RLT_PI2... +left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))... +apply Rlt_sqrt3_0... +apply Rinv_0_lt_compat; prove_sup0... +assert (H : 2 <> 0); [ discrR | idtac ]... +assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... +rewrite Rsqr_div... +rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def... +unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... +rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... +rewrite Rmult_1_l; rewrite Rmult_1_r... +rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc... +rewrite <- Rinv_l_sym... +rewrite Rmult_1_l; rewrite <- Rinv_r_sym... +ring... +left; prove_sup0... +Qed. + +Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3. +unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *; + repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym. +apply Rmult_1_r. +discrR. +discrR. +red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1; + elim (Rlt_irrefl 0 H1). +apply Rinv_neq_0_compat; discrR. +Qed. + +Lemma sin_PI3 : sin (PI / 3) = sqrt 3 / 2. +rewrite sin_PI3_cos_PI6; apply cos_PI6. +Qed. + +Lemma cos_PI3 : cos (PI / 3) = 1 / 2. +rewrite sin_PI6_cos_PI3; apply sin_PI6. +Qed. + +Lemma tan_PI3 : tan (PI / 3) = sqrt 3. +unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *; + rewrite Rmult_1_l; rewrite Rinv_involutive. +rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +apply Rmult_1_r. +discrR. +discrR. +Qed. + +Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2. +rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; + unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); + repeat rewrite <- Rmult_assoc; rewrite double_var; + reflexivity. +Qed. + +Lemma cos_2PI3 : cos (2 * (PI / 3)) = -1 / 2. +Proof with trivial. +assert (H : 2 <> 0); [ discrR | idtac ]... +assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... +rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3; + unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... +rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2)... +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite <- Rinv_r_sym... +pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r... +rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))... +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_r; rewrite sqrt_def... +ring... +left; prove_sup... +Qed. + +Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3. +Proof with trivial. +assert (H : 2 <> 0); [ discrR | idtac ]... +unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; + rewrite <- Ropp_inv_permute... +rewrite Rinv_involutive... +rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym... +ring... +apply Rinv_neq_0_compat... +Qed. + +Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2. +Proof with trivial. +replace (5 * (PI / 4)) with (PI / 4 + PI)... +rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse... +pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + rewrite double_var; assert (H : 2 <> 0); + [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... +Qed. + +Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2. +Proof with trivial. +replace (5 * (PI / 4)) with (PI / 4 + PI)... +rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse... +pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + rewrite double_var; assert (H : 2 <> 0); + [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... +Qed. + +Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)). +rewrite cos_5PI4; rewrite sin_5PI4; reflexivity. +Qed. + +Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2). +apply Rmult_lt_0_compat; + [ prove_sup0 + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ]. +Qed. + +Lemma Rgt_2PI_0 : 0 < 2 * PI. +apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ]. +Qed. + +Lemma Rlt_PI_3PI2 : PI < 3 * (PI / 2). +generalize PI2_RGT_0; intro H1; + generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1); + replace (PI + PI / 2) with (3 * (PI / 2)). +rewrite Rplus_0_r; intro H2; assumption. +pattern PI at 2 in |- *; rewrite double_var; ring. Qed. -Lemma Rlt_3PI2_2PI : ``3*(PI/2)<2*PI``. -Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility ``3*(PI/2)`` ``0`` ``PI/2`` H1); Replace ``3*(PI/2)+(PI/2)`` with ``2*PI``. -Rewrite Rplus_Or; Intro H2; Assumption. -Rewrite double; Pattern 1 2 PI; Rewrite double_var; Ring. +Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI. +generalize PI2_RGT_0; intro H1; + generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1); + replace (3 * (PI / 2) + PI / 2) with (2 * PI). +rewrite Rplus_0_r; intro H2; assumption. +rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring. Qed. (***************************************************************) (* Radian -> Degree | Degree -> Radian *) (***************************************************************) -Definition plat : R := ``180``. -Definition toRad [x:R] : R := ``x*PI*/plat``. -Definition toDeg [x:R] : R := ``x*plat*/PI``. +Definition plat : R := 180. +Definition toRad (x:R) : R := x * PI * / plat. +Definition toDeg (x:R) : R := x * plat * / PI. -Lemma rad_deg : (x:R) (toRad (toDeg x))==x. -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; DiscrR. +Lemma rad_deg : forall x:R, toRad (toDeg x) = x. +intro; unfold toRad, toDeg in |- *; + replace (x * plat * / PI * PI * / plat) with + (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ]. +repeat rewrite <- Rinv_r_sym. +ring. +apply PI_neq0. +unfold plat in |- *; discrR. Qed. -Lemma toRad_inj : (x,y:R) (toRad x)==(toRad y) -> x==y. -Intros; Unfold toRad in H; Apply r_Rmult_mult with PI. -Rewrite <- (Rmult_sym x); Rewrite <- (Rmult_sym y). -Apply r_Rmult_mult with ``/plat``. -Rewrite <- (Rmult_sym ``x*PI``); Rewrite <- (Rmult_sym ``y*PI``); Assumption. -Apply Rinv_neq_R0; Unfold plat; DiscrR. -Apply PI_neq0. +Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y. +intros; unfold toRad in H; apply Rmult_eq_reg_l with PI. +rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y). +apply Rmult_eq_reg_l with (/ plat). +rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI)); + assumption. +apply Rinv_neq_0_compat; unfold plat in |- *; discrR. +apply PI_neq0. Qed. -Lemma deg_rad : (x:R) (toDeg (toRad x))==x. -Intro x; Apply toRad_inj; Rewrite -> (rad_deg (toRad x)); Reflexivity. +Lemma deg_rad : forall x:R, toDeg (toRad x) = x. +intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity. Qed. -Definition sind [x:R] : R := (sin (toRad x)). -Definition cosd [x:R] : R := (cos (toRad x)). -Definition tand [x:R] : R := (tan (toRad x)). +Definition sind (x:R) : R := sin (toRad x). +Definition cosd (x:R) : R := cos (toRad x). +Definition tand (x:R) : R := tan (toRad x). -Lemma Rsqr_sin_cos_d_one : (x:R) ``(Rsqr (sind x))+(Rsqr (cosd x))==1``. -Intro x; Unfold sind; Unfold cosd; Apply sin2_cos2. +Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1. +intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2. Qed. (***************************************************) (* Other properties *) (***************************************************) -Lemma sin_lb_ge_0 : (a:R) ``0<=a``->``a<=PI/2``->``0<=(sin_lb a)``. -Intros; Case (total_order R0 a); Intro. -Left; Apply sin_lb_gt_0; Assumption. -Elim H1; Intro. -Rewrite <- H2; Unfold sin_lb; Unfold sin_approx; Unfold sum_f_R0; Unfold sin_term; Repeat Rewrite pow_ne_zero. -Unfold Rdiv; Repeat Rewrite Rmult_Ol; Repeat Rewrite Rmult_Or; Repeat Rewrite Rplus_Or; Right; Reflexivity. -Discriminate. -Discriminate. -Discriminate. -Discriminate. -Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` a ``0`` H H2)). -Qed. +Lemma sin_lb_ge_0 : forall a:R, 0 <= a -> a <= PI / 2 -> 0 <= sin_lb a. +intros; case (Rtotal_order 0 a); intro. +left; apply sin_lb_gt_0; assumption. +elim H1; intro. +rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *; + unfold sum_f_R0 in |- *; unfold sin_term in |- *; + repeat rewrite pow_ne_zero. +unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; + repeat rewrite Rplus_0_r; right; reflexivity. +discriminate. +discriminate. +discriminate. +discriminate. +elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)). +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v index 82c63a7b2..f18e9188e 100644 --- a/theories/Reals/Rtrigo_def.v +++ b/theories/Reals/Rtrigo_def.v @@ -8,350 +8,405 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo_fun. -Require Max. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo_fun. +Require Import Max. Open Local Scope R_scope. (*****************************) (* Definition of exponential *) (*****************************) -Definition exp_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``/(INR (fact i))*(pow x i)`` l). +Definition exp_in (x l:R) : Prop := + infinit_sum (fun i:nat => / INR (fact i) * x ^ i) l. -Lemma exp_cof_no_R0 : (n:nat) ``/(INR (fact n))<>0``. -Intro. -Apply Rinv_neq_R0. -Apply INR_fact_neq_0. +Lemma exp_cof_no_R0 : forall n:nat, / INR (fact n) <> 0. +intro. +apply Rinv_neq_0_compat. +apply INR_fact_neq_0. Qed. -Lemma exist_exp : (x:R)(SigT R [l:R](exp_in x l)). -Intro; Generalize (Alembert_C3 [n:nat](Rinv (INR (fact n))) x exp_cof_no_R0 Alembert_exp). -Unfold Pser exp_in. -Trivial. +Lemma exist_exp : forall x:R, sigT (fun l:R => exp_in x l). +intro; + generalize + (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp). +unfold Pser, exp_in in |- *. +trivial. Defined. -Definition exp : R -> R := [x:R](projT1 ? ? (exist_exp x)). +Definition exp (x:R) : R := projT1 (exist_exp x). -Lemma pow_i : (i:nat) (lt O i) -> (pow R0 i)==R0. -Intros; Apply pow_ne_zero. -Red; Intro; Rewrite H0 in H; Elim (lt_n_n ? H). +Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0. +intros; apply pow_ne_zero. +red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H). Qed. (*i Calculus of $e^0$ *) -Lemma exist_exp0 : (SigT R [l:R](exp_in R0 l)). -Apply Specif.existT with R1. -Unfold exp_in; Unfold infinit_sum; Intros. -Exists O. -Intros; Replace (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow R0 i)``) n) with R1. -Unfold R_dist; Replace ``1-1`` with R0; [Rewrite Rabsolu_R0; Assumption | Ring]. -Induction n. -Simpl; Rewrite Rinv_R1; Ring. -Rewrite tech5. -Rewrite <- Hrecn. -Simpl. -Ring. -Unfold ge; Apply le_O_n. +Lemma exist_exp0 : sigT (fun l:R => exp_in 0 l). +apply existT with 1. +unfold exp_in in |- *; unfold infinit_sum in |- *; intros. +exists 0%nat. +intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1. +unfold R_dist in |- *; replace (1 - 1) with 0; + [ rewrite Rabs_R0; assumption | ring ]. +induction n as [| n Hrecn]. +simpl in |- *; rewrite Rinv_1; ring. +rewrite tech5. +rewrite <- Hrecn. +simpl in |- *. +ring. +unfold ge in |- *; apply le_O_n. Defined. -Lemma exp_0 : ``(exp 0)==1``. -Cut (exp_in R0 (exp R0)). -Cut (exp_in R0 R1). -Unfold exp_in; Intros; EApply unicity_sum. -Apply H0. -Apply H. -Exact (projT2 ? ? exist_exp0). -Exact (projT2 ? ? (exist_exp R0)). +Lemma exp_0 : exp 0 = 1. +cut (exp_in 0 (exp 0)). +cut (exp_in 0 1). +unfold exp_in in |- *; intros; eapply uniqueness_sum. +apply H0. +apply H. +exact (projT2 exist_exp0). +exact (projT2 (exist_exp 0)). Qed. (**************************************) (* Definition of hyperbolic functions *) (**************************************) -Definition cosh : R->R := [x:R]``((exp x)+(exp (-x)))/2``. -Definition sinh : R->R := [x:R]``((exp x)-(exp (-x)))/2``. -Definition tanh : R->R := [x:R]``(sinh x)/(cosh x)``. +Definition cosh (x:R) : R := (exp x + exp (- x)) / 2. +Definition sinh (x:R) : R := (exp x - exp (- x)) / 2. +Definition tanh (x:R) : R := sinh x / cosh x. -Lemma cosh_0 : ``(cosh 0)==1``. -Unfold cosh; Rewrite Ropp_O; Rewrite exp_0. -Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | DiscrR]. +Lemma cosh_0 : cosh 0 = 1. +unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0. +unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ]. Qed. -Lemma sinh_0 : ``(sinh 0)==0``. -Unfold sinh; Rewrite Ropp_O; Rewrite exp_0. -Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Apply Rmult_Ol. +Lemma sinh_0 : sinh 0 = 0. +unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0. +unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l. Qed. -Definition cos_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (mult (S (S O)) n)))``. - -Lemma simpl_cos_n : (n:nat) (Rdiv (cos_n (S n)) (cos_n n))==(Ropp (Rinv (INR (mult (mult (2) (S n)) (plus (mult (2) n) (1)))))). -Intro; Unfold cos_n; Replace (S n) with (plus n (1)); [Idtac | Ring]. -Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(/(pow ( -1) n)*(INR (fact (mult (S (S O)) n))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(INR (fact (mult (S (S O)) n)))*(pow (-1) (S O))``; [Idtac | Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r. -Replace (mult (S (S O)) (plus n (S O))) with (S (S (mult (S (S O)) n))); [Idtac | Ring]. -Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rinv_Rmult; Try (Apply not_O_INR; Discriminate). -Rewrite <- (Rmult_sym ``-1``). -Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r. -Replace (S (mult (S (S O)) n)) with (plus (mult (S (S O)) n) (S O)); [Idtac | Ring]. -Rewrite mult_INR; Rewrite Rinv_Rmult. -Ring. -Apply not_O_INR; Discriminate. -Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (S (S O)) n)); [Apply not_O_INR; Discriminate | Ring]. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0]. -Apply pow_nonzero; DiscrR. -Apply INR_fact_neq_0. -Apply pow_nonzero; DiscrR. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. +Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)). + +Lemma simpl_cos_n : + forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). +intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +replace + ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) * + (/ (-1) ^ n * INR (fact (2 * n)))) with + ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) * + (-1) ^ 1); [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r. +replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ]. +do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate). +rewrite <- (Rmult_comm (-1)). +repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r. +replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. +rewrite mult_INR; rewrite Rinv_mult_distr. +ring. +apply not_O_INR; discriminate. +replace (2 * n + 1)%nat with (S (2 * n)); + [ apply not_O_INR; discriminate | ring ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +apply pow_nonzero; discrR. +apply INR_fact_neq_0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. -Lemma archimed_cor1 : (eps:R) ``0<eps`` -> (EX N : nat | ``/(INR N) < eps``/\(lt O N)). -Intros; Cut ``/eps < (IZR (up (/eps)))``. -Intro; Cut `0<=(up (Rinv eps))`. -Intro; Assert H2 := (IZN ? H1); Elim H2; Intros; Exists (max x (1)). -Split. -Cut ``0<(IZR (INZ x))``. -Intro; Rewrite INR_IZR_INZ; Apply Rle_lt_trans with ``/(IZR (INZ x))``. -Apply Rle_monotony_contra with (IZR (INZ x)). -Assumption. -Rewrite <- Rinv_r_sym; [Idtac | Red; Intro; Rewrite H5 in H4; Elim (Rlt_antirefl ? H4)]. -Apply Rle_monotony_contra with (IZR (INZ (max x (1)))). -Apply Rlt_le_trans with (IZR (INZ x)). -Assumption. -Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l. -Rewrite Rmult_1r; Rewrite (Rmult_sym (IZR (INZ (max x (S O))))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l. -Rewrite <- INR_IZR_INZ; Apply not_O_INR. -Red; Intro;Assert H6 := (le_max_r x (1)); Cut (lt O (1)); [Intro | Apply lt_O_Sn]; Assert H8 := (lt_le_trans ? ? ? H7 H6); Rewrite H5 in H8; Elim (lt_n_n ? H8). -Pattern 1 eps; Rewrite <- Rinv_Rinv. -Apply Rinv_lt. -Apply Rmult_lt_pos; [Apply Rlt_Rinv; Assumption | Assumption]. -Rewrite H3 in H0; Assumption. -Red; Intro; Rewrite H5 in H; Elim (Rlt_antirefl ? H). -Apply Rlt_trans with ``/eps``. -Apply Rlt_Rinv; Assumption. -Rewrite H3 in H0; Assumption. -Apply lt_le_trans with (1); [Apply lt_O_Sn | Apply le_max_r]. -Apply le_IZR; Replace (IZR `0`) with R0; [Idtac | Reflexivity]; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption]. -Assert H0 := (archimed ``/eps``). -Elim H0; Intros; Assumption. +Lemma archimed_cor1 : + forall eps:R, 0 < eps -> exists N : nat | / INR N < eps /\ (0 < N)%nat. +intros; cut (/ eps < IZR (up (/ eps))). +intro; cut (0 <= up (/ eps))%Z. +intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1). +split. +cut (0 < IZR (Z_of_nat x)). +intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)). +apply Rmult_le_reg_l with (IZR (Z_of_nat x)). +assumption. +rewrite <- Rinv_r_sym; + [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ]. +apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))). +apply Rlt_le_trans with (IZR (Z_of_nat x)). +assumption. +repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l. +rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1)))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR; + apply le_max_l. +rewrite <- INR_IZR_INZ; apply not_O_INR. +red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat; + [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6); + rewrite H5 in H8; elim (lt_irrefl _ H8). +pattern eps at 1 in |- *; rewrite <- Rinv_involutive. +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ]. +rewrite H3 in H0; assumption. +red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H). +apply Rlt_trans with (/ eps). +apply Rinv_0_lt_compat; assumption. +rewrite H3 in H0; assumption. +apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ]. +apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left; + apply Rlt_trans with (/ eps); + [ apply Rinv_0_lt_compat; assumption | assumption ]. +assert (H0 := archimed (/ eps)). +elim H0; intros; assumption. Qed. -Lemma Alembert_cos : (Un_cv [n:nat]``(Rabsolu (cos_n (S n))/(cos_n n))`` R0). -Unfold Un_cv; Intros. -Assert H0 := (archimed_cor1 eps H). -Elim H0; Intros; Exists x. -Intros; Rewrite simpl_cos_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right. -Rewrite mult_INR; Rewrite Rinv_Rmult. -Cut ``/(INR (mult (S (S O)) (S n)))<1``. -Intro; Cut ``/(INR (plus (mult (S (S O)) n) (S O)))<eps``. -Intro; Rewrite <- (Rmult_1l eps). -Apply Rmult_lt; Try Assumption. -Change ``0</(INR (plus (mult (S (S O)) n) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring]. -Apply Rlt_R0_R1. -Cut (lt x (plus (mult (2) n) (1))). -Intro; Assert H5 := (lt_INR ? ? H4). -Apply Rlt_trans with ``/(INR x)``. -Apply Rinv_lt. -Apply Rmult_lt_pos. -Apply lt_INR_0. -Elim H1; Intros; Assumption. -Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring]. -Assumption. -Elim H1; Intros; Assumption. -Apply lt_le_trans with (S n). -Unfold ge in H2; Apply le_lt_n_Sm; Assumption. -Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Idtac | Ring]. -Apply le_n_S; Apply le_n_2n. -Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))). -Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))). -Apply lt_O_Sn. -Replace (S n) with (plus n (1)); [Idtac | Ring]. -Ring. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity]. -Replace (mult (2) (S n)) with (S (S (mult (2) n))). -Apply lt_n_S; Apply lt_O_Sn. -Replace (S n) with (plus n (1)); [Ring | Ring]. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Discriminate. -Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (2) n)); [Apply not_O_INR; Discriminate | Ring]. -Apply Rle_sym1; Left; Apply Rlt_Rinv. -Apply lt_INR_0. -Replace (mult (mult (2) (S n)) (plus (mult (2) n) (1))) with (S (S (plus (mult (4) (mult n n)) (mult (6) n)))). -Apply lt_O_Sn. -Apply INR_eq. -Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity]. +Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0. +unfold Un_cv in |- *; intros. +assert (H0 := archimed_cor1 eps H). +elim H0; intros; exists x. +intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Rabs_Ropp; rewrite Rabs_right. +rewrite mult_INR; rewrite Rinv_mult_distr. +cut (/ INR (2 * S n) < 1). +intro; cut (/ INR (2 * n + 1) < eps). +intro; rewrite <- (Rmult_1_l eps). +apply Rmult_gt_0_lt_compat; try assumption. +change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat; + apply lt_INR_0. +replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +apply Rlt_0_1. +cut (x < 2 * n + 1)%nat. +intro; assert (H5 := lt_INR _ _ H4). +apply Rlt_trans with (/ INR x). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply lt_INR_0. +elim H1; intros; assumption. +apply lt_INR_0; replace (2 * n + 1)%nat with (S (2 * n)); + [ apply lt_O_Sn | ring ]. +assumption. +elim H1; intros; assumption. +apply lt_le_trans with (S n). +unfold ge in H2; apply le_lt_n_Sm; assumption. +replace (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ]. +apply le_n_S; apply le_n_2n. +apply Rmult_lt_reg_l with (INR (2 * S n)). +apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))). +apply lt_O_Sn. +replace (S n) with (n + 1)%nat; [ idtac | ring ]. +ring. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. +replace (2 * S n)%nat with (S (S (2 * n))). +apply lt_n_S; apply lt_O_Sn. +replace (S n) with (n + 1)%nat; [ ring | ring ]. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +replace (2 * n + 1)%nat with (S (2 * n)); + [ apply not_O_INR; discriminate | ring ]. +apply Rle_ge; left; apply Rinv_0_lt_compat. +apply lt_INR_0. +replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 6 * n))). +apply lt_O_Sn. +apply INR_eq. +repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; + rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + replace (INR 0) with 0; [ ring | reflexivity ]. Qed. -Lemma cosn_no_R0 : (n:nat)``(cos_n n)<>0``. -Intro; Unfold cos_n; Unfold Rdiv; Apply prod_neq_R0. -Apply pow_nonzero; DiscrR. -Apply Rinv_neq_R0. -Apply INR_fact_neq_0. +Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0. +intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat. +apply INR_fact_neq_0. Qed. (**********) -Definition cos_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(cos_n i)*(pow x i)`` l). +Definition cos_in (x l:R) : Prop := + infinit_sum (fun i:nat => cos_n i * x ^ i) l. (**********) -Lemma exist_cos : (x:R)(SigT R [l:R](cos_in x l)). -Intro; Generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). -Unfold Pser cos_in; Trivial. +Lemma exist_cos : forall x:R, sigT (fun l:R => cos_in x l). +intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). +unfold Pser, cos_in in |- *; trivial. Qed. (* Definition of cosinus *) (*************************) -Definition cos : R -> R := [x:R](Cases (exist_cos (Rsqr x)) of (Specif.existT a b) => a end). - - -Definition sin_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``. - -Lemma simpl_sin_n : (n:nat) (Rdiv (sin_n (S n)) (sin_n n))==(Ropp (Rinv (INR (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n)))))). -Intro; Unfold sin_n; Replace (S n) with (plus n (1)); [Idtac | Ring]. -Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(/(pow ( -1) n)*(INR (fact (plus (mult (S (S O)) n) (S O)))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow (-1) (S O))``; [Idtac | Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r; Replace (plus (mult (S (S O)) (plus n (S O))) (S O)) with (S (S (plus (mult (S (S O)) n) (S O)))). -Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rinv_Rmult. -Rewrite <- (Rmult_sym ``-1``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Replace (S (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) (plus n (S O))). -Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult. -Ring. -Apply not_O_INR; Discriminate. -Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring]. -Apply not_O_INR; Discriminate. -Apply prod_neq_R0. -Apply not_O_INR; Discriminate. -Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring]. -Apply not_O_INR; Discriminate. -Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring]. -Rewrite mult_plus_distr_r; Cut (n:nat) (S n)=(plus n (1)). -Intros; Rewrite (H (plus (mult (2) n) (1))). -Ring. -Intros; Ring. -Apply INR_fact_neq_0. -Apply not_O_INR; Discriminate. -Apply INR_fact_neq_0. -Apply not_O_INR; Discriminate. -Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0]. -Cut (n:nat) (S (S n))=(plus n (2)); [Intros; Rewrite (H (plus (mult (2) n) (1))); Ring | Intros; Ring]. -Apply pow_nonzero; DiscrR. -Apply INR_fact_neq_0. -Apply pow_nonzero; DiscrR. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. +Definition cos (x:R) : R := + match exist_cos (Rsqr x) with + | existT a b => a + end. + + +Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)). + +Lemma simpl_sin_n : + forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). +intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +replace + ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) * + (/ (-1) ^ n * INR (fact (2 * n + 1)))) with + ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) * + INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r; + replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))). +do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rinv_mult_distr. +rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat. +repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. +ring. +apply not_O_INR; discriminate. +replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. +apply not_O_INR; discriminate. +apply prod_neq_R0. +apply not_O_INR; discriminate. +replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. +apply not_O_INR; discriminate. +replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. +rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat). +intros; rewrite (H (2 * n + 1)%nat). +ring. +intros; ring. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. +cut (forall n:nat, S (S n) = (n + 2)%nat); + [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ]. +apply pow_nonzero; discrR. +apply INR_fact_neq_0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. -Lemma Alembert_sin : (Un_cv [n:nat]``(Rabsolu (sin_n (S n))/(sin_n n))`` R0). -Unfold Un_cv; Intros; Assert H0 := (archimed_cor1 eps H). -Elim H0; Intros; Exists x. -Intros; Rewrite simpl_sin_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right. -Rewrite mult_INR; Rewrite Rinv_Rmult. -Cut ``/(INR (mult (S (S O)) (S n)))<1``. -Intro; Cut ``/(INR (plus (mult (S (S O)) (S n)) (S O)))<eps``. -Intro; Rewrite <- (Rmult_1l eps); Rewrite (Rmult_sym ``/(INR (plus (mult (S (S O)) (S n)) (S O)))``); Apply Rmult_lt; Try Assumption. -Change ``0</(INR (plus (mult (S (S O)) (S n)) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring]. -Apply Rlt_R0_R1. -Cut (lt x (plus (mult (2) (S n)) (1))). -Intro; Assert H5 := (lt_INR ? ? H4); Apply Rlt_trans with ``/(INR x)``. -Apply Rinv_lt. -Apply Rmult_lt_pos. -Apply lt_INR_0; Elim H1; Intros; Assumption. -Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring]. -Assumption. -Elim H1; Intros; Assumption. -Apply lt_le_trans with (S n). -Unfold ge in H2; Apply le_lt_n_Sm; Assumption. -Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Idtac | Ring]. -Apply le_S; Apply le_n_2n. -Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))). -Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))); [Apply lt_O_Sn | Replace (S n) with (plus n (1)); [Idtac | Ring]; Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity]. -Replace (mult (2) (S n)) with (S (S (mult (2) n))). -Apply lt_n_S; Apply lt_O_Sn. -Replace (S n) with (plus n (1)); [Ring | Ring]. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Discriminate. -Apply not_O_INR; Discriminate. -Left; Change ``0</(INR (mult (plus (mult (S (S O)) (S n)) (S O)) (mult (S (S O)) (S n))))``; Apply Rlt_Rinv. -Apply lt_INR_0. -Replace (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n))) with (S (S (S (S (S (S (plus (mult (4) (mult n n)) (mult (10) n)))))))). -Apply lt_O_Sn. -Apply INR_eq; Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity]. +Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0. +unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H). +elim H0; intros; exists x. +intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Rabs_Ropp; rewrite Rabs_right. +rewrite mult_INR; rewrite Rinv_mult_distr. +cut (/ INR (2 * S n) < 1). +intro; cut (/ INR (2 * S n + 1) < eps). +intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1))); + apply Rmult_gt_0_lt_compat; try assumption. +change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat; + apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); + [ apply lt_O_Sn | ring ]. +apply Rlt_0_1. +cut (x < 2 * S n + 1)%nat. +intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x). +apply Rinv_lt_contravar. +apply Rmult_lt_0_compat. +apply lt_INR_0; elim H1; intros; assumption. +apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); + [ apply lt_O_Sn | ring ]. +assumption. +elim H1; intros; assumption. +apply lt_le_trans with (S n). +unfold ge in H2; apply le_lt_n_Sm; assumption. +replace (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ]. +apply le_S; apply le_n_2n. +apply Rmult_lt_reg_l with (INR (2 * S n)). +apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))); + [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. +replace (2 * S n)%nat with (S (S (2 * n))). +apply lt_n_S; apply lt_O_Sn. +replace (S n) with (n + 1)%nat; [ ring | ring ]. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +apply not_O_INR; discriminate. +left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *; + apply Rinv_0_lt_compat. +apply lt_INR_0. +replace ((2 * S n + 1) * (2 * S n))%nat with + (S (S (S (S (S (S (4 * (n * n) + 10 * n))))))). +apply lt_O_Sn. +apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; + rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + replace (INR 0) with 0; [ ring | reflexivity ]. Qed. -Lemma sin_no_R0 : (n:nat)``(sin_n n)<>0``. -Intro; Unfold sin_n; Unfold Rdiv; Apply prod_neq_R0. -Apply pow_nonzero; DiscrR. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. +Lemma sin_no_R0 : forall n:nat, sin_n n <> 0. +intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. (**********) -Definition sin_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(sin_n i)*(pow x i)`` l). +Definition sin_in (x l:R) : Prop := + infinit_sum (fun i:nat => sin_n i * x ^ i) l. (**********) -Lemma exist_sin : (x:R)(SigT R [l:R](sin_in x l)). -Intro; Generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). -Unfold Pser sin_n; Trivial. +Lemma exist_sin : forall x:R, sigT (fun l:R => sin_in x l). +intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). +unfold Pser, sin_n in |- *; trivial. Qed. (***********************) (* Definition of sinus *) -Definition sin : R -> R := [x:R](Cases (exist_sin (Rsqr x)) of (Specif.existT a b) => ``x*a`` end). +Definition sin (x:R) : R := + match exist_sin (Rsqr x) with + | existT a b => x * a + end. (*********************************************) (* PROPERTIES *) (*********************************************) -Lemma cos_sym : (x:R) ``(cos x)==(cos (-x))``. -Intros; Unfold cos; Replace ``(Rsqr (-x))`` with (Rsqr x). -Reflexivity. -Apply Rsqr_neg. +Lemma cos_sym : forall x:R, cos x = cos (- x). +intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x). +reflexivity. +apply Rsqr_neg. Qed. -Lemma sin_antisym : (x:R)``(sin (-x))==-(sin x)``. -Intro; Unfold sin; Replace ``(Rsqr (-x))`` with (Rsqr x); [Idtac | Apply Rsqr_neg]. -Case (exist_sin (Rsqr x)); Intros; Ring. +Lemma sin_antisym : forall x:R, sin (- x) = - sin x. +intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x); + [ idtac | apply Rsqr_neg ]. +case (exist_sin (Rsqr x)); intros; ring. Qed. -Lemma sin_0 : ``(sin 0)==0``. -Unfold sin; Case (exist_sin (Rsqr R0)). -Intros; Ring. +Lemma sin_0 : sin 0 = 0. +unfold sin in |- *; case (exist_sin (Rsqr 0)). +intros; ring. Qed. -Lemma exist_cos0 : (SigT R [l:R](cos_in R0 l)). -Apply Specif.existT with R1. -Unfold cos_in; Unfold infinit_sum; Intros; Exists O. -Intros. -Unfold R_dist. -Induction n. -Unfold cos_n; Simpl. -Unfold Rdiv; Rewrite Rinv_R1. -Do 2 Rewrite Rmult_1r. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Rewrite tech5. -Replace ``(cos_n (S n))*(pow 0 (S n))`` with R0. -Rewrite Rplus_Or. -Apply Hrecn; Unfold ge; Apply le_O_n. -Simpl; Ring. +Lemma exist_cos0 : sigT (fun l:R => cos_in 0 l). +apply existT with 1. +unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat. +intros. +unfold R_dist in |- *. +induction n as [| n Hrecn]. +unfold cos_n in |- *; simpl in |- *. +unfold Rdiv in |- *; rewrite Rinv_1. +do 2 rewrite Rmult_1_r. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +rewrite tech5. +replace (cos_n (S n) * 0 ^ S n) with 0. +rewrite Rplus_0_r. +apply Hrecn; unfold ge in |- *; apply le_O_n. +simpl in |- *; ring. Defined. (* Calculus of (cos 0) *) -Lemma cos_0 : ``(cos 0)==1``. -Cut (cos_in R0 (cos R0)). -Cut (cos_in R0 R1). -Unfold cos_in; Intros; EApply unicity_sum. -Apply H0. -Apply H. -Exact (projT2 ? ? exist_cos0). -Assert H := (projT2 ? ? (exist_cos (Rsqr R0))); Unfold cos; Pattern 1 R0; Replace R0 with (Rsqr R0); [Exact H | Apply Rsqr_O]. -Qed. +Lemma cos_0 : cos 0 = 1. +cut (cos_in 0 (cos 0)). +cut (cos_in 0 1). +unfold cos_in in |- *; intros; eapply uniqueness_sum. +apply H0. +apply H. +exact (projT2 exist_cos0). +assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *; + pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ]. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v index 33c3f6a5f..6470dd581 100644 --- a/theories/Reals/Rtrigo_fun.v +++ b/theories/Reals/Rtrigo_fun.v @@ -8,10 +8,9 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. Open Local Scope R_scope. (*****************************************************************) @@ -24,95 +23,87 @@ Open Local Scope R_scope. (*****************************************************************) (*********) -Lemma Alembert_exp:(Un_cv - [n:nat](Rabsolu (Rmult (Rinv (INR (fact (S n)))) - (Rinv (Rinv (INR (fact n)))))) R0). -Unfold Un_cv;Intros;Elim (total_order_Rgt eps R1);Intro. -Split with O;Intros;Rewrite (simpl_fact n);Unfold R_dist; - Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n))))); - Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n)))); - Cut (Rgt (Rinv (INR (S n))) R0). -Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))). -Cut (Rlt (Rminus (Rinv eps) R1) R0). -Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) R0 (INR n) H2 - (pos_INR n));Clear H2;Intro; - Unfold Rminus in H2;Generalize (Rlt_compatibility R1 - (Rplus (Rinv eps) (Ropp R1)) (INR n) H2); - Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps); - [Clear H2;Intro|Ring]. -Rewrite (Rplus_sym R1 (INR n)) in H2;Rewrite <-(S_INR n) in H2; - Generalize (Rmult_gt (Rinv (INR (S n))) eps H1 H);Intro; - Unfold Rgt in H3; - Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps) - (INR (S n)) H3 H2);Intro; - Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H4; - Rewrite (Rinv_r eps (imp_not_Req eps R0 - (or_intror (Rlt eps R0) (Rgt eps R0) H))) - in H4;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1) - in H4;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H4; - Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H4; - Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) - (sym_not_equal nat O (S n) (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_R1; - Apply (Rinv_lt R1 eps);Auto; - Rewrite (let (H1,H2)=(Rmult_ne eps) in H2);Unfold Rgt in H;Assumption. -Unfold Rgt in H1;Apply Rlt_le;Assumption. -Unfold Rgt;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn. +Lemma Alembert_exp : + Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0. +unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro. +split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *; + rewrite (Rminus_0_r (Rabs (/ INR (S n)))); + rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). +intro; rewrite (Rabs_pos_eq (/ INR (S n))). +cut (/ eps - 1 < 0). +intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n)); + clear H2; intro; unfold Rminus in H2; + generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2); + replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ]. +rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2; + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); + intro; unfold Rgt in H3; + generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2); + intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4; + rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) + in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4; + rewrite (Rmult_comm (/ INR (S n))) in H4; + rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4; + rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; + assumption. +apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1; + apply (Rinv_lt_contravar 1 eps); auto; + rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; + assumption. +unfold Rgt in H1; apply Rlt_le; assumption. +unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. (**) -Cut `0<=(up (Rminus (Rinv eps) R1))`. -Intro;Elim (IZN (up (Rminus (Rinv eps) R1)) H0);Intros; - Split with x;Intros;Rewrite (simpl_fact n);Unfold R_dist; - Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n))))); - Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n)))); - Cut (Rgt (Rinv (INR (S n))) R0). -Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))). -Cut (Rlt (Rminus (Rinv eps) R1) (INR x)). -Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) (INR x) (INR n) - H4 (le_INR x n ([n,m:nat; H:(ge m n)]H x n H2))); - Clear H4;Intro;Unfold Rminus in H4;Generalize (Rlt_compatibility R1 - (Rplus (Rinv eps) (Ropp R1)) (INR n) H4); - Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps); - [Clear H4;Intro|Ring]. -Rewrite (Rplus_sym R1 (INR n)) in H4;Rewrite <-(S_INR n) in H4; - Generalize (Rmult_gt (Rinv (INR (S n))) eps H3 H);Intro; - Unfold Rgt in H5; - Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps) - (INR (S n)) H5 H4);Intro; - Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H6; - Rewrite (Rinv_r eps (imp_not_Req eps R0 - (or_intror (Rlt eps R0) (Rgt eps R0) H))) - in H6;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1) - in H6;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H6; - Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H6; - Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) - (sym_not_equal nat O (S n) (O_S n)))) in H6; - Rewrite (let (H1,H2)=(Rmult_ne eps) in H1) in H6;Assumption. -Cut (IZR (up (Rminus (Rinv eps) R1)))==(IZR (INZ x)); - [Intro|Rewrite H1;Trivial]. -Elim (archimed (Rminus (Rinv eps) R1));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;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn. -Apply (le_O_IZR (up (Rminus (Rinv eps) R1))); - Apply (Rle_trans R0 (Rminus (Rinv eps) R1) - (IZR (up (Rminus (Rinv eps) R1)))). -Generalize (Rgt_not_le eps R1 b);Clear b;Unfold Rle;Intro;Elim H0; - Clear H0;Intro. -Left;Unfold Rgt in H; - Generalize (Rlt_monotony (Rinv eps) eps R1 (Rlt_Rinv eps H) H0); - Rewrite (Rinv_l eps (sym_not_eqT R R0 eps - (imp_not_Req R0 eps (or_introl (Rlt R0 eps) (Rgt R0 eps) H)))); - Rewrite (let (H1,H2)=(Rmult_ne (Rinv eps)) in H1);Intro; - Fold (Rgt (Rminus (Rinv eps) R1) R0);Apply Rgt_minus;Unfold Rgt; - Assumption. -Right;Rewrite H0;Rewrite Rinv_R1;Apply sym_eqT;Apply eq_Rminus;Auto. -Elim (archimed (Rminus (Rinv eps) R1));Intros;Clear H1; - Unfold Rgt in H0;Apply Rlt_le;Assumption. +cut (0 <= up (/ eps - 1))%Z. +intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros; + rewrite (simpl_fact n); unfold R_dist in |- *; + rewrite (Rminus_0_r (Rabs (/ INR (S n)))); + rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). +intro; rewrite (Rabs_pos_eq (/ INR (S n))). +cut (/ eps - 1 < INR x). +intro; + generalize + (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4 + (le_INR x n ((fun (n m:nat) (H:(m >= n)%nat) => H) x n H2))); + clear H4; intro; unfold Rminus in H4; + generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4); + replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ]. +rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4; + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); + intro; unfold Rgt in H5; + generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4); + intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6; + rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) + in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6; + rewrite (Rmult_comm (/ INR (S n))) in H6; + rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6; + rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; + assumption. +cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x)); + [ intro | rewrite H1; trivial ]. +elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5; + rewrite H4 in H5; rewrite INR_IZR_INZ; assumption. +unfold Rgt in H1; apply Rlt_le; assumption. +unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +apply (le_O_IZR (up (/ eps - 1))); + apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))). +generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0; + clear H0; intro. +left; unfold Rgt in H; + generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0); + rewrite + (Rinv_l eps + (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H)))) + ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); + intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; + unfold Rgt in |- *; assumption. +right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto. +elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le; + assumption. Qed. - diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v index 1155a05a0..ca0eb33dc 100644 --- a/theories/Reals/Rtrigo_reg.v +++ b/theories/Reals/Rtrigo_reg.v @@ -8,490 +8,601 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require SeqSeries. -Require Rtrigo. -Require Ranalysis1. -Require PSeries_reg. -V7only [Import nat_scope. Import Z_scope. Import R_scope.]. +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Import Rtrigo. +Require Import Ranalysis1. +Require Import PSeries_reg. Open Local Scope nat_scope. Open Local Scope R_scope. -Lemma CVN_R_cos : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn). -Unfold CVN_R; Intros. -Cut (r::R)<>``0``. -Intro hyp_r; Unfold CVN_r. -Apply Specif.existT with [n:nat]``/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))``. -Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (mult (S (S O)) k)))*(pow r (mult (S (S O)) k))``) n) l)). -Intro; Elim X; Intros. -Apply existTT with x. -Split. -Apply p. -Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult. -Rewrite pow_1_abs; Rewrite Rmult_1l. -Cut ``0</(INR (fact (mult (S (S O)) n)))``. -Intro; Rewrite (Rabsolu_right ? (Rle_sym1 ? ? (Rlt_le ? ? H1))). -Apply Rle_monotony. -Left; Apply H1. -Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs. -Rewrite Rabsolu_Rabsolu. -Unfold Boule in H0; Rewrite minus_R0 in H0. -Left; Apply H0. -Apply Rlt_Rinv; Apply INR_fact_lt_0. -Apply Alembert_C2. -Intro; Apply Rabsolu_no_R0. -Apply prod_neq_R0. -Apply Rinv_neq_R0. -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; Intros. -Cut ``0<eps/(Rsqr r)``. -Intro; Elim (H0 ? H2); Intros N0 H3. -Exists N0; Intros. -Unfold R_dist; Assert H5 := (H3 ? H4). -Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (mult (S (S O)) (S n))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (mult (S (S O)) (S n))))/((pow ( -1) n)/(INR (fact (mult (S (S O)) n))))))``. -Apply Rlt_monotony_contra with ``/(Rsqr r)``. -Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption. -Pattern 1 ``/(Rsqr r)``; Replace ``/(Rsqr r)`` with ``(Rabsolu (/(Rsqr r)))``. -Rewrite <- Rabsolu_mult; Rewrite Rminus_distr; Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Apply H5. -Unfold Rsqr; Apply prod_neq_R0; Assumption. -Rewrite Rabsolu_Rinv. -Rewrite Rabsolu_right. -Reflexivity. -Apply Rle_sym1; Apply pos_Rsqr. -Unfold Rsqr; Apply prod_neq_R0; Assumption. -Rewrite (Rmult_sym (Rsqr r)); Unfold Rdiv; Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs; Rewrite Rmult_1l; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r. -Rewrite Rabsolu_Rinv. -Rewrite Rabsolu_mult; Rewrite (pow_1_abs n); Rewrite Rmult_1l; Rewrite <- Rabsolu_Rinv. -Rewrite Rinv_Rinv. -Rewrite Rinv_Rmult. -Rewrite Rabsolu_Rinv. -Rewrite Rinv_Rinv. -Rewrite (Rmult_sym ``(Rabsolu (Rabsolu (pow r (mult (S (S O)) (S n)))))``); Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite Rmult_assoc; Apply Rmult_mult_r. -Rewrite Rabsolu_Rinv. -Do 2 Rewrite Rabsolu_Rabsolu; Repeat Rewrite Rabsolu_right. -Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``. -Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Unfold Rsqr; Ring. -Apply pow_nonzero; Assumption. -Replace (mult (2) (S n)) with (S (S (mult (2) n))). -Simpl; Ring. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r). -Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r). -Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption. -Apply Rabsolu_no_R0; Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption. -Apply INR_fact_neq_0. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Apply prod_neq_R0. -Apply pow_nonzero; DiscrR. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply H1. -Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption. -Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0). +Lemma CVN_R_cos : + forall fn:nat -> R -> R, + fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) -> + CVN_R fn. +unfold CVN_R in |- *; intros. +cut ((r:R) <> 0). +intro hyp_r; unfold CVN_r in |- *. +apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). +cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k))) + n) l)). +intro; elim X; intros. +apply existT with x. +split. +apply p. +intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult. +rewrite pow_1_abs; rewrite Rmult_1_l. +cut (0 < / INR (fact (2 * n))). +intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). +apply Rmult_le_compat_l. +left; apply H1. +rewrite <- RPow_abs; apply pow_maj_Rabs. +rewrite Rabs_Rabsolu. +unfold Boule in H0; rewrite Rminus_0_r in H0. +left; apply H0. +apply Rinv_0_lt_compat; apply INR_fact_lt_0. +apply Alembert_C2. +intro; apply Rabs_no_R0. +apply prod_neq_R0. +apply Rinv_neq_0_compat. +apply INR_fact_neq_0. +apply pow_nonzero; assumption. +assert (H0 := Alembert_cos). +unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros. +cut (0 < eps / Rsqr r). +intro; elim (H0 _ H2); intros N0 H3. +exists N0; intros. +unfold R_dist in |- *; assert (H5 := H3 _ H4). +unfold R_dist in H5; + replace + (Rabs + (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) / + Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with + (Rsqr r * + Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))). +apply Rmult_lt_reg_l with (/ Rsqr r). +apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)). +rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r; + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5. +unfold Rsqr in |- *; apply prod_neq_R0; assumption. +rewrite Rabs_Rinv. +rewrite Rabs_right. +reflexivity. +apply Rle_ge; apply Rle_0_sqr. +unfold Rsqr in |- *; apply prod_neq_R0; assumption. +rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l; + repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rabs_Rinv. +rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l; + rewrite <- Rabs_Rinv. +rewrite Rinv_involutive. +rewrite Rinv_mult_distr. +rewrite Rabs_Rinv. +rewrite Rinv_involutive. +rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rabs_Rinv. +do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right. +replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). +repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +unfold Rsqr in |- *; ring. +apply pow_nonzero; assumption. +replace (2 * S n)%nat with (S (S (2 * n))). +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply Rabs_no_R0; apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply INR_fact_neq_0. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply prod_neq_R0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply H1. +apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; + elim (Rlt_irrefl _ H0). Qed. (**********) -Lemma continuity_cos : (continuity cos). -Pose fn := [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``. -Cut (CVN_R fn). -Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)). -Intro cv; Cut ((n:nat)(continuity (fn n))). -Intro; Cut (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; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; 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. -Case (cv x); Case (exist_cos (Rsqr x)); Intros. -Symmetry; EApply UL_sequence. -Apply u. -Unfold cos_in in c; Unfold infinit_sum in c; Unfold Un_cv; Intros. -Elim (c ? H0); Intros N0 H1. -Exists N0; Intros. -Unfold R_dist in H1; Unfold R_dist SP. -Replace (sum_f_R0 [k:nat](fn k x) n) with (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr x) i)`` n). -Apply H1; Assumption. -Apply sum_eq; Intros. -Unfold cos_n fn; Apply Rmult_mult_r. -Unfold Rsqr; Rewrite pow_sqr; Reflexivity. -Intro; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity]. -Apply continuity_mult. -Apply derivable_continuous; Apply derivable_const. -Apply derivable_continuous; Apply (derivable_pow (mult (2) n)). -Apply CVN_R_CVS; Apply X. -Apply CVN_R_cos; Unfold fn; Reflexivity. +Lemma continuity_cos : continuity cos. +pose (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)). +cut (CVN_R fn). +intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). +intro cv; cut (forall n:nat, continuity (fn n)). +intro; cut (forall x:R, cos x = SFL fn cv x). +intro; cut (continuity (SFL fn cv) -> continuity cos). +intro; apply H1. +apply SFL_continuity; assumption. +unfold continuity in |- *; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +elim (H1 x _ H2); intros. +exists x0; intros. +elim H3; intros. +split. +apply H4. +intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6. +intro; unfold cos, SFL in |- *. +case (cv x); case (exist_cos (Rsqr x)); intros. +symmetry in |- *; eapply UL_sequence. +apply u. +unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros. +elim (c _ H0); intros N0 H1. +exists N0; intros. +unfold R_dist in H1; unfold R_dist, SP in |- *. +replace (sum_f_R0 (fun k:nat => fn k x) n) with + (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n). +apply H1; assumption. +apply sum_eq; intros. +unfold cos_n, fn in |- *; apply Rmult_eq_compat_l. +unfold Rsqr in |- *; rewrite pow_sqr; reflexivity. +intro; unfold fn in |- *; + replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with + (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F; + [ idtac | reflexivity ]. +apply continuity_mult. +apply derivable_continuous; apply derivable_const. +apply derivable_continuous; apply (derivable_pow (2 * n)). +apply CVN_R_CVS; apply X. +apply CVN_R_cos; unfold fn in |- *; reflexivity. Qed. (**********) -Lemma continuity_sin : (continuity sin). -Unfold continuity; 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; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros. -Elim (H0 ? H); Intros. -Exists x0; Intros. -Elim H1; Intros. -Split. -Assumption. -Intros; Rewrite <- (cos_shift x); Rewrite <- (cos_shift x1); Apply H3. -Elim H4; Intros. -Split. -Unfold D_x no_cond; Split. -Trivial. -Red; Intro; Unfold D_x no_cond in H5; Elim H5; Intros _ H8; Elim H8; Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp x1); Apply eq_Ropp; Apply r_Rplus_plus with ``PI/2``; Apply H7. -Replace ``PI/2-x1-(PI/2-x)`` with ``x-x1``; [Idtac | Ring]; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H6. +Lemma continuity_sin : continuity sin. +unfold continuity in |- *; intro. +assert (H0 := continuity_cos (PI / 2 - x)). +unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0; + unfold limit_in in H0; simpl in H0; unfold R_dist in H0; + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +elim (H0 _ H); intros. +exists x0; intros. +elim H1; intros. +split. +assumption. +intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3. +elim H4; intros. +split. +unfold D_x, no_cond in |- *; split. +trivial. +red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8; + rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1); + apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); + apply H7. +replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ]; + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6. Qed. -Lemma CVN_R_sin : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn). -Unfold CVN_R; Unfold CVN_r; Intros fn H r. -Apply Specif.existT with [n:nat]``/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))``. -Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow r (mult (S (S O)) k))``) n) l)). -Intro; Elim X; Intros. -Apply existTT with x. -Split. -Apply p. -Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l. -Cut ``0</(INR (fact (plus (mult (S (S O)) n) (S O))))``. -Intro; Rewrite (Rabsolu_right ? (Rle_sym1 ? ? (Rlt_le ? ? H1))). -Apply Rle_monotony. -Left; Apply H1. -Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs. -Rewrite Rabsolu_Rabsolu; Unfold Boule in H0; Rewrite minus_R0 in H0; Left; Apply H0. -Apply Rlt_Rinv; Apply INR_fact_lt_0. -Cut (r::R)<>``0``. -Intro; Apply Alembert_C2. -Intro; Apply Rabsolu_no_R0. -Apply prod_neq_R0. -Apply Rinv_neq_R0; 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; Intros. -Cut ``0<eps/(Rsqr r)``. -Intro; Elim (H1 ? H3); Intros N0 H4. -Exists N0; Intros. -Unfold R_dist; Assert H6 := (H4 ? H5). -Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))/((pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O)))))))``. -Apply Rlt_monotony_contra with ``/(Rsqr r)``. -Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption. -Pattern 1 ``/(Rsqr r)``; Rewrite <- (Rabsolu_right ``/(Rsqr r)``). -Rewrite <- Rabsolu_mult. -Rewrite Rminus_distr. -Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps). -Apply H6. -Unfold Rsqr; Apply prod_neq_R0; Assumption. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption. -Unfold Rdiv; Rewrite (Rmult_sym (Rsqr r)); Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs. -Rewrite Rmult_1l. -Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r. -Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Rewrite Rabsolu_mult. -Rewrite Rabsolu_Rinv. -Rewrite pow_1_abs; Rewrite Rinv_R1; Rewrite Rmult_1l. -Rewrite Rinv_Rmult. -Rewrite <- Rabsolu_Rinv. -Rewrite Rinv_Rinv. -Rewrite Rabsolu_mult. -Do 2 Rewrite Rabsolu_Rabsolu. -Rewrite (Rmult_sym ``(Rabsolu (pow r (mult (S (S O)) (S n))))``). -Rewrite Rmult_assoc; Apply Rmult_mult_r. -Rewrite Rabsolu_Rinv. -Rewrite Rabsolu_Rabsolu. -Repeat Rewrite Rabsolu_right. -Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``. -Do 2 Rewrite <- Rmult_assoc. -Rewrite <- Rinv_l_sym. -Unfold Rsqr; Ring. -Apply pow_nonzero; Assumption. -Replace (mult (2) (S n)) with (S (S (mult (2) n))). -Simpl; Ring. -Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring. -Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r). -Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r). -Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption. -Apply INR_fact_neq_0. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption. -Apply pow_nonzero; DiscrR. -Apply INR_fact_neq_0. -Apply pow_nonzero; DiscrR. -Apply Rinv_neq_R0; Apply INR_fact_neq_0. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption]. -Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0). +Lemma CVN_R_sin : + forall fn:nat -> R -> R, + fn = + (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) -> + CVN_R fn. +unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r. +apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)). +cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 + (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n) + l)). +intro; elim X; intros. +apply existT with x. +split. +apply p. +intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult; + rewrite pow_1_abs; rewrite Rmult_1_l. +cut (0 < / INR (fact (2 * n + 1))). +intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). +apply Rmult_le_compat_l. +left; apply H1. +rewrite <- RPow_abs; apply pow_maj_Rabs. +rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left; + apply H0. +apply Rinv_0_lt_compat; apply INR_fact_lt_0. +cut ((r:R) <> 0). +intro; apply Alembert_C2. +intro; apply Rabs_no_R0. +apply prod_neq_R0. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply pow_nonzero; assumption. +assert (H1 := Alembert_sin). +unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros. +cut (0 < eps / Rsqr r). +intro; elim (H1 _ H3); intros N0 H4. +exists N0; intros. +unfold R_dist in |- *; assert (H6 := H4 _ H5). +unfold R_dist in H5; + replace + (Rabs + (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) / + Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with + (Rsqr r * + Rabs + ((-1) ^ S n / INR (fact (2 * S n + 1)) / + ((-1) ^ n / INR (fact (2 * n + 1))))). +apply Rmult_lt_reg_l with (/ Rsqr r). +apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)). +rewrite <- Rabs_mult. +rewrite Rmult_minus_distr_l. +rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). +apply H6. +unfold Rsqr in |- *; apply prod_neq_R0; assumption. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. +unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite pow_1_abs. +rewrite Rmult_1_l. +repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +rewrite Rabs_mult. +rewrite Rabs_Rinv. +rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l. +rewrite Rinv_mult_distr. +rewrite <- Rabs_Rinv. +rewrite Rinv_involutive. +rewrite Rabs_mult. +do 2 rewrite Rabs_Rabsolu. +rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))). +rewrite Rmult_assoc; apply Rmult_eq_compat_l. +rewrite Rabs_Rinv. +rewrite Rabs_Rabsolu. +repeat rewrite Rabs_right. +replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). +do 2 rewrite <- Rmult_assoc. +rewrite <- Rinv_l_sym. +unfold Rsqr in |- *; ring. +apply pow_nonzero; assumption. +replace (2 * S n)%nat with (S (S (2 * n))). +simpl in |- *; ring. +apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; + ring. +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rle_ge; apply pow_le; left; apply (cond_pos r). +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply INR_fact_neq_0. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. +apply Rabs_no_R0; apply pow_nonzero; assumption. +apply pow_nonzero; discrR. +apply INR_fact_neq_0. +apply pow_nonzero; discrR. +apply Rinv_neq_0_compat; apply INR_fact_neq_0. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ]. +assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; + elim (Rlt_irrefl _ H0). Qed. (* (sin h)/h -> 1 when h -> 0 *) -Lemma derivable_pt_lim_sin_0 : (derivable_pt_lim sin R0 R1). -Unfold derivable_pt_lim; Intros. -Pose fn := [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``. -Cut (CVN_R fn). -Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)). -Intro cv. -Pose r := (mkposreal ? Rlt_R0_R1). -Cut (CVN_r fn r). -Intro; Cut ((n:nat; y:R)(Boule ``0`` r y)->(continuity_pt (fn n) y)). -Intro; Cut (Boule R0 r R0). -Intro; Assert H2 := (SFL_continuity_pt ? cv ? X0 H0 ? H1). -Unfold continuity_pt in H2; Unfold continue_in in H2; Unfold limit1_in in H2; Unfold limit_in in H2; Simpl in H2; Unfold R_dist in H2. -Elim (H2 ? H); Intros alp H3. -Elim H3; Intros. -Exists (mkposreal ? H4). -Simpl; Intros. -Rewrite sin_0; Rewrite Rplus_Ol; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or. -Cut ``(Rabsolu ((SFL fn cv h)-(SFL fn cv 0))) < eps``. -Intro; Cut (SFL fn cv R0)==R1. -Intro; Cut (SFL fn cv h)==``(sin h)/h``. -Intro; Rewrite H9 in H8; Rewrite H10 in H8. -Apply H8. -Unfold SFL sin. -Case (cv h); Intros. -Case (exist_sin (Rsqr h)); Intros. -Unfold Rdiv; Rewrite (Rinv_r_simpl_m h x0 H6). -EApply UL_sequence. -Apply u. -Unfold sin_in in s; Unfold sin_n infinit_sum in s; Unfold SP fn Un_cv; Intros. -Elim (s ? H10); Intros N0 H11. -Exists N0; Intros. -Unfold R_dist; Unfold R_dist in H11. -Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow h (mult (S (S O)) k))`` n) with (sum_f_R0 [i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (Rsqr h) i)`` n). -Apply H11; Assumption. -Apply sum_eq; Intros; Apply Rmult_mult_r; Unfold Rsqr; Rewrite pow_sqr; Reflexivity. -Unfold SFL sin. -Case (cv R0); Intros. -EApply UL_sequence. -Apply u. -Unfold SP fn; Unfold Un_cv; Intros; Exists (S O); Intros. -Unfold R_dist; Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (mult (S (S O)) k))`` n) with R1. -Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. -Rewrite decomp_sum. -Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rplus_plus_r. -Symmetry; Apply sum_eq_R0; Intros. -Rewrite Rmult_Ol; Rewrite Rmult_Or; Reflexivity. -Unfold ge in H10; Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H10]. -Apply H5. -Split. -Unfold D_x no_cond; Split. -Trivial. -Apply not_sym; Apply H6. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H7. -Unfold Boule; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Apply (cond_pos r). -Intros; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity]. -Apply continuity_pt_mult. -Apply derivable_continuous_pt. -Apply derivable_pt_const. -Apply derivable_continuous_pt. -Apply (derivable_pt_pow (mult (2) n) y). -Apply (X r). -Apply (CVN_R_CVS ? X). -Apply CVN_R_sin; Unfold fn; Reflexivity. +Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1. +unfold derivable_pt_lim in |- *; intros. +pose + (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)). +cut (CVN_R fn). +intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). +intro cv. +pose (r := mkposreal _ Rlt_0_1). +cut (CVN_r fn r). +intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y). +intro; cut (Boule 0 r 0). +intro; assert (H2 := SFL_continuity_pt _ cv _ X0 H0 _ H1). +unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. +elim (H2 _ H); intros alp H3. +elim H3; intros. +exists (mkposreal _ H4). +simpl in |- *; intros. +rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r. +cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps). +intro; cut (SFL fn cv 0 = 1). +intro; cut (SFL fn cv h = sin h / h). +intro; rewrite H9 in H8; rewrite H10 in H8. +apply H8. +unfold SFL, sin in |- *. +case (cv h); intros. +case (exist_sin (Rsqr h)); intros. +unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6). +eapply UL_sequence. +apply u. +unfold sin_in in s; unfold sin_n, infinit_sum in s; + unfold SP, fn, Un_cv in |- *; intros. +elim (s _ H10); intros N0 H11. +exists N0; intros. +unfold R_dist in |- *; unfold R_dist in H11. +replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n) + with + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n). +apply H11; assumption. +apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *; + rewrite pow_sqr; reflexivity. +unfold SFL, sin in |- *. +case (cv 0); intros. +eapply UL_sequence. +apply u. +unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros. +unfold R_dist in |- *; + replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n) + with 1. +unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +rewrite decomp_sum. +simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_eq_compat_l. +symmetry in |- *; apply sum_eq_R0; intros. +rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity. +unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ]. +apply H5. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq (A:=R)); apply H6. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7. +unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r). +intros; unfold fn in |- *; + replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with + (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F; + [ idtac | reflexivity ]. +apply continuity_pt_mult. +apply derivable_continuous_pt. +apply derivable_pt_const. +apply derivable_continuous_pt. +apply (derivable_pt_pow (2 * n) y). +apply (X r). +apply (CVN_R_CVS _ X). +apply CVN_R_sin; unfold fn in |- *; reflexivity. Qed. (* ((cos h)-1)/h -> 0 when h -> 0 *) -Lemma derivable_pt_lim_cos_0 : (derivable_pt_lim cos ``0`` ``0``). -Unfold derivable_pt_lim; Intros. -Assert H0 := derivable_pt_lim_sin_0. -Unfold derivable_pt_lim in H0. -Cut ``0<eps/2``. -Intro; Elim (H0 ? H1); Intros del H2. -Cut (continuity_pt sin ``0``). -Intro; Unfold continuity_pt in H3; Unfold continue_in in H3; Unfold limit1_in in H3; Unfold limit_in in H3; Simpl in H3; Unfold R_dist in H3. -Cut ``0<eps/2``; [Intro | Assumption]. -Elim (H3 ? H4); Intros del_c H5. -Cut ``0<(Rmin del del_c)``. -Intro; Pose delta := (mkposreal ? H6). -Exists delta; Intros. -Rewrite Rplus_Ol; Replace ``((cos h)-(cos 0))`` with ``-2*(Rsqr (sin (h/2)))``. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or. -Unfold Rdiv; Do 2 Rewrite Ropp_mul1. -Rewrite Rabsolu_Ropp. -Replace ``2*(Rsqr (sin (h*/2)))*/h`` with ``(sin (h/2))*((sin (h/2))/(h/2)-1)+(sin (h/2))``. -Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))*((sin (h/2))/(h/2)-1)))+(Rabsolu ((sin (h/2))))``. -Apply Rabsolu_triang. -Rewrite (double_var eps); Apply Rplus_lt. -Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))/(h/2)-1))``. -Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin (h/2))/(h/2)-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony. -Apply Rabsolu_pos. -Assert H9 := (SIN_bound ``h/2``). -Unfold Rabsolu; Case (case_Rabsolu ``(sin (h/2))``); Intro. -Pattern 3 R1; Rewrite <- (Ropp_Ropp ``1``). -Apply Rle_Ropp1. -Elim H9; Intros; Assumption. -Elim H9; Intros; Assumption. -Cut ``(Rabsolu (h/2))<del``. -Intro; Cut ``h/2<>0``. -Intro; Assert H11 := (H2 ? H10 H9). -Rewrite Rplus_Ol in H11; Rewrite sin_0 in H11. -Rewrite minus_R0 in H11; Apply H11. -Unfold Rdiv; Apply prod_neq_R0. -Apply H7. -Apply Rinv_neq_R0; DiscrR. -Apply Rlt_trans with ``del/2``. -Unfold Rdiv; Rewrite Rabsolu_mult. -Rewrite (Rabsolu_right ``/2``). -Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony. -Apply Rlt_Rinv; Sup0. -Apply Rlt_le_trans with (pos delta). -Apply H8. -Unfold delta; Simpl; Apply Rmin_l. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0. -Rewrite <- (Rplus_Or ``del/2``); Pattern 1 del; Rewrite (double_var del); Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos. -Apply (cond_pos del). -Apply Rlt_Rinv; Sup0. -Elim H5; Intros; Assert H11 := (H10 ``h/2``). -Rewrite sin_0 in H11; Do 2 Rewrite minus_R0 in H11. -Apply H11. -Split. -Unfold D_x no_cond; Split. -Trivial. -Apply not_sym; Unfold Rdiv; Apply prod_neq_R0. -Apply H7. -Apply Rinv_neq_R0; DiscrR. -Apply Rlt_trans with ``del_c/2``. -Unfold Rdiv; Rewrite Rabsolu_mult. -Rewrite (Rabsolu_right ``/2``). -Do 2 Rewrite <- (Rmult_sym ``/2``). -Apply Rlt_monotony. -Apply Rlt_Rinv; Sup0. -Apply Rlt_le_trans with (pos delta). -Apply H8. -Unfold delta; Simpl; Apply Rmin_r. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0. -Rewrite <- (Rplus_Or ``del_c/2``); Pattern 2 del_c; Rewrite (double_var del_c); Apply Rlt_compatibility. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply H9. -Apply Rlt_Rinv; Sup0. -Rewrite Rminus_distr; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite (Rmult_sym ``2``); Unfold Rdiv Rsqr. -Repeat Rewrite Rmult_assoc. -Repeat Apply Rmult_mult_r. -Rewrite Rinv_Rmult. -Rewrite Rinv_Rinv. -Apply Rmult_sym. -DiscrR. -Apply H7. -Apply Rinv_neq_R0; DiscrR. -Pattern 2 h; Replace h with ``2*(h/2)``. -Rewrite (cos_2a_sin ``h/2``). -Rewrite cos_0; Unfold Rsqr; Ring. -Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m. -DiscrR. -Unfold Rmin; Case (total_order_Rle del del_c); Intro. -Apply (cond_pos del). -Elim H5; Intros; Assumption. -Apply continuity_sin. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]. +Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0. +unfold derivable_pt_lim in |- *; intros. +assert (H0 := derivable_pt_lim_sin_0). +unfold derivable_pt_lim in H0. +cut (0 < eps / 2). +intro; elim (H0 _ H1); intros del H2. +cut (continuity_pt sin 0). +intro; unfold continuity_pt in H3; unfold continue_in in H3; + unfold limit1_in in H3; unfold limit_in in H3; simpl in H3; + unfold R_dist in H3. +cut (0 < eps / 2); [ intro | assumption ]. +elim (H3 _ H4); intros del_c H5. +cut (0 < Rmin del del_c). +intro; pose (delta := mkposreal _ H6). +exists delta; intros. +rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))). +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. +unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse. +rewrite Rabs_Ropp. +replace (2 * Rsqr (sin (h * / 2)) * / h) with + (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)). +apply Rle_lt_trans with + (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)). +rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *; + rewrite <- Rmult_1_r; apply Rmult_le_compat_l. +apply Rabs_pos. +assert (H9 := SIN_bound (h / 2)). +unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro. +pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1). +apply Ropp_le_contravar. +elim H9; intros; assumption. +elim H9; intros; assumption. +cut (Rabs (h / 2) < del). +intro; cut (h / 2 <> 0). +intro; assert (H11 := H2 _ H10 H9). +rewrite Rplus_0_l in H11; rewrite sin_0 in H11. +rewrite Rminus_0_r in H11; apply H11. +unfold Rdiv in |- *; apply prod_neq_R0. +apply H7. +apply Rinv_neq_0_compat; discrR. +apply Rlt_trans with (del / 2). +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite (Rabs_right (/ 2)). +do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rlt_le_trans with (pos delta). +apply H8. +unfold delta in |- *; simpl in |- *; apply Rmin_l. +apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. +rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *; + rewrite (double_var del); apply Rplus_lt_compat_l; + unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply (cond_pos del). +apply Rinv_0_lt_compat; prove_sup0. +elim H5; intros; assert (H11 := H10 (h / 2)). +rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11. +apply H11. +split. +unfold D_x, no_cond in |- *; split. +trivial. +apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0. +apply H7. +apply Rinv_neq_0_compat; discrR. +apply Rlt_trans with (del_c / 2). +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite (Rabs_right (/ 2)). +do 2 rewrite <- (Rmult_comm (/ 2)). +apply Rmult_lt_compat_l. +apply Rinv_0_lt_compat; prove_sup0. +apply Rlt_le_trans with (pos delta). +apply H8. +unfold delta in |- *; simpl in |- *; apply Rmin_r. +apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. +rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *; + rewrite (double_var del_c); apply Rplus_lt_compat_l. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply H9. +apply Rinv_0_lt_compat; prove_sup0. +rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *. +repeat rewrite Rmult_assoc. +repeat apply Rmult_eq_compat_l. +rewrite Rinv_mult_distr. +rewrite Rinv_involutive. +apply Rmult_comm. +discrR. +apply H7. +apply Rinv_neq_0_compat; discrR. +pattern h at 2 in |- *; replace h with (2 * (h / 2)). +rewrite (cos_2a_sin (h / 2)). +rewrite cos_0; unfold Rsqr in |- *; ring. +unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. +discrR. +unfold Rmin in |- *; case (Rle_dec del del_c); intro. +apply (cond_pos del). +elim H5; intros; assumption. +apply continuity_sin. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. (**********) -Theorem derivable_pt_lim_sin : (x:R)(derivable_pt_lim sin x (cos x)). -Intro; Assert H0 := derivable_pt_lim_sin_0. -Assert H := derivable_pt_lim_cos_0. -Unfold derivable_pt_lim in H0 H. -Unfold derivable_pt_lim; Intros. -Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H1 | Apply Rlt_Rinv; Sup0]]. -Elim (H0 ? H2); Intros alp1 H3. -Elim (H ? H2); Intros alp2 H4. -Pose alp := (Rmin alp1 alp2). -Cut ``0<alp``. -Intro; Exists (mkposreal ? H5); Intros. -Replace ``((sin (x+h))-(sin x))/h-(cos x)`` with ``(sin x)*((cos h)-1)/h+(cos x)*((sin h)/h-1)``. -Apply Rle_lt_trans with ``(Rabsolu ((sin x)*((cos h)-1)/h))+(Rabsolu ((cos x)*((sin h)/h-1)))``. -Apply Rabsolu_triang. -Rewrite (double_var eps); Apply Rplus_lt. -Apply Rle_lt_trans with ``(Rabsolu ((cos h)-1)/h)``. -Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu (((cos h)-1)/h))``; Rewrite <- Rmult_1r; Apply Rle_monotony. -Apply Rabsolu_pos. -Assert H8 := (SIN_bound x); Elim H8; Intros. -Unfold Rabsolu; Case (case_Rabsolu (sin x)); Intro. -Rewrite <- (Ropp_Ropp R1). -Apply Rle_Ropp1; Assumption. -Assumption. -Cut ``(Rabsolu h)<alp2``. -Intro; Assert H9 := (H4 ? H6 H8). -Rewrite cos_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9. -Apply Rlt_le_trans with alp. -Apply H7. -Unfold alp; Apply Rmin_r. -Apply Rle_lt_trans with ``(Rabsolu ((sin h)/h-1))``. -Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin h)/h-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony. -Apply Rabsolu_pos. -Assert H8 := (COS_bound x); Elim H8; Intros. -Unfold Rabsolu; Case (case_Rabsolu (cos x)); Intro. -Rewrite <- (Ropp_Ropp R1); Apply Rle_Ropp1; Assumption. -Assumption. -Cut ``(Rabsolu h)<alp1``. -Intro; Assert H9 := (H3 ? H6 H8). -Rewrite sin_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9. -Apply Rlt_le_trans with alp. -Apply H7. -Unfold alp; Apply Rmin_l. -Rewrite sin_plus; Unfold Rminus Rdiv; Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rmult_assoc; Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Rewrite (Rplus_sym ``(sin x)*( -1*/h)``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r. -Rewrite Ropp_mul3; Rewrite Ropp_mul1; Rewrite Rmult_1r; Rewrite Rmult_1l; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Apply Rplus_sym. -Unfold alp; Unfold Rmin; Case (total_order_Rle alp1 alp2); Intro. -Apply (cond_pos alp1). -Apply (cond_pos alp2). +Theorem derivable_pt_lim_sin : forall x:R, derivable_pt_lim sin x (cos x). +intro; assert (H0 := derivable_pt_lim_sin_0). +assert (H := derivable_pt_lim_cos_0). +unfold derivable_pt_lim in H0, H. +unfold derivable_pt_lim in |- *; intros. +cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H0 _ H2); intros alp1 H3. +elim (H _ H2); intros alp2 H4. +pose (alp := Rmin alp1 alp2). +cut (0 < alp). +intro; exists (mkposreal _ H5); intros. +replace ((sin (x + h) - sin x) / h - cos x) with + (sin x * ((cos h - 1) / h) + cos x * (sin h / h - 1)). +apply Rle_lt_trans with + (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply Rle_lt_trans with (Rabs ((cos h - 1) / h)). +rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r; + apply Rmult_le_compat_l. +apply Rabs_pos. +assert (H8 := SIN_bound x); elim H8; intros. +unfold Rabs in |- *; case (Rcase_abs (sin x)); intro. +rewrite <- (Ropp_involutive 1). +apply Ropp_le_contravar; assumption. +assumption. +cut (Rabs h < alp2). +intro; assert (H9 := H4 _ H6 H8). +rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; + apply H9. +apply Rlt_le_trans with alp. +apply H7. +unfold alp in |- *; apply Rmin_r. +apply Rle_lt_trans with (Rabs (sin h / h - 1)). +rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r; + apply Rmult_le_compat_l. +apply Rabs_pos. +assert (H8 := COS_bound x); elim H8; intros. +unfold Rabs in |- *; case (Rcase_abs (cos x)); intro. +rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption. +assumption. +cut (Rabs h < alp1). +intro; assert (H9 := H3 _ H6 H8). +rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; + apply H9. +apply Rlt_le_trans with alp. +apply H7. +unfold alp in |- *; apply Rmin_l. +rewrite sin_plus; unfold Rminus, Rdiv in |- *; + repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. +rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. +rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse; + rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse; + rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm. +unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro. +apply (cond_pos alp1). +apply (cond_pos alp2). Qed. -Lemma derivable_pt_lim_cos : (x:R) (derivable_pt_lim cos x ``-(sin x)``). -Intro; Cut (h:R)``(sin (h+PI/2))``==(cos h). -Intro; Replace ``-(sin x)`` with (Rmult (cos ``x+PI/2``) (Rplus R1 R0)). -Generalize (derivable_pt_lim_comp (plus_fct id (fct_cte ``PI/2``)) sin); Intros. -Cut (derivable_pt_lim (plus_fct id (fct_cte ``PI/2``)) x ``1+0``). -Cut (derivable_pt_lim sin (plus_fct id (fct_cte ``PI/2``) x) ``(cos (x+PI/2))``). -Intros; Generalize (H0 ? ? ? H2 H1); Replace (comp sin (plus_fct id (fct_cte ``PI/2``))) with [x:R]``(sin (x+PI/2))``; [Idtac | Reflexivity]. -Unfold derivable_pt_lim; Intros. -Elim (H3 eps H4); Intros. -Exists x0. -Intros; Rewrite <- (H ``x+h``); Rewrite <- (H x); Apply H5; Assumption. -Apply derivable_pt_lim_sin. -Apply derivable_pt_lim_plus. -Apply derivable_pt_lim_id. -Apply derivable_pt_lim_const. -Rewrite sin_cos; Rewrite <- (Rplus_sym x); Ring. -Intro; Rewrite cos_sin; Rewrite Rplus_sym; Reflexivity. +Lemma derivable_pt_lim_cos : forall x:R, derivable_pt_lim cos x (- sin x). +intro; cut (forall h:R, sin (h + PI / 2) = cos h). +intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)). +generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros. +cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)). +cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))). +intros; generalize (H0 _ _ _ H2 H1); + replace (comp sin (id + fct_cte (PI / 2))%F) with + (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ]. +unfold derivable_pt_lim in |- *; intros. +elim (H3 eps H4); intros. +exists x0. +intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption. +apply derivable_pt_lim_sin. +apply derivable_pt_lim_plus. +apply derivable_pt_lim_id. +apply derivable_pt_lim_const. +rewrite sin_cos; rewrite <- (Rplus_comm x); ring. +intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity. Qed. -Lemma derivable_pt_sin : (x:R) (derivable_pt sin x). -Unfold derivable_pt; Intro. -Apply Specif.existT with (cos x). -Apply derivable_pt_lim_sin. +Lemma derivable_pt_sin : forall x:R, derivable_pt sin x. +unfold derivable_pt in |- *; intro. +apply existT with (cos x). +apply derivable_pt_lim_sin. Qed. -Lemma derivable_pt_cos : (x:R) (derivable_pt cos x). -Unfold derivable_pt; Intro. -Apply Specif.existT with ``-(sin x)``. -Apply derivable_pt_lim_cos. +Lemma derivable_pt_cos : forall x:R, derivable_pt cos x. +unfold derivable_pt in |- *; intro. +apply existT with (- sin x). +apply derivable_pt_lim_cos. Qed. -Lemma derivable_sin : (derivable sin). -Unfold derivable; Intro; Apply derivable_pt_sin. +Lemma derivable_sin : derivable sin. +unfold derivable in |- *; intro; apply derivable_pt_sin. Qed. -Lemma derivable_cos : (derivable cos). -Unfold derivable; Intro; Apply derivable_pt_cos. +Lemma derivable_cos : derivable cos. +unfold derivable in |- *; intro; apply derivable_pt_cos. Qed. -Lemma derive_pt_sin : (x:R) ``(derive_pt sin x (derivable_pt_sin ?))==(cos x)``. -Intros; Apply derive_pt_eq_0. -Apply derivable_pt_lim_sin. +Lemma derive_pt_sin : + forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x. +intros; apply derive_pt_eq_0. +apply derivable_pt_lim_sin. Qed. -Lemma derive_pt_cos : (x:R) ``(derive_pt cos x (derivable_pt_cos ?))==-(sin x)``. -Intros; Apply derive_pt_eq_0. -Apply derivable_pt_lim_cos. -Qed. +Lemma derive_pt_cos : + forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x. +intros; apply derive_pt_eq_0. +apply derivable_pt_lim_cos. +Qed.
\ No newline at end of file diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v index 7bd6b8a47..1175543b6 100644 --- a/theories/Reals/SeqProp.v +++ b/theories/Reals/SeqProp.v @@ -8,1082 +8,1288 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Rseries. -Require Classical. -Require Max. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. +Require Import Rbase. +Require Import Rfunctions. +Require Import Rseries. +Require Import Classical. +Require Import Max. Open Local Scope R_scope. -Definition Un_decreasing [Un:nat->R] : Prop := (n:nat) (Rle (Un (S n)) (Un n)). -Definition opp_seq [Un:nat->R] : nat->R := [n:nat]``-(Un n)``. -Definition has_ub [Un:nat->R] : Prop := (bound (EUn Un)). -Definition has_lb [Un:nat->R] : Prop := (bound (EUn (opp_seq Un))). +Definition Un_decreasing (Un:nat -> R) : Prop := + forall n:nat, Un (S n) <= Un n. +Definition opp_seq (Un:nat -> R) (n:nat) : R := - Un n. +Definition has_ub (Un:nat -> R) : Prop := bound (EUn Un). +Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)). (**********) -Lemma growing_cv : (Un:nat->R) (Un_growing Un) -> (has_ub Un) -> (sigTT R [l:R](Un_cv Un l)). -Unfold Un_growing Un_cv;Intros; - NewDestruct (complet (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]]. - Exists x;Intros eps H1. - Unfold is_upper_bound in H2 H3. -Assert H5:(n:nat)(Rle (Un n) x). - Intro n; Apply (H2 (Un n) (Un_in_EUn Un n)). -Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))). -Intro H6;NewDestruct H6 as [N H6];Exists N. -Intros n H7;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps). -Unfold Rgt in H1. - Apply (Rle_lt_trans (Rminus (Un n) x) R0 eps - (Rle_minus (Un n) x (H5 n)) H1). -Fold Un_growing in H;Generalize (growing_prop Un n N H H7);Intro H8. - Generalize (Rlt_le_trans (Rminus x eps) (Un N) (Un n) H6 - (Rle_sym2 (Un N) (Un n) H8));Intro H9; - Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9); - Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps)); - Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x); - Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2); - Trivial. -Cut ~((N:nat)(Rle (Un N) (Rminus x eps))). -Intro H6;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N)))). - Intro H7; Apply H6; Intro N; Apply Rnot_lt_le; Apply H7. -Intro H7;Generalize (Un_bound_imp Un (Rminus x eps) H7);Intro H8; - Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8); - Apply Rlt_le_not; Apply tech_Rgt_minus; Exact H1. +Lemma growing_cv : + forall Un:nat -> R, + Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l). +unfold Un_growing, Un_cv in |- *; intros; + destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]]. + exists x; intros eps H1. + unfold is_upper_bound in H2, H3. +assert (H5 : forall n:nat, Un n <= x). + intro n; apply (H2 (Un n) (Un_in_EUn Un n)). +cut ( exists N : nat | x - eps < Un N). +intro H6; destruct H6 as [N H6]; exists N. +intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). +unfold Rgt in H1. + apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1). +fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8. + generalize + (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8)); + intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); + rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; + rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); + trivial. +cut (~ (forall N:nat, Un N <= x - eps)). +intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)). + intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7. +intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8; + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + apply Rlt_not_le; apply tech_Rgt_minus; exact H1. Qed. -Lemma decreasing_growing : (Un:nat->R) (Un_decreasing Un) -> (Un_growing (opp_seq Un)). -Intro. -Unfold Un_growing opp_seq Un_decreasing. -Intros. -Apply Rle_Ropp1. -Apply H. +Lemma decreasing_growing : + forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un). +intro. +unfold Un_growing, opp_seq, Un_decreasing in |- *. +intros. +apply Ropp_le_contravar. +apply H. Qed. -Lemma decreasing_cv : (Un:nat->R) (Un_decreasing Un) -> (has_lb Un) -> (sigTT R [l:R](Un_cv Un l)). -Intros. -Cut (sigTT R [l:R](Un_cv (opp_seq Un) l)) -> (sigTT R [l:R](Un_cv Un l)). -Intro. -Apply X. -Apply growing_cv. -Apply decreasing_growing; Assumption. -Exact H0. -Intro. -Elim X; Intros. -Apply existTT with ``-x``. -Unfold Un_cv in p. -Unfold R_dist in p. -Unfold opp_seq in p. -Unfold Un_cv. -Unfold R_dist. -Intros. -Elim (p eps H1); Intros. -Exists x0; Intros. -Assert H4 := (H2 n H3). -Rewrite <- Rabsolu_Ropp. -Replace ``-((Un n)- -x)`` with ``-(Un n)-x``; [Assumption | Ring]. +Lemma decreasing_cv : + forall Un:nat -> R, + Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l). +intros. +cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)). +intro. +apply X. +apply growing_cv. +apply decreasing_growing; assumption. +exact H0. +intro. +elim X; intros. +apply existT with (- x). +unfold Un_cv in p. +unfold R_dist in p. +unfold opp_seq in p. +unfold Un_cv in |- *. +unfold R_dist in |- *. +intros. +elim (p eps H1); intros. +exists x0; intros. +assert (H4 := H2 n H3). +rewrite <- Rabs_Ropp. +replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ]. Qed. (***********) -Lemma maj_sup : (Un:nat->R) (has_ub Un) -> (sigTT R [l:R](is_lub (EUn Un) l)). -Intros. -Unfold has_ub in H. -Apply complet. -Assumption. -Exists (Un O). -Unfold EUn. -Exists O; Reflexivity. +Lemma maj_sup : + forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l). +intros. +unfold has_ub in H. +apply completeness. +assumption. +exists (Un 0%nat). +unfold EUn in |- *. +exists 0%nat; reflexivity. Qed. (**********) -Lemma min_inf : (Un:nat->R) (has_lb Un) -> (sigTT R [l:R](is_lub (EUn (opp_seq Un)) l)). -Intros; Unfold has_lb in H. -Apply complet. -Assumption. -Exists ``-(Un O)``. -Exists O. -Reflexivity. +Lemma min_inf : + forall Un:nat -> R, + has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l). +intros; unfold has_lb in H. +apply completeness. +assumption. +exists (- Un 0%nat). +exists 0%nat. +reflexivity. Qed. -Definition majorant [Un:nat->R;pr:(has_ub Un)] : R := Cases (maj_sup Un pr) of (existTT a b) => a end. +Definition majorant (Un:nat -> R) (pr:has_ub Un) : R := + match maj_sup Un pr with + | existT a b => a + end. -Definition minorant [Un:nat->R;pr:(has_lb Un)] : R := Cases (min_inf Un pr) of (existTT a b) => ``-a`` end. +Definition minorant (Un:nat -> R) (pr:has_lb Un) : R := + match min_inf Un pr with + | existT a b => - a + end. -Lemma maj_ss : (Un:nat->R;k:nat) (has_ub Un) -> (has_ub [i:nat](Un (plus k i))). -Intros. -Unfold has_ub in H. -Unfold bound in H. -Elim H; Intros. -Unfold is_upper_bound in H0. -Unfold has_ub. -Exists x. -Unfold is_upper_bound. -Intros. -Apply H0. -Elim H1; Intros. -Exists (plus k x1); Assumption. +Lemma maj_ss : + forall (Un:nat -> R) (k:nat), + has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat). +intros. +unfold has_ub in H. +unfold bound in H. +elim H; intros. +unfold is_upper_bound in H0. +unfold has_ub in |- *. +exists x. +unfold is_upper_bound in |- *. +intros. +apply H0. +elim H1; intros. +exists (k + x1)%nat; assumption. Qed. -Lemma min_ss : (Un:nat->R;k:nat) (has_lb Un) -> (has_lb [i:nat](Un (plus k i))). -Intros. -Unfold has_lb in H. -Unfold bound in H. -Elim H; Intros. -Unfold is_upper_bound in H0. -Unfold has_lb. -Exists x. -Unfold is_upper_bound. -Intros. -Apply H0. -Elim H1; Intros. -Exists (plus k x1); Assumption. +Lemma min_ss : + forall (Un:nat -> R) (k:nat), + has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat). +intros. +unfold has_lb in H. +unfold bound in H. +elim H; intros. +unfold is_upper_bound in H0. +unfold has_lb in |- *. +exists x. +unfold is_upper_bound in |- *. +intros. +apply H0. +elim H1; intros. +exists (k + x1)%nat; assumption. Qed. -Definition sequence_majorant [Un:nat->R;pr:(has_ub Un)] : nat -> R := [i:nat](majorant [k:nat](Un (plus i k)) (maj_ss Un i pr)). +Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un) + (i:nat) : R := majorant (fun k:nat => Un (i + k)%nat) (maj_ss Un i pr). -Definition sequence_minorant [Un:nat->R;pr:(has_lb Un)] : nat -> R := [i:nat](minorant [k:nat](Un (plus i k)) (min_ss Un i pr)). +Definition sequence_minorant (Un:nat -> R) (pr:has_lb Un) + (i:nat) : R := minorant (fun k:nat => Un (i + k)%nat) (min_ss Un i pr). -Lemma Wn_decreasing : (Un:nat->R;pr:(has_ub Un)) (Un_decreasing (sequence_majorant Un pr)). -Intros. -Unfold Un_decreasing. -Intro. -Unfold sequence_majorant. -Assert H := (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)). -Assert H0 := (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)). -Elim H; Intros. -Elim H0; Intros. -Cut (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) == x; [Intro Maj1; Rewrite Maj1 | Idtac]. -Cut (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) == x0; [Intro Maj2; Rewrite Maj2 | Idtac]. -Unfold is_lub in p. -Unfold is_lub in p0. -Elim p; Intros. -Apply H2. -Elim p0; Intros. -Unfold is_upper_bound. -Intros. -Unfold is_upper_bound in H3. -Apply H3. -Elim H5; Intros. -Exists (plus (1) x2). -Replace (plus n (plus (S O) x2)) with (plus (S n) x2). -Assumption. -Replace (S n) with (plus (1) n); [Ring | Ring]. -Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr))). -Intro. -Unfold is_lub in p0; Unfold is_lub in H1. -Elim p0; Intros; Elim H1; Intros. -Assert H6 := (H5 x0 H2). -Assert H7 := (H3 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) H4). -Apply Rle_antisym; Assumption. -Unfold majorant. -Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)). -Trivial. -Cut (is_lub (EUn [k:nat](Un (plus (S n) k))) (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr))). -Intro. -Unfold is_lub in p; Unfold is_lub in H1. -Elim p; Intros; Elim H1; Intros. -Assert H6 := (H5 x H2). -Assert H7 := (H3 (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) H4). -Apply Rle_antisym; Assumption. -Unfold majorant. -Case (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)). -Trivial. +Lemma Wn_decreasing : + forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr). +intros. +unfold Un_decreasing in |- *. +intro. +unfold sequence_majorant in |- *. +assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). +assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). +elim H; intros. +elim H0; intros. +cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x); + [ intro Maj1; rewrite Maj1 | idtac ]. +cut (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0); + [ intro Maj2; rewrite Maj2 | idtac ]. +unfold is_lub in p. +unfold is_lub in p0. +elim p; intros. +apply H2. +elim p0; intros. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H3. +apply H3. +elim H5; intros. +exists (1 + x2)%nat. +replace (n + (1 + x2))%nat with (S n + x2)%nat. +assumption. +replace (S n) with (1 + n)%nat; [ ring | ring ]. +cut + (is_lub (EUn (fun k:nat => Un (n + k)%nat)) + (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))). +intro. +unfold is_lub in p0; unfold is_lub in H1. +elim p0; intros; elim H1; intros. +assert (H6 := H5 x0 H2). +assert + (H7 := H3 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4). +apply Rle_antisym; assumption. +unfold majorant in |- *. +case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). +trivial. +cut + (is_lub (EUn (fun k:nat => Un (S n + k)%nat)) + (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))). +intro. +unfold is_lub in p; unfold is_lub in H1. +elim p; intros; elim H1; intros. +assert (H6 := H5 x H2). +assert + (H7 := + H3 (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4). +apply Rle_antisym; assumption. +unfold majorant in |- *. +case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). +trivial. Qed. -Lemma Vn_growing : (Un:nat->R;pr:(has_lb Un)) (Un_growing (sequence_minorant Un pr)). -Intros. -Unfold Un_growing. -Intro. -Unfold sequence_minorant. -Assert H := (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)). -Assert H0 := (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)). -Elim H; Intros. -Elim H0; Intros. -Cut (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)) == ``-x``; [Intro Maj1; Rewrite Maj1 | Idtac]. -Cut (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)) == ``-x0``; [Intro Maj2; Rewrite Maj2 | Idtac]. -Unfold is_lub in p. -Unfold is_lub in p0. -Elim p; Intros. -Apply Rle_Ropp1. -Apply H2. -Elim p0; Intros. -Unfold is_upper_bound. -Intros. -Unfold is_upper_bound in H3. -Apply H3. -Elim H5; Intros. -Exists (plus (1) x2). -Unfold opp_seq in H6. -Unfold opp_seq. -Replace (plus n (plus (S O) x2)) with (plus (S n) x2). -Assumption. -Replace (S n) with (plus (1) n); [Ring | Ring]. -Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)))). -Intro. -Unfold is_lub in p0; Unfold is_lub in H1. -Elim p0; Intros; Elim H1; Intros. -Assert H6 := (H5 x0 H2). -Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))) H4). -Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))). -Apply eq_Ropp; Apply Rle_antisym; Assumption. -Unfold minorant. -Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)). -Intro; Rewrite Ropp_Ropp. -Trivial. -Cut (is_lub (EUn (opp_seq [k:nat](Un (plus (S n) k)))) (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)))). -Intro. -Unfold is_lub in p; Unfold is_lub in H1. -Elim p; Intros; Elim H1; Intros. -Assert H6 := (H5 x H2). -Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))) H4). -Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))). -Apply eq_Ropp; Apply Rle_antisym; Assumption. -Unfold minorant. -Case (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)). -Intro; Rewrite Ropp_Ropp. -Trivial. +Lemma Vn_growing : + forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr). +intros. +unfold Un_growing in |- *. +intro. +unfold sequence_minorant in |- *. +assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). +assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). +elim H; intros. +elim H0; intros. +cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x); + [ intro Maj1; rewrite Maj1 | idtac ]. +cut (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0); + [ intro Maj2; rewrite Maj2 | idtac ]. +unfold is_lub in p. +unfold is_lub in p0. +elim p; intros. +apply Ropp_le_contravar. +apply H2. +elim p0; intros. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H3. +apply H3. +elim H5; intros. +exists (1 + x2)%nat. +unfold opp_seq in H6. +unfold opp_seq in |- *. +replace (n + (1 + x2))%nat with (S n + x2)%nat. +assumption. +replace (S n) with (1 + n)%nat; [ ring | ring ]. +cut + (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) + (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))). +intro. +unfold is_lub in p0; unfold is_lub in H1. +elim p0; intros; elim H1; intros. +assert (H6 := H5 x0 H2). +assert + (H7 := H3 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4). +rewrite <- + (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))) + . +apply Ropp_eq_compat; apply Rle_antisym; assumption. +unfold minorant in |- *. +case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). +intro; rewrite Ropp_involutive. +trivial. +cut + (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat))) + (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))). +intro. +unfold is_lub in p; unfold is_lub in H1. +elim p; intros; elim H1; intros. +assert (H6 := H5 x H2). +assert + (H7 := + H3 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4). +rewrite <- + (Ropp_involutive + (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))) + . +apply Ropp_eq_compat; apply Rle_antisym; assumption. +unfold minorant in |- *. +case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). +intro; rewrite Ropp_involutive. +trivial. Qed. (**********) -Lemma Vn_Un_Wn_order : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (n:nat) ``((sequence_minorant Un pr2) n)<=(Un n)<=((sequence_majorant Un pr1) n)``. -Intros. -Split. -Unfold sequence_minorant. -Cut (sigTT R [l:R](is_lub (EUn (opp_seq [i:nat](Un (plus n i)))) l)). -Intro. -Elim X; Intros. -Replace (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)) with ``-x``. -Unfold is_lub in p. -Elim p; Intros. -Unfold is_upper_bound in H. -Rewrite <- (Ropp_Ropp (Un n)). -Apply Rle_Ropp1. -Apply H. -Exists O. -Unfold opp_seq. -Replace (plus n O) with n; [Reflexivity | Ring]. -Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)))). -Intro. -Unfold is_lub in p; Unfold is_lub in H. -Elim p; Intros; Elim H; Intros. -Assert H4 := (H3 x H0). -Assert H5 := (H1 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))) H2). -Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))). -Apply eq_Ropp; Apply Rle_antisym; Assumption. -Unfold minorant. -Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr2)). -Intro; Rewrite Ropp_Ropp. -Trivial. -Apply min_inf. -Apply min_ss; Assumption. -Unfold sequence_majorant. -Cut (sigTT R [l:R](is_lub (EUn [i:nat](Un (plus n i))) l)). -Intro. -Elim X; Intros. -Replace (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) with ``x``. -Unfold is_lub in p. -Elim p; Intros. -Unfold is_upper_bound in H. -Apply H. -Exists O. -Replace (plus n O) with n; [Reflexivity | Ring]. -Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1))). -Intro. -Unfold is_lub in p; Unfold is_lub in H. -Elim p; Intros; Elim H; Intros. -Assert H4 := (H3 x H0). -Assert H5 := (H1 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) H2). -Apply Rle_antisym; Assumption. -Unfold majorant. -Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr1)). -Intro; Trivial. -Apply maj_sup. -Apply maj_ss; Assumption. +Lemma Vn_Un_Wn_order : + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un) + (n:nat), sequence_minorant Un pr2 n <= Un n <= sequence_majorant Un pr1 n. +intros. +split. +unfold sequence_minorant in |- *. +cut + (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)). +intro. +elim X; intros. +replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x). +unfold is_lub in p. +elim p; intros. +unfold is_upper_bound in H. +rewrite <- (Ropp_involutive (Un n)). +apply Ropp_le_contravar. +apply H. +exists 0%nat. +unfold opp_seq in |- *. +replace (n + 0)%nat with n; [ reflexivity | ring ]. +cut + (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) + (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))). +intro. +unfold is_lub in p; unfold is_lub in H. +elim p; intros; elim H; intros. +assert (H4 := H3 x H0). +assert + (H5 := H1 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2). +rewrite <- + (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))) + . +apply Ropp_eq_compat; apply Rle_antisym; assumption. +unfold minorant in |- *. +case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)). +intro; rewrite Ropp_involutive. +trivial. +apply min_inf. +apply min_ss; assumption. +unfold sequence_majorant in |- *. +cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)). +intro. +elim X; intros. +replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x. +unfold is_lub in p. +elim p; intros. +unfold is_upper_bound in H. +apply H. +exists 0%nat. +replace (n + 0)%nat with n; [ reflexivity | ring ]. +cut + (is_lub (EUn (fun k:nat => Un (n + k)%nat)) + (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))). +intro. +unfold is_lub in p; unfold is_lub in H. +elim p; intros; elim H; intros. +assert (H4 := H3 x H0). +assert + (H5 := H1 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2). +apply Rle_antisym; assumption. +unfold majorant in |- *. +case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)). +intro; trivial. +apply maj_sup. +apply maj_ss; assumption. Qed. -Lemma min_maj : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_ub (sequence_minorant Un pr2)). -Intros. -Assert H := (Vn_Un_Wn_order Un pr1 pr2). -Unfold has_ub. -Unfold bound. -Unfold has_ub in pr1. -Unfold bound in pr1. -Elim pr1; Intros. -Exists x. -Unfold is_upper_bound. -Intros. -Unfold is_upper_bound in H0. -Elim H1; Intros. -Rewrite H2. -Apply Rle_trans with (Un x1). -Assert H3 := (H x1); Elim H3; Intros; Assumption. -Apply H0. -Exists x1; Reflexivity. +Lemma min_maj : + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), + has_ub (sequence_minorant Un pr2). +intros. +assert (H := Vn_Un_Wn_order Un pr1 pr2). +unfold has_ub in |- *. +unfold bound in |- *. +unfold has_ub in pr1. +unfold bound in pr1. +elim pr1; intros. +exists x. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H0. +elim H1; intros. +rewrite H2. +apply Rle_trans with (Un x1). +assert (H3 := H x1); elim H3; intros; assumption. +apply H0. +exists x1; reflexivity. Qed. -Lemma maj_min : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_lb (sequence_majorant Un pr1)). -Intros. -Assert H := (Vn_Un_Wn_order Un pr1 pr2). -Unfold has_lb. -Unfold bound. -Unfold has_lb in pr2. -Unfold bound in pr2. -Elim pr2; Intros. -Exists x. -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; Apply Rle_Ropp1. -Assumption. -Apply H0. -Exists x1; Reflexivity. +Lemma maj_min : + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), + has_lb (sequence_majorant Un pr1). +intros. +assert (H := Vn_Un_Wn_order Un pr1 pr2). +unfold has_lb in |- *. +unfold bound in |- *. +unfold has_lb in pr2. +unfold bound in pr2. +elim pr2; intros. +exists x. +unfold is_upper_bound in |- *. +intros. +unfold is_upper_bound in H0. +elim H1; intros. +rewrite H2. +apply Rle_trans with (opp_seq Un x1). +assert (H3 := H x1); elim H3; intros. +unfold opp_seq in |- *; apply Ropp_le_contravar. +assumption. +apply H0. +exists x1; reflexivity. Qed. (**********) -Lemma cauchy_maj : (Un:nat->R) (Cauchy_crit Un) -> (has_ub Un). -Intros. -Unfold has_ub. -Apply cauchy_bound. -Assumption. +Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un. +intros. +unfold has_ub in |- *. +apply cauchy_bound. +assumption. Qed. (**********) -Lemma cauchy_opp : (Un:nat->R) (Cauchy_crit Un) -> (Cauchy_crit (opp_seq Un)). -Intro. -Unfold Cauchy_crit. -Unfold R_dist. -Intros. -Elim (H eps H0); Intros. -Exists x; Intros. -Unfold opp_seq. -Rewrite <- Rabsolu_Ropp. -Replace ``-( -(Un n)- -(Un m))`` with ``(Un n)-(Un m)``; [Apply H1; Assumption | Ring]. +Lemma cauchy_opp : + forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un). +intro. +unfold Cauchy_crit in |- *. +unfold R_dist in |- *. +intros. +elim (H eps H0); intros. +exists x; intros. +unfold opp_seq in |- *. +rewrite <- Rabs_Ropp. +replace (- (- Un n - - Un m)) with (Un n - Un m); + [ apply H1; assumption | ring ]. Qed. (**********) -Lemma cauchy_min : (Un:nat->R) (Cauchy_crit Un) -> (has_lb Un). -Intros. -Unfold has_lb. -Assert H0 := (cauchy_opp ? H). -Apply cauchy_bound. -Assumption. +Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un. +intros. +unfold has_lb in |- *. +assert (H0 := cauchy_opp _ H). +apply cauchy_bound. +assumption. Qed. (**********) -Lemma maj_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l)). -Intros. -Apply decreasing_cv. -Apply Wn_decreasing. -Apply maj_min. -Apply cauchy_min. -Assumption. +Lemma maj_cv : + forall (Un:nat -> R) (pr:Cauchy_crit Un), + sigT (fun l:R => Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l). +intros. +apply decreasing_cv. +apply Wn_decreasing. +apply maj_min. +apply cauchy_min. +assumption. Qed. (**********) -Lemma min_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_minorant Un (cauchy_min Un pr)) l)). -Intros. -Apply growing_cv. -Apply Vn_growing. -Apply min_maj. -Apply cauchy_maj. -Assumption. +Lemma min_cv : + forall (Un:nat -> R) (pr:Cauchy_crit Un), + sigT (fun l:R => Un_cv (sequence_minorant Un (cauchy_min Un pr)) l). +intros. +apply growing_cv. +apply Vn_growing. +apply min_maj. +apply cauchy_maj. +assumption. Qed. -Lemma cond_eq : (x,y:R) ((eps:R)``0<eps``->``(Rabsolu (x-y))<eps``) -> x==y. -Intros. -Case (total_order_T x y); Intro. -Elim s; Intro. -Cut ``0<y-x``. -Intro. -Assert H1 := (H ``y-x`` H0). -Rewrite <- Rabsolu_Ropp in H1. -Cut ``-(x-y)==y-x``; [Intro; Rewrite H2 in H1 | Ring]. -Rewrite Rabsolu_right in H1. -Elim (Rlt_antirefl ? H1). -Left; Assumption. -Apply Rlt_anti_compatibility with x. -Rewrite Rplus_Or; Replace ``x+(y-x)`` with y; [Assumption | Ring]. -Assumption. -Cut ``0<x-y``. -Intro. -Assert H1 := (H ``x-y`` H0). -Rewrite Rabsolu_right in H1. -Elim (Rlt_antirefl ? H1). -Left; Assumption. -Apply Rlt_anti_compatibility with y. -Rewrite Rplus_Or; Replace ``y+(x-y)`` with x; [Assumption | Ring]. +Lemma cond_eq : + forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y. +intros. +case (total_order_T x y); intro. +elim s; intro. +cut (0 < y - x). +intro. +assert (H1 := H (y - x) H0). +rewrite <- Rabs_Ropp in H1. +cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ]. +rewrite Rabs_right in H1. +elim (Rlt_irrefl _ H1). +left; assumption. +apply Rplus_lt_reg_r with x. +rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ]. +assumption. +cut (0 < x - y). +intro. +assert (H1 := H (x - y) H0). +rewrite Rabs_right in H1. +elim (Rlt_irrefl _ H1). +left; assumption. +apply Rplus_lt_reg_r with y. +rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ]. Qed. -Lemma not_Rlt : (r1,r2:R)~(``r1<r2``)->``r1>=r2``. -Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rge. -Tauto. +Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2. +intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *. +tauto. Qed. (**********) -Lemma approx_maj : (Un:nat->R;pr:(has_ub Un)) (eps:R) ``0<eps`` -> (EX k : nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``). -Intros. -Pose P := [k:nat]``(Rabsolu ((majorant Un pr)-(Un k))) < eps``. -Unfold P. -Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``). -Intros. -Apply H0. -Apply not_all_not_ex. -Red; Intro. -2:Unfold P; Trivial. -Unfold P in H1. -Cut (n:nat)``(Rabsolu ((majorant Un pr)-(Un n))) >= eps``. -Intro. -Cut (is_lub (EUn Un) (majorant Un pr)). -Intro. -Unfold is_lub in H3. -Unfold is_upper_bound in H3. -Elim H3; Intros. -Cut (n:nat)``eps<=(majorant Un pr)-(Un n)``. -Intro. -Cut (n:nat)``(Un n)<=(majorant Un pr)-eps``. -Intro. -Cut ((x:R)(EUn Un x)->``x <= (majorant Un pr)-eps``). -Intro. -Assert H9 := (H5 ``(majorant Un pr)-eps`` H8). -Cut ``eps<=0``. -Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)). -Apply Rle_anti_compatibility with ``(majorant Un pr)-eps``. -Rewrite Rplus_Or. -Replace ``(majorant Un pr)-eps+eps`` with (majorant Un pr); [Assumption | Ring]. -Intros. -Unfold EUn in H8. -Elim H8; Intros. -Rewrite H9; Apply H7. -Intro. -Assert H7 := (H6 n). -Apply Rle_anti_compatibility with ``eps-(Un n)``. -Replace ``eps-(Un n)+(Un n)`` with ``eps``. -Replace ``eps-(Un n)+((majorant Un pr)-eps)`` with ``(majorant Un pr)-(Un n)``. -Assumption. -Ring. -Ring. -Intro. -Assert H6 := (H2 n). -Rewrite Rabsolu_right in H6. -Apply Rle_sym2. -Assumption. -Apply Rle_sym1. -Apply Rle_anti_compatibility with (Un n). -Rewrite Rplus_Or; Replace ``(Un n)+((majorant Un pr)-(Un n))`` with (majorant Un pr); [Apply H4 | Ring]. -Exists n; Reflexivity. -Unfold majorant. -Case (maj_sup Un pr). -Trivial. -Intro. -Assert H2 := (H1 n). -Apply not_Rlt; Assumption. +Lemma approx_maj : + forall (Un:nat -> R) (pr:has_ub Un) (eps:R), + 0 < eps -> exists k : nat | Rabs (majorant Un pr - Un k) < eps. +intros. +pose (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps). +unfold P in |- *. +cut + (( exists k : nat | P k) -> + exists k : nat | Rabs (majorant Un pr - Un k) < eps). +intros. +apply H0. +apply not_all_not_ex. +red in |- *; intro. +2: unfold P in |- *; trivial. +unfold P in H1. +cut (forall n:nat, Rabs (majorant Un pr - Un n) >= eps). +intro. +cut (is_lub (EUn Un) (majorant Un pr)). +intro. +unfold is_lub in H3. +unfold is_upper_bound in H3. +elim H3; intros. +cut (forall n:nat, eps <= majorant Un pr - Un n). +intro. +cut (forall n:nat, Un n <= majorant Un pr - eps). +intro. +cut (forall x:R, EUn Un x -> x <= majorant Un pr - eps). +intro. +assert (H9 := H5 (majorant Un pr - eps) H8). +cut (eps <= 0). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). +apply Rplus_le_reg_l with (majorant Un pr - eps). +rewrite Rplus_0_r. +replace (majorant Un pr - eps + eps) with (majorant Un pr); + [ assumption | ring ]. +intros. +unfold EUn in H8. +elim H8; intros. +rewrite H9; apply H7. +intro. +assert (H7 := H6 n). +apply Rplus_le_reg_l with (eps - Un n). +replace (eps - Un n + Un n) with eps. +replace (eps - Un n + (majorant Un pr - eps)) with (majorant Un pr - Un n). +assumption. +ring. +ring. +intro. +assert (H6 := H2 n). +rewrite Rabs_right in H6. +apply Rge_le. +assumption. +apply Rle_ge. +apply Rplus_le_reg_l with (Un n). +rewrite Rplus_0_r; + replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr); + [ apply H4 | ring ]. +exists n; reflexivity. +unfold majorant in |- *. +case (maj_sup Un pr). +trivial. +intro. +assert (H2 := H1 n). +apply not_Rlt; assumption. Qed. (**********) -Lemma approx_min : (Un:nat->R;pr:(has_lb Un)) (eps:R) ``0<eps`` -> (EX k :nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``). -Intros. -Pose P := [k:nat]``(Rabsolu ((minorant Un pr)-(Un k))) < eps``. -Unfold P. -Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``). -Intros. -Apply H0. -Apply not_all_not_ex. -Red; Intro. -2:Unfold P; Trivial. -Unfold P in H1. -Cut (n:nat)``(Rabsolu ((minorant Un pr)-(Un n))) >= eps``. -Intro. -Cut (is_lub (EUn (opp_seq Un)) ``-(minorant Un pr)``). -Intro. -Unfold is_lub in H3. -Unfold is_upper_bound in H3. -Elim H3; Intros. -Cut (n:nat)``eps<=(Un n)-(minorant Un pr)``. -Intro. -Cut (n:nat)``((opp_seq Un) n)<=-(minorant Un pr)-eps``. -Intro. -Cut ((x:R)(EUn (opp_seq Un) x)->``x <= -(minorant Un pr)-eps``). -Intro. -Assert H9 := (H5 ``-(minorant Un pr)-eps`` H8). -Cut ``eps<=0``. -Intro. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)). -Apply Rle_anti_compatibility with ``-(minorant Un pr)-eps``. -Rewrite Rplus_Or. -Replace ``-(minorant Un pr)-eps+eps`` with ``-(minorant Un pr)``; [Assumption | Ring]. -Intros. -Unfold EUn in H8. -Elim H8; Intros. -Rewrite H9; Apply H7. -Intro. -Assert H7 := (H6 n). -Unfold opp_seq. -Apply Rle_anti_compatibility with ``eps+(Un n)``. -Replace ``eps+(Un n)+ -(Un n)`` with ``eps``. -Replace ``eps+(Un n)+(-(minorant Un pr)-eps)`` with ``(Un n)-(minorant Un pr)``. -Assumption. -Ring. -Ring. -Intro. -Assert H6 := (H2 n). -Rewrite Rabsolu_left1 in H6. -Apply Rle_sym2. -Replace ``(Un n)-(minorant Un pr)`` with `` -((minorant Un pr)-(Un n))``; [Assumption | Ring]. -Apply Rle_anti_compatibility with ``-(minorant Un pr)``. -Rewrite Rplus_Or; Replace ``-(minorant Un pr)+((minorant Un pr)-(Un n))`` with ``-(Un n)``. -Apply H4. -Exists n; Reflexivity. -Ring. -Unfold minorant. -Case (min_inf Un pr). -Intro. -Rewrite Ropp_Ropp. -Trivial. -Intro. -Assert H2 := (H1 n). -Apply not_Rlt; Assumption. +Lemma approx_min : + forall (Un:nat -> R) (pr:has_lb Un) (eps:R), + 0 < eps -> exists k : nat | Rabs (minorant Un pr - Un k) < eps. +intros. +pose (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps). +unfold P in |- *. +cut + (( exists k : nat | P k) -> + exists k : nat | Rabs (minorant Un pr - Un k) < eps). +intros. +apply H0. +apply not_all_not_ex. +red in |- *; intro. +2: unfold P in |- *; trivial. +unfold P in H1. +cut (forall n:nat, Rabs (minorant Un pr - Un n) >= eps). +intro. +cut (is_lub (EUn (opp_seq Un)) (- minorant Un pr)). +intro. +unfold is_lub in H3. +unfold is_upper_bound in H3. +elim H3; intros. +cut (forall n:nat, eps <= Un n - minorant Un pr). +intro. +cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps). +intro. +cut (forall x:R, EUn (opp_seq Un) x -> x <= - minorant Un pr - eps). +intro. +assert (H9 := H5 (- minorant Un pr - eps) H8). +cut (eps <= 0). +intro. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). +apply Rplus_le_reg_l with (- minorant Un pr - eps). +rewrite Rplus_0_r. +replace (- minorant Un pr - eps + eps) with (- minorant Un pr); + [ assumption | ring ]. +intros. +unfold EUn in H8. +elim H8; intros. +rewrite H9; apply H7. +intro. +assert (H7 := H6 n). +unfold opp_seq in |- *. +apply Rplus_le_reg_l with (eps + Un n). +replace (eps + Un n + - Un n) with eps. +replace (eps + Un n + (- minorant Un pr - eps)) with (Un n - minorant Un pr). +assumption. +ring. +ring. +intro. +assert (H6 := H2 n). +rewrite Rabs_left1 in H6. +apply Rge_le. +replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n)); + [ assumption | ring ]. +apply Rplus_le_reg_l with (- minorant Un pr). +rewrite Rplus_0_r; + replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n). +apply H4. +exists n; reflexivity. +ring. +unfold minorant in |- *. +case (min_inf Un pr). +intro. +rewrite Ropp_involutive. +trivial. +intro. +assert (H2 := H1 n). +apply not_Rlt; assumption. Qed. (* Unicity of limit for convergent sequences *) -Lemma UL_sequence : (Un:nat->R;l1,l2:R) (Un_cv Un l1) -> (Un_cv Un l2) -> l1==l2. -Intros Un l1 l2; Unfold Un_cv; Unfold R_dist; Intros. -Apply cond_eq. -Intros; Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H ``eps/2`` H2); Intros. -Elim (H0 ``eps/2`` H2); Intros. -Pose N := (max x x0). -Apply Rle_lt_trans with ``(Rabsolu (l1 -(Un N)))+(Rabsolu ((Un N)-l2))``. -Replace ``l1-l2`` with ``(l1-(Un N))+((Un N)-l2)``; [Apply Rabsolu_triang | Ring]. -Rewrite (double_var eps); Apply Rplus_lt. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H3; Unfold ge N; Apply le_max_l. -Apply H4; Unfold ge N; Apply le_max_r. +Lemma UL_sequence : + forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2. +intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros. +apply cond_eq. +intros; cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H (eps / 2) H2); intros. +elim (H0 (eps / 2) H2); intros. +pose (N := max x x0). +apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)). +replace (l1 - l2) with (l1 - Un N + (Un N - l2)); + [ apply Rabs_triang | ring ]. +rewrite (double_var eps); apply Rplus_lt_compat. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3; + unfold ge, N in |- *; apply le_max_l. +apply H4; unfold ge, N in |- *; apply le_max_r. Qed. (**********) -Lemma CV_plus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)+(Bn i)`` ``l1+l2``). -Unfold Un_cv; Unfold R_dist; Intros. -Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (H ``eps/2`` H2); Intros. -Elim (H0 ``eps/2`` H2); Intros. -Pose N := (max x x0). -Exists N; Intros. -Replace ``(An n)+(Bn n)-(l1+l2)`` with ``((An n)-l1)+((Bn n)-l2)``; [Idtac | Ring]. -Apply Rle_lt_trans with ``(Rabsolu ((An n)-l1))+(Rabsolu ((Bn n)-l2))``. -Apply Rabsolu_triang. -Rewrite (double_var eps); Apply Rplus_lt. -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]. +Lemma CV_plus : + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2). +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (H (eps / 2) H2); intros. +elim (H0 (eps / 2) H2); intros. +pose (N := max x x0). +exists N; intros. +replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2)); + [ idtac | ring ]. +apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)). +apply Rabs_triang. +rewrite (double_var eps); apply Rplus_lt_compat. +apply H3; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_l | assumption ]. +apply H4; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_r | assumption ]. Qed. (**********) -Lemma cv_cvabs : (Un:nat->R;l:R) (Un_cv Un l) -> (Un_cv [i:nat](Rabsolu (Un i)) (Rabsolu l)). -Unfold Un_cv; Unfold R_dist; Intros. -Elim (H eps H0); Intros. -Exists x; Intros. -Apply Rle_lt_trans with ``(Rabsolu ((Un n)-l))``. -Apply Rabsolu_triang_inv2. -Apply H1; Assumption. +Lemma cv_cvabs : + forall (Un:nat -> R) (l:R), + Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l). +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros. +exists x; intros. +apply Rle_lt_trans with (Rabs (Un n - l)). +apply Rabs_triang_inv2. +apply H1; assumption. Qed. (**********) -Lemma CV_Cauchy : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (Cauchy_crit Un). -Intros; Elim X; Intros. -Unfold Cauchy_crit; Intros. -Unfold Un_cv in p; Unfold R_dist in p. -Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. -Elim (p ``eps/2`` H0); Intros. -Exists x0; Intros. -Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((Un n)-x))+(Rabsolu (x-(Un m)))``. -Replace ``(Un n)-(Un m)`` with ``((Un n)-x)+(x-(Un m))``; [Apply Rabsolu_triang | Ring]. -Rewrite (double_var eps); Apply Rplus_lt. -Apply H1; Assumption. -Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1; Assumption. +Lemma CV_Cauchy : + forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un. +intros; elim X; intros. +unfold Cauchy_crit in |- *; intros. +unfold Un_cv in p; unfold R_dist in p. +cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. +elim (p (eps / 2) H0); intros. +exists x0; intros. +unfold R_dist in |- *; + apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)). +replace (Un n - Un m) with (Un n - x + (x - Un m)); + [ apply Rabs_triang | ring ]. +rewrite (double_var eps); apply Rplus_lt_compat. +apply H1; assumption. +rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption. Qed. (**********) -Lemma maj_by_pos : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (EXT l:R | ``0<l``/\((n:nat)``(Rabsolu (Un n))<=l``)). -Intros; Elim X; Intros. -Cut (sigTT R [l:R](Un_cv [k:nat](Rabsolu (Un k)) l)). -Intro. -Assert H := (CV_Cauchy [k:nat](Rabsolu (Un k)) X0). -Assert H0 := (cauchy_bound [k:nat](Rabsolu (Un k)) H). -Elim H0; Intros. -Exists ``x0+1``. -Cut ``0<=x0``. -Intro. -Split. -Apply ge0_plus_gt0_is_gt0; [Assumption | Apply Rlt_R0_R1]. -Intros. -Apply Rle_trans with x0. -Unfold is_upper_bound in H1. -Apply H1. -Exists n; Reflexivity. -Pattern 1 x0; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1. -Apply Rle_trans with (Rabsolu (Un O)). -Apply Rabsolu_pos. -Unfold is_upper_bound in H1. -Apply H1. -Exists O; Reflexivity. -Apply existTT with (Rabsolu x). -Apply cv_cvabs; Assumption. +Lemma maj_by_pos : + forall Un:nat -> R, + sigT (fun l:R => Un_cv Un l) -> + exists l : R | 0 < l /\ (forall n:nat, Rabs (Un n) <= l). +intros; elim X; intros. +cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)). +intro. +assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0). +assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H). +elim H0; intros. +exists (x0 + 1). +cut (0 <= x0). +intro. +split. +apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ]. +intros. +apply Rle_trans with x0. +unfold is_upper_bound in H1. +apply H1. +exists n; reflexivity. +pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. +apply Rle_trans with (Rabs (Un 0%nat)). +apply Rabs_pos. +unfold is_upper_bound in H1. +apply H1. +exists 0%nat; reflexivity. +apply existT with (Rabs x). +apply cv_cvabs; assumption. Qed. (**********) -Lemma CV_mult : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)*(Bn i)`` ``l1*l2``). -Intros. -Cut (sigTT R [l:R](Un_cv An l)). -Intro. -Assert H1 := (maj_by_pos An X). -Elim H1; Intros M H2. -Elim H2; Intros. -Unfold Un_cv; Unfold R_dist; Intros. -Cut ``0<eps/(2*M)``. -Intro. -Case (Req_EM l2 R0); Intro. -Unfold Un_cv in H0; Unfold R_dist in H0. -Elim (H0 ``eps/(2*M)`` H6); Intros. -Exists x; Intros. -Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``. -Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring]. -Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``. -Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with R0. -Rewrite Rplus_Or. -Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``). -Apply Rle_monotony. -Apply Rabsolu_pos. -Apply H4. -Apply Rlt_monotony_contra with ``/M``. -Apply Rlt_Rinv; Apply H3. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``). -Apply Rlt_trans with ``eps/(2*M)``. -Apply H8; Assumption. -Unfold Rdiv; Rewrite Rinv_Rmult. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Replace ``2*(eps*(/2*/M))`` with ``(2*/2)*(eps*/M)``; [Idtac | Ring]. -Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite double. -Pattern 1 ``eps*/M``; Rewrite <- Rplus_Or. -Apply Rlt_compatibility; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]. -DiscrR. -DiscrR. -Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3). -Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3). -Rewrite H7; Do 2 Rewrite Rmult_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Reflexivity. -Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Idtac | Ring]. -Symmetry; Apply Rabsolu_mult. -Cut ``0<eps/(2*(Rabsolu l2))``. -Intro. -Unfold Un_cv in H; Unfold R_dist in H; Unfold Un_cv in H0; Unfold R_dist in H0. -Elim (H ``eps/(2*(Rabsolu l2))`` H8); Intros N1 H9. -Elim (H0 ``eps/(2*M)`` H6); Intros N2 H10. -Pose N := (max N1 N2). -Exists N; Intros. -Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``. -Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring]. -Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``. -Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with ``(Rabsolu l2)*(Rabsolu ((An n)-l1))``. -Rewrite (double_var eps); Apply Rplus_lt. -Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``. -Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``). -Apply Rle_monotony. -Apply Rabsolu_pos. -Apply H4. -Apply Rlt_monotony_contra with ``/M``. -Apply Rlt_Rinv; Apply H3. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``). -Apply Rlt_le_trans with ``eps/(2*M)``. -Apply H10. -Unfold ge; Apply le_trans with N. -Unfold N; Apply le_max_r. -Assumption. -Unfold Rdiv; Rewrite Rinv_Rmult. -Right; Ring. -DiscrR. -Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3). -Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3). -Apply Rlt_monotony_contra with ``/(Rabsolu l2)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Apply Rlt_le_trans with ``eps/(2*(Rabsolu l2))``. -Apply H9. -Unfold ge; Apply le_trans with N. -Unfold N; Apply le_max_l. -Assumption. -Unfold Rdiv; Right; Rewrite Rinv_Rmult. -Ring. -DiscrR. -Apply Rabsolu_no_R0; Assumption. -Apply Rabsolu_no_R0; Assumption. -Replace ``(An n)*l2-l1*l2`` with ``l2*((An n)-l1)``; [Symmetry; Apply Rabsolu_mult | Ring]. -Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Symmetry; Apply Rabsolu_mult | Ring]. -Unfold Rdiv; Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]. -Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Assumption]]. -Apply existTT with l1; Assumption. +Lemma CV_mult : + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2). +intros. +cut (sigT (fun l:R => Un_cv An l)). +intro. +assert (H1 := maj_by_pos An X). +elim H1; intros M H2. +elim H2; intros. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +cut (0 < eps / (2 * M)). +intro. +case (Req_dec l2 0); intro. +unfold Un_cv in H0; unfold R_dist in H0. +elim (H0 (eps / (2 * M)) H6); intros. +exists x; intros. +apply Rle_lt_trans with + (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). +replace (An n * Bn n - l1 * l2) with + (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); + [ apply Rabs_triang | ring ]. +replace (Rabs (An n * Bn n - An n * l2)) with + (Rabs (An n) * Rabs (Bn n - l2)). +replace (Rabs (An n * l2 - l1 * l2)) with 0. +rewrite Rplus_0_r. +apply Rle_lt_trans with (M * Rabs (Bn n - l2)). +do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). +apply Rmult_le_compat_l. +apply Rabs_pos. +apply H4. +apply Rmult_lt_reg_l with (/ M). +apply Rinv_0_lt_compat; apply H3. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). +apply Rlt_trans with (eps / (2 * M)). +apply H8; assumption. +unfold Rdiv in |- *; rewrite Rinv_mult_distr. +apply Rmult_lt_reg_l with 2. +prove_sup0. +replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M)); + [ idtac | ring ]. +rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite double. +pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r. +apply Rplus_lt_compat_l; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ]. +discrR. +discrR. +red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). +red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). +rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity. +replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ]. +symmetry in |- *; apply Rabs_mult. +cut (0 < eps / (2 * Rabs l2)). +intro. +unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0; + unfold R_dist in H0. +elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9. +elim (H0 (eps / (2 * M)) H6); intros N2 H10. +pose (N := max N1 N2). +exists N; intros. +apply Rle_lt_trans with + (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). +replace (An n * Bn n - l1 * l2) with + (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); + [ apply Rabs_triang | ring ]. +replace (Rabs (An n * Bn n - An n * l2)) with + (Rabs (An n) * Rabs (Bn n - l2)). +replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)). +rewrite (double_var eps); apply Rplus_lt_compat. +apply Rle_lt_trans with (M * Rabs (Bn n - l2)). +do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). +apply Rmult_le_compat_l. +apply Rabs_pos. +apply H4. +apply Rmult_lt_reg_l with (/ M). +apply Rinv_0_lt_compat; apply H3. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). +apply Rlt_le_trans with (eps / (2 * M)). +apply H10. +unfold ge in |- *; apply le_trans with N. +unfold N in |- *; apply le_max_r. +assumption. +unfold Rdiv in |- *; rewrite Rinv_mult_distr. +right; ring. +discrR. +red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). +red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). +apply Rmult_lt_reg_l with (/ Rabs l2). +apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)). +apply H9. +unfold ge in |- *; apply le_trans with N. +unfold N in |- *; apply le_max_l. +assumption. +unfold Rdiv in |- *; right; rewrite Rinv_mult_distr. +ring. +discrR. +apply Rabs_no_R0; assumption. +apply Rabs_no_R0; assumption. +replace (An n * l2 - l1 * l2) with (l2 * (An n - l1)); + [ symmetry in |- *; apply Rabs_mult | ring ]. +replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); + [ symmetry in |- *; apply Rabs_mult | ring ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | assumption ] ]. +apply existT with l1; assumption. Qed. -Lemma tech9 : (Un:nat->R) (Un_growing Un) -> ((m,n:nat)(le m n)->``(Un m)<=(Un n)``). -Intros; Unfold Un_growing in H. -Induction n. -Induction m. -Right; Reflexivity. -Elim (le_Sn_O ? H0). -Cut (le m n)\/m=(S n). -Intro; Elim H1; Intro. -Apply Rle_trans with (Un n). -Apply Hrecn; Assumption. -Apply H. -Rewrite H2; Right; Reflexivity. -Inversion H0. -Right; Reflexivity. -Left; Assumption. +Lemma tech9 : + forall Un:nat -> R, + Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n. +intros; unfold Un_growing in H. +induction n as [| n Hrecn]. +induction m as [| m Hrecm]. +right; reflexivity. +elim (le_Sn_O _ H0). +cut ((m <= n)%nat \/ m = S n). +intro; elim H1; intro. +apply Rle_trans with (Un n). +apply Hrecn; assumption. +apply H. +rewrite H2; right; reflexivity. +inversion H0. +right; reflexivity. +left; assumption. Qed. -Lemma tech10 : (Un:nat->R;x:R) (Un_growing Un) -> (is_lub (EUn Un) x) -> (Un_cv Un x). -Intros; Cut (bound (EUn Un)). -Intro; Assert H2 := (Un_cv_crit ? H H1). -Elim H2; Intros. -Case (total_order_T x x0); Intro. -Elim s; Intro. -Cut (n:nat)``(Un n)<=x``. -Intro; Unfold Un_cv in H3; Cut ``0<x0-x``. -Intro; Elim (H3 ``x0-x`` H5); Intros. -Cut (ge x1 x1). -Intro; Assert H8 := (H6 x1 H7). -Unfold R_dist in H8; Rewrite Rabsolu_left1 in H8. -Rewrite Ropp_distr2 in H8; Unfold Rminus in H8. -Assert H9 := (Rlt_anti_compatibility ``x0`` ? ? H8). -Assert H10 := (Ropp_Rlt ? ? H9). -Assert H11 := (H4 x1). -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H11)). -Apply Rle_minus; Apply Rle_trans with x. -Apply H4. -Left; Assumption. -Unfold ge; Apply le_n. -Apply Rgt_minus; Assumption. -Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros. -Apply H4; Unfold EUn; Exists n; Reflexivity. -Rewrite b; Assumption. -Cut ((n:nat)``(Un n)<=x0``). -Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros. -Cut (y:R)(EUn Un y)->``y<=x0``. -Intro; Assert H8 := (H6 ? H7). -Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 r)). -Unfold EUn; Intros; Elim H7; Intros. -Rewrite H8; Apply H4. -Intro; Case (total_order_Rle (Un n) x0); Intro. -Assumption. -Cut (n0:nat)(le n n0) -> ``x0<(Un n0)``. -Intro; Unfold Un_cv in H3; Cut ``0<(Un n)-x0``. -Intro; Elim (H3 ``(Un n)-x0`` H5); Intros. -Cut (ge (max n x1) x1). -Intro; Assert H8 := (H6 (max n x1) H7). -Unfold R_dist in H8. -Rewrite Rabsolu_right in H8. -Unfold Rminus in H8; Do 2 Rewrite <- (Rplus_sym ``-x0``) in H8. -Assert H9 := (Rlt_anti_compatibility ? ? ? H8). -Cut ``(Un n)<=(Un (max n x1))``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H9)). -Apply tech9; [Assumption | Apply le_max_l]. -Apply Rge_trans with ``(Un n)-x0``. -Unfold Rminus; Apply Rle_sym1; Do 2 Rewrite <- (Rplus_sym ``-x0``); Apply Rle_compatibility. -Apply tech9; [Assumption | Apply le_max_l]. -Left; Assumption. -Unfold ge; Apply le_max_r. -Apply Rlt_anti_compatibility with x0. -Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym x0); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H4; Apply le_n. -Intros; Apply Rlt_le_trans with (Un n). -Case (total_order_Rlt_Rle x0 (Un n)); Intro. -Assumption. -Elim n0; Assumption. -Apply tech9; Assumption. -Unfold bound; Exists x; Unfold is_lub in H0; Elim H0; Intros; Assumption. +Lemma tech10 : + forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x. +intros; cut (bound (EUn Un)). +intro; assert (H2 := Un_cv_crit _ H H1). +elim H2; intros. +case (total_order_T x x0); intro. +elim s; intro. +cut (forall n:nat, Un n <= x). +intro; unfold Un_cv in H3; cut (0 < x0 - x). +intro; elim (H3 (x0 - x) H5); intros. +cut (x1 >= x1)%nat. +intro; assert (H8 := H6 x1 H7). +unfold R_dist in H8; rewrite Rabs_left1 in H8. +rewrite Ropp_minus_distr in H8; unfold Rminus in H8. +assert (H9 := Rplus_lt_reg_r x0 _ _ H8). +assert (H10 := Ropp_lt_cancel _ _ H9). +assert (H11 := H4 x1). +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)). +apply Rle_minus; apply Rle_trans with x. +apply H4. +left; assumption. +unfold ge in |- *; apply le_n. +apply Rgt_minus; assumption. +intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. +apply H4; unfold EUn in |- *; exists n; reflexivity. +rewrite b; assumption. +cut (forall n:nat, Un n <= x0). +intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. +cut (forall y:R, EUn Un y -> y <= x0). +intro; assert (H8 := H6 _ H7). +elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)). +unfold EUn in |- *; intros; elim H7; intros. +rewrite H8; apply H4. +intro; case (Rle_dec (Un n) x0); intro. +assumption. +cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0). +intro; unfold Un_cv in H3; cut (0 < Un n - x0). +intro; elim (H3 (Un n - x0) H5); intros. +cut (max n x1 >= x1)%nat. +intro; assert (H8 := H6 (max n x1) H7). +unfold R_dist in H8. +rewrite Rabs_right in H8. +unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8. +assert (H9 := Rplus_lt_reg_r _ _ _ H8). +cut (Un n <= Un (max n x1)). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)). +apply tech9; [ assumption | apply le_max_l ]. +apply Rge_trans with (Un n - x0). +unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0)); + apply Rplus_le_compat_l. +apply tech9; [ assumption | apply le_max_l ]. +left; assumption. +unfold ge in |- *; apply le_max_r. +apply Rplus_lt_reg_r with x0. +rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H4; apply le_n. +intros; apply Rlt_le_trans with (Un n). +case (Rlt_le_dec x0 (Un n)); intro. +assumption. +elim n0; assumption. +apply tech9; assumption. +unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros; + assumption. Qed. -Lemma tech13 : (An:nat->R;k:R) ``0<=k<1`` -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (EXT k0 : R | ``k<k0<1`` /\ (EX N:nat | (n:nat) (le N n)->``(Rabsolu ((An (S n))/(An n)))<k0``)). -Intros; Exists ``k+(1-k)/2``. -Split. -Split. -Pattern 1 k; Rewrite <- Rplus_Or; Apply Rlt_compatibility. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Replace ``k+(1-k)`` with R1; [Elim H; Intros; Assumption | Ring]. -Apply Rlt_Rinv; Sup0. -Apply Rlt_monotony_contra with ``2``. -Sup0. -Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Pattern 1 ``2``; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Replace ``2*k+(1-k)`` with ``1+k``; [Idtac | Ring]. -Elim H; Intros. -Apply Rlt_compatibility; Assumption. -Unfold Un_cv in H0; Cut ``0<(1-k)/2``. -Intro; Elim (H0 ``(1-k)/2`` H1); Intros. -Exists x; Intros. -Assert H4 := (H2 n H3). -Unfold R_dist in H4; Rewrite <- Rabsolu_Rabsolu; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``((Rabsolu ((An (S n))/(An n)))-k)+k``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-k))+(Rabsolu k)``. -Apply Rabsolu_triang. -Rewrite (Rabsolu_right k). -Apply Rlt_anti_compatibility with ``-k``; Rewrite <- (Rplus_sym k); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Repeat Rewrite Rplus_Ol; Apply H4. -Apply Rle_sym1; Elim H; Intros; Assumption. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Elim H; Intros; Replace ``k+(1-k)`` with R1; [Assumption | Ring]. -Apply Rlt_Rinv; Sup0. +Lemma tech13 : + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + exists k0 : R + | k < k0 < 1 /\ + ( exists N : nat + | (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)). +intros; exists (k + (1 - k) / 2). +split. +split. +pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1; + [ elim H; intros; assumption | ring ]. +apply Rinv_0_lt_compat; prove_sup0. +apply Rmult_lt_reg_l with 2. +prove_sup0. +unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; + pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r; + replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ]. +elim H; intros. +apply Rplus_lt_compat_l; assumption. +unfold Un_cv in H0; cut (0 < (1 - k) / 2). +intro; elim (H0 ((1 - k) / 2) H1); intros. +exists x; intros. +assert (H4 := H2 n H3). +unfold R_dist in H4; rewrite <- Rabs_Rabsolu; + replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k); + [ idtac | ring ]; + apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k). +apply Rabs_triang. +rewrite (Rabs_right k). +apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k); + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + repeat rewrite Rplus_0_l; apply H4. +apply Rle_ge; elim H; intros; assumption. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros; + replace (k + (1 - k)) with 1; [ assumption | ring ]. +apply Rinv_0_lt_compat; prove_sup0. Qed. (**********) -Lemma growing_ineq : (Un:nat->R;l:R) (Un_growing Un) -> (Un_cv Un l) -> ((n:nat)``(Un n)<=l``). -Intros; Case (total_order_T (Un n) l); Intro. -Elim s; Intro. -Left; Assumption. -Right; Assumption. -Cut ``0<(Un n)-l``. -Intro; Unfold Un_cv in H0; Unfold R_dist in H0. -Elim (H0 ``(Un n)-l`` H1); Intros N1 H2. -Pose N := (max n N1). -Cut ``(Un n)-l<=(Un N)-l``. -Intro; Cut ``(Un N)-l<(Un n)-l``. -Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 H4)). -Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l))``. -Apply Rle_Rabsolu. -Apply H2. -Unfold ge N; Apply le_max_r. -Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rle_compatibility. -Apply tech9. -Assumption. -Unfold N; Apply le_max_l. -Apply Rlt_anti_compatibility with l. -Rewrite Rplus_Or. -Replace ``l+((Un n)-l)`` with (Un n); [Assumption | Ring]. +Lemma growing_ineq : + forall (Un:nat -> R) (l:R), + Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l. +intros; case (total_order_T (Un n) l); intro. +elim s; intro. +left; assumption. +right; assumption. +cut (0 < Un n - l). +intro; unfold Un_cv in H0; unfold R_dist in H0. +elim (H0 (Un n - l) H1); intros N1 H2. +pose (N := max n N1). +cut (Un n - l <= Un N - l). +intro; cut (Un N - l < Un n - l). +intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)). +apply Rle_lt_trans with (Rabs (Un N - l)). +apply RRle_abs. +apply H2. +unfold ge, N in |- *; apply le_max_r. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); + apply Rplus_le_compat_l. +apply tech9. +assumption. +unfold N in |- *; apply le_max_l. +apply Rplus_lt_reg_r with l. +rewrite Rplus_0_r. +replace (l + (Un n - l)) with (Un n); [ assumption | ring ]. Qed. (* Un->l => (-Un) -> (-l) *) -Lemma CV_opp : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv (opp_seq An) ``-l``). -Intros An l. -Unfold Un_cv; Unfold R_dist; Intros. -Elim (H eps H0); Intros. -Exists x; Intros. -Unfold opp_seq; Replace ``-(An n)- (-l)`` with ``-((An n)-l)``; [Rewrite Rabsolu_Ropp | Ring]. -Apply H1; Assumption. +Lemma CV_opp : + forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l). +intros An l. +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H eps H0); intros. +exists x; intros. +unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l)); + [ rewrite Rabs_Ropp | ring ]. +apply H1; assumption. Qed. (**********) -Lemma decreasing_ineq : (Un:nat->R;l:R) (Un_decreasing Un) -> (Un_cv Un l) -> ((n:nat)``l<=(Un n)``). -Intros. -Assert H1 := (decreasing_growing ? H). -Assert H2 := (CV_opp ? ? H0). -Assert H3 := (growing_ineq ? ? H1 H2). -Apply Ropp_Rle. -Unfold opp_seq in H3; Apply H3. +Lemma decreasing_ineq : + forall (Un:nat -> R) (l:R), + Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n. +intros. +assert (H1 := decreasing_growing _ H). +assert (H2 := CV_opp _ _ H0). +assert (H3 := growing_ineq _ _ H1 H2). +apply Ropp_le_cancel. +unfold opp_seq in H3; apply H3. Qed. (**********) -Lemma CV_minus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)-(Bn i)`` ``l1-l2``). -Intros. -Replace [i:nat]``(An i)-(Bn i)`` with [i:nat]``(An i)+((opp_seq Bn) i)``. -Unfold Rminus; Apply CV_plus. -Assumption. -Apply CV_opp; Assumption. -Unfold Rminus opp_seq; Reflexivity. +Lemma CV_minus : + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2). +intros. +replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i). +unfold Rminus in |- *; apply CV_plus. +assumption. +apply CV_opp; assumption. +unfold Rminus, opp_seq in |- *; reflexivity. Qed. (* Un -> +oo *) -Definition cv_infty [Un:nat->R] : Prop := (M:R)(EXT N:nat | (n:nat) (le N n) -> ``M<(Un n)``). +Definition cv_infty (Un:nat -> R) : Prop := + forall M:R, exists N : nat | (forall n:nat, (N <= n)%nat -> M < Un n). (* Un -> +oo => /Un -> O *) -Lemma cv_infty_cv_R0 : (Un:nat->R) ((n:nat)``(Un n)<>0``) -> (cv_infty Un) -> (Un_cv [n:nat]``/(Un n)`` R0). -Unfold cv_infty Un_cv; Unfold R_dist; Intros. -Elim (H0 ``/eps``); Intros N0 H2. -Exists N0; Intros. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite (Rabsolu_Rinv ? (H n)). -Apply Rlt_monotony_contra with (Rabsolu (Un n)). -Apply Rabsolu_pos_lt; Apply H. -Rewrite <- Rinv_r_sym. -Apply Rlt_monotony_contra with ``/eps``. -Apply Rlt_Rinv; Assumption. -Rewrite Rmult_1r; Rewrite (Rmult_sym ``/eps``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Apply Rlt_le_trans with (Un n). -Apply H2; Assumption. -Apply Rle_Rabsolu. -Red; Intro; Rewrite H4 in H1; Elim (Rlt_antirefl ? H1). -Apply Rabsolu_no_R0; Apply H. +Lemma cv_infty_cv_R0 : + forall Un:nat -> R, + (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0. +unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H0 (/ eps)); intros N0 H2. +exists N0; intros. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite (Rabs_Rinv _ (H n)). +apply Rmult_lt_reg_l with (Rabs (Un n)). +apply Rabs_pos_lt; apply H. +rewrite <- Rinv_r_sym. +apply Rmult_lt_reg_l with (/ eps). +apply Rinv_0_lt_compat; assumption. +rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rlt_le_trans with (Un n). +apply H2; assumption. +apply RRle_abs. +red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1). +apply Rabs_no_R0; apply H. Qed. (**********) -Lemma decreasing_prop : (Un:nat->R;m,n:nat) (Un_decreasing Un) -> (le m n) -> ``(Un n)<=(Un m)``. -Unfold Un_decreasing; Intros. -Induction n. -Induction m. -Right; Reflexivity. -Elim (le_Sn_O ? H0). -Cut (le m n)\/m=(S n). -Intro; Elim H1; Intro. -Apply Rle_trans with (Un n). -Apply H. -Apply Hrecn; Assumption. -Rewrite H2; Right; Reflexivity. -Inversion H0; [Right; Reflexivity | Left; Assumption]. +Lemma decreasing_prop : + forall (Un:nat -> R) (m n:nat), + Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m. +unfold Un_decreasing in |- *; intros. +induction n as [| n Hrecn]. +induction m as [| m Hrecm]. +right; reflexivity. +elim (le_Sn_O _ H0). +cut ((m <= n)%nat \/ m = S n). +intro; elim H1; intro. +apply Rle_trans with (Un n). +apply H. +apply Hrecn; assumption. +rewrite H2; right; reflexivity. +inversion H0; [ right; reflexivity | left; assumption ]. Qed. (* |x|^n/n! -> 0 *) -Lemma cv_speed_pow_fact : (x:R) (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` R0). -Intro; Cut (Un_cv [n:nat]``(pow (Rabsolu x) n)/(INR (fact n))`` R0) -> (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` ``0``). -Intro; Apply H. -Unfold Un_cv; Unfold R_dist; Intros; Case (Req_EM x R0); Intro. -Exists (S O); Intros. -Rewrite H1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Rewrite pow_ne_zero; [Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption | Red; Intro; Rewrite H3 in H2; Elim (le_Sn_n ? H2)]. -Assert H2 := (Rabsolu_pos_lt x H1); Pose M := (up (Rabsolu x)); Cut `0<=M`. -Intro; Elim (IZN M H3); Intros M_nat H4. -Pose Un := [n:nat]``(pow (Rabsolu x) (plus M_nat n))/(INR (fact (plus M_nat n)))``. -Cut (Un_cv Un R0); Unfold Un_cv; Unfold R_dist; Intros. -Elim (H5 eps H0); Intros N H6. -Exists (plus M_nat N); Intros; Cut (EX p:nat | (ge p N)/\n=(plus M_nat p)). -Intro; Elim H8; Intros p H9. -Elim H9; Intros; Rewrite H11; Unfold Un in H6; Apply H6; Assumption. -Exists (minus n M_nat). -Split. -Unfold ge; Apply simpl_le_plus_l with M_nat; Rewrite <- le_plus_minus. -Assumption. -Apply le_trans with (plus M_nat N). -Apply le_plus_l. -Assumption. -Apply le_plus_minus; Apply le_trans with (plus M_nat N); [Apply le_plus_l | Assumption]. -Pose Vn := [n:nat]``(Rabsolu x)*(Un O)/(INR (S n))``. -Cut (le (1) M_nat). -Intro; Cut (n:nat)``0<(Un n)``. -Intro; Cut (Un_decreasing Un). -Intro; Cut (n:nat)``(Un (S n))<=(Vn n)``. -Intro; Cut (Un_cv Vn R0). -Unfold Un_cv; Unfold R_dist; Intros. -Elim (H10 eps0 H5); Intros N1 H11. -Exists (S N1); Intros. -Cut (n:nat)``0<(Vn n)``. -Intro; Apply Rle_lt_trans with ``(Rabsolu ((Vn (pred n))-0))``. -Repeat Rewrite Rabsolu_right. -Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Replace n with (S (pred n)). -Apply H9. -Inversion H12; Simpl; Reflexivity. -Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H13. -Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H7. -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 [n:nat](INR (S n))). -Intro; Cut (Un_cv [n:nat]``/(INR (S n))`` R0). -Unfold Un_cv R_dist; Intros; Unfold Vn. -Cut ``0<eps1/((Rabsolu x)*(Un O))``. -Intro; Elim (H11 ? H13); Intros N H14. -Exists N; Intros; Replace ``(Rabsolu x)*(Un O)/(INR (S n))-0`` with ``((Rabsolu x)*(Un O))*(/(INR (S n))-0)``; [Idtac | Unfold Rdiv; Ring]. -Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu ((Rabsolu x)*(Un O)))``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt. -Apply prod_neq_R0. -Apply Rabsolu_no_R0; Assumption. -Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16). -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l. -Replace ``/(Rabsolu ((Rabsolu x)*(Un O)))*eps1`` with ``eps1/((Rabsolu x)*(Un O))``. -Apply H14; Assumption. -Unfold Rdiv; Rewrite (Rabsolu_right ``(Rabsolu x)*(Un O)``). -Apply Rmult_sym. -Apply Rle_sym1; Apply Rmult_le_pos. -Apply Rabsolu_pos. -Left; Apply H7. -Apply Rabsolu_no_R0. -Apply prod_neq_R0; [Apply Rabsolu_no_R0; Assumption | Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16)]. -Unfold Rdiv; Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv; Apply Rmult_lt_pos. -Apply Rabsolu_pos_lt; Assumption. -Apply H7. -Apply (cv_infty_cv_R0 [n:nat]``(INR (S n))``). -Intro; Apply not_O_INR; Discriminate. -Assumption. -Unfold cv_infty; Intro; Case (total_order_T M0 R0); Intro. -Elim s; Intro. -Exists O; Intros. -Apply Rlt_trans with R0; [Assumption | Apply lt_INR_0; Apply lt_O_Sn]. -Exists O; Intros; Rewrite b; Apply lt_INR_0; Apply lt_O_Sn. -Pose M0_z := (up M0). -Assert H10 := (archimed M0). -Cut `0<=M0_z`. -Intro; Elim (IZN ? H11); Intros M0_nat H12. -Exists M0_nat; Intros. -Apply Rlt_le_trans with (IZR M0_z). -Elim H10; Intros; Assumption. -Rewrite H12; Rewrite <- INR_IZR_INZ; Apply le_INR. -Apply le_trans with n; [Assumption | Apply le_n_Sn]. -Apply le_IZR; Left; Simpl; Unfold M0_z; Apply Rlt_trans with M0; [Assumption | Elim H10; Intros; Assumption]. -Intro; Apply Rle_trans with ``(Rabsolu x)*(Un n)*/(INR (S n))``. -Unfold Un; Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)). -Rewrite pow_add; Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring]. -Unfold Rdiv; Rewrite <- (Rmult_sym (Rabsolu x)); Repeat Rewrite Rmult_assoc; Repeat Apply Rle_monotony. -Apply Rabsolu_pos. -Left; Apply pow_lt; Assumption. -Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)). -Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rinv_Rmult. -Apply Rle_monotony. -Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H10 := (sym_eq ? ? ? H9); Elim (fact_neq_0 ? H10). -Left; Apply Rinv_lt. -Apply Rmult_lt_pos; Apply lt_INR_0; Apply lt_O_Sn. -Apply lt_INR; Apply lt_n_S. -Pattern 1 n; Replace n with (plus O n); [Idtac | Reflexivity]. -Apply lt_reg_r. -Apply lt_le_trans with (S O); [Apply lt_O_Sn | Assumption]. -Apply INR_fact_neq_0. -Apply not_O_INR; Discriminate. -Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity. -Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring. -Unfold Vn; Rewrite Rmult_assoc; Unfold Rdiv; Rewrite (Rmult_sym (Un O)); Rewrite (Rmult_sym (Un n)). -Repeat Apply Rle_monotony. -Apply Rabsolu_pos. -Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn. -Apply decreasing_prop; [Assumption | Apply le_O_n]. -Unfold Un_decreasing; Intro; Unfold Un. -Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)). -Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony. -Left; Apply pow_lt; Assumption. -Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring]. -Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)). -Apply Rle_monotony_contra with (INR (fact (S (plus M_nat n)))). -Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H9 := (sym_eq ? ? ? H8); Elim (fact_neq_0 ? H9). -Rewrite (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l. -Rewrite fact_simpl; Rewrite mult_INR; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1r; Apply Rle_trans with (INR M_nat). -Left; Rewrite INR_IZR_INZ. -Rewrite <- H4; Assert H8 := (archimed (Rabsolu x)); Elim H8; Intros; Assumption. -Apply le_INR; Apply le_trans with (S M_nat); [Apply le_n_Sn | Apply le_n_S; Apply le_plus_l]. -Apply INR_fact_neq_0. -Apply INR_fact_neq_0. -Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity. -Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring. -Intro; Unfold Un; Unfold Rdiv; Apply Rmult_lt_pos. -Apply pow_lt; Assumption. -Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H8 := (sym_eq ? ? ? H7); Elim (fact_neq_0 ? H8). -Clear Un Vn; Apply INR_le; Simpl. -Induction M_nat. -Assert H6 := (archimed (Rabsolu x)); Fold M in H6; Elim H6; Intros. -Rewrite H4 in H7; Rewrite <- INR_IZR_INZ in H7. -Simpl in H7; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H2 H7)). -Replace R1 with (INR (S O)); [Apply le_INR | Reflexivity]; Apply le_n_S; Apply le_O_n. -Apply le_IZR; Simpl; Left; Apply Rlt_trans with (Rabsolu x). -Assumption. -Elim (archimed (Rabsolu x)); Intros; Assumption. -Unfold Un_cv; Unfold R_dist; Intros; Elim (H eps H0); Intros. -Exists x0; Intros; Apply Rle_lt_trans with ``(Rabsolu ((pow (Rabsolu x) n)/(INR (fact n))-0))``. -Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Rewrite (Rabsolu_right ``(pow (Rabsolu x) n)/(INR (fact n))``). -Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(INR (fact n))``). -Rewrite Pow_Rabsolu; Right; Reflexivity. -Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4). -Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos. -Case (Req_EM x R0); Intro. -Rewrite H3; Rewrite Rabsolu_R0. -Induction n; [Simpl; Left; Apply Rlt_R0_R1 | Simpl; Rewrite Rmult_Ol; Right; Reflexivity]. -Left; Apply pow_lt; Apply Rabsolu_pos_lt; Assumption. -Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4). -Apply H1; Assumption. -Qed. +Lemma cv_speed_pow_fact : + forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0. +intro; + cut + (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 -> + Un_cv (fun n:nat => x ^ n / INR (fact n)) 0). +intro; apply H. +unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0); + intro. +exists 1%nat; intros. +rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_R0; rewrite pow_ne_zero; + [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption + | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ]. +assert (H2 := Rabs_pos_lt x H1); pose (M := up (Rabs x)); cut (0 <= M)%Z. +intro; elim (IZN M H3); intros M_nat H4. +pose (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))). +cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H5 eps H0); intros N H6. +exists (M_nat + N)%nat; intros; + cut ( exists p : nat | (p >= N)%nat /\ n = (M_nat + p)%nat). +intro; elim H8; intros p H9. +elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption. +exists (n - M_nat)%nat. +split. +unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat; + rewrite <- le_plus_minus. +assumption. +apply le_trans with (M_nat + N)%nat. +apply le_plus_l. +assumption. +apply le_plus_minus; apply le_trans with (M_nat + N)%nat; + [ apply le_plus_l | assumption ]. +pose (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))). +cut (1 <= M_nat)%nat. +intro; cut (forall n:nat, 0 < Un n). +intro; cut (Un_decreasing Un). +intro; cut (forall n:nat, Un (S n) <= Vn n). +intro; cut (Un_cv Vn 0). +unfold Un_cv in |- *; unfold R_dist in |- *; intros. +elim (H10 eps0 H5); intros N1 H11. +exists (S N1); intros. +cut (forall n:nat, 0 < Vn n). +intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)). +repeat rewrite Rabs_right. +unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; + replace n with (S (pred n)). +apply H9. +inversion H12; simpl in |- *; reflexivity. +apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; + apply H13. +apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; + apply H7. +apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n; + [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ]. +intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ]. +cut (cv_infty (fun n:nat => INR (S n))). +intro; cut (Un_cv (fun n:nat => / INR (S n)) 0). +unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *. +cut (0 < eps1 / (Rabs x * Un 0%nat)). +intro; elim (H11 _ H13); intros N H14. +exists N; intros; + replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with + (Rabs x * Un 0%nat * (/ INR (S n) - 0)); + [ idtac | unfold Rdiv in |- *; ring ]. +rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)). +apply Rinv_0_lt_compat; apply Rabs_pos_lt. +apply prod_neq_R0. +apply Rabs_no_R0; assumption. +assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; + elim (Rlt_irrefl _ H16). +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l. +replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)). +apply H14; assumption. +unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)). +apply Rmult_comm. +apply Rle_ge; apply Rmult_le_pos. +apply Rabs_pos. +left; apply H7. +apply Rabs_no_R0. +apply prod_neq_R0; + [ apply Rabs_no_R0; assumption + | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; + elim (Rlt_irrefl _ H16) ]. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. +apply Rabs_pos_lt; assumption. +apply H7. +apply (cv_infty_cv_R0 (fun n:nat => INR (S n))). +intro; apply not_O_INR; discriminate. +assumption. +unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro. +elim s; intro. +exists 0%nat; intros. +apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ]. +exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn. +pose (M0_z := up M0). +assert (H10 := archimed M0). +cut (0 <= M0_z)%Z. +intro; elim (IZN _ H11); intros M0_nat H12. +exists M0_nat; intros. +apply Rlt_le_trans with (IZR M0_z). +elim H10; intros; assumption. +rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR. +apply le_trans with n; [ assumption | apply le_n_Sn ]. +apply le_IZR; left; simpl in |- *; unfold M0_z in |- *; + apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ]. +intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)). +unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. +rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x); + [ idtac | simpl in |- *; ring ]. +unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x)); + repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply pow_lt; assumption. +replace (M_nat + n + 1)%nat with (S (M_nat + n)). +rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; + rewrite Rinv_mult_distr. +apply Rmult_le_compat_l. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; + intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10). +left; apply Rinv_lt_contravar. +apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn. +apply lt_INR; apply lt_n_S. +pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ]. +apply plus_lt_compat_r. +apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. +apply INR_fact_neq_0. +apply not_O_INR; discriminate. +apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. +apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. +unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *; + rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)). +repeat apply Rmult_le_compat_l. +apply Rabs_pos. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. +apply decreasing_prop; [ assumption | apply le_O_n ]. +unfold Un_decreasing in |- *; intro; unfold Un in |- *. +replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. +rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; + apply Rmult_le_compat_l. +left; apply pow_lt; assumption. +replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ]. +replace (M_nat + n + 1)%nat with (S (M_nat + n)). +apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))). +apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8); + elim (fact_neq_0 _ H9). +rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l. +rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. +rewrite Rmult_1_r; apply Rle_trans with (INR M_nat). +left; rewrite INR_IZR_INZ. +rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption. +apply le_INR; apply le_trans with (S M_nat); + [ apply le_n_Sn | apply le_n_S; apply le_plus_l ]. +apply INR_fact_neq_0. +apply INR_fact_neq_0. +apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. +apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. +intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply pow_lt; assumption. +apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8). +clear Un Vn; apply INR_le; simpl in |- *. +induction M_nat as [| M_nat HrecM_nat]. +assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros. +rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7. +simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)). +replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S; + apply le_O_n. +apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x). +assumption. +elim (archimed (Rabs x)); intros; assumption. +unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros. +exists x0; intros; + apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)). +unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; + rewrite (Rabs_right (Rabs x ^ n / INR (fact n))). +unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))). +rewrite RPow_abs; right; reflexivity. +apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; + red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). +apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos. +case (Req_dec x 0); intro. +rewrite H3; rewrite Rabs_R0. +induction n as [| n Hrecn]; + [ simpl in |- *; left; apply Rlt_0_1 + | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ]. +left; apply pow_lt; apply Rabs_pos_lt; assumption. +left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; + intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). +apply H1; assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v index 03963fc4d..ffac3df29 100644 --- a/theories/Reals/SeqSeries.v +++ b/theories/Reals/SeqSeries.v @@ -8,9 +8,9 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Max. +Require Import Rbase. +Require Import Rfunctions. +Require Import Max. Require Export Rseries. Require Export SeqProp. Require Export Rcomplete. @@ -21,287 +21,397 @@ Require Export Rsigma. Require Export Rprod. Require Export Cauchy_prod. Require Export Alembert. -V7only [ Import nat_scope. Import Z_scope. Import R_scope. ]. Open Local Scope R_scope. (**********) -Lemma sum_maj1 : (fn:nat->R->R;An:nat->R;x,l1,l2:R;N:nat) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu (l1-(SP fn N x)))<=l2-(sum_f_R0 An N)``. -Intros; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](fn (plus (S N) l) x) n) l)). -Intro; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](An (plus (S N) l)) n) l)). -Intro; Elim X; Intros l1N H2. -Elim X0; Intros l2N H3. -Cut ``l1-(SP fn N x)==l1N``. -Intro; Cut ``l2-(sum_f_R0 An N)==l2N``. -Intro; Rewrite H4; Rewrite H5. -Apply sum_cv_maj with [l:nat](An (plus (S N) l)) [l:nat][x:R](fn (plus (S N) l) x) x. -Unfold SP; Apply H2. -Apply H3. -Intros; Apply H1. -Symmetry; EApply UL_sequence. -Apply H3. -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; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring]. -Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))). -Apply H6; Unfold ge; Apply le_trans with n. -Apply H7. -Apply le_trans with (plus N n). -Apply le_plus_r. -Apply le_n_Sn. -Cut (le O N). -Cut (lt N (S (plus N n))). -Intros; Assert H10 := (sigma_split An H9 H8). -Unfold sigma in H10. -Do 2 Rewrite <- minus_n_O in H10. -Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))). -Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N). -Cut (minus (S (plus N n)) (S N))=n. -Intro; Rewrite H11 in H10. -Apply H10. -Apply INR_eq; Rewrite minus_INR. -Do 2 Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_n_S; Apply le_plus_l. -Apply sum_eq; Intros. -Reflexivity. -Apply sum_eq; Intros. -Reflexivity. -Apply le_lt_n_Sm; Apply le_plus_l. -Apply le_O_n. -Symmetry; EApply UL_sequence. -Apply H2. -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; Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring]. -Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))). -Unfold SP in H5; Apply H5; Unfold ge; Apply le_trans with n. -Apply H6. -Apply le_trans with (plus N n). -Apply le_plus_r. -Apply le_n_Sn. -Cut (le O N). -Cut (lt N (S (plus N n))). -Intros; Assert H9 := (sigma_split [k:nat](fn k x) H8 H7). -Unfold sigma in H9. -Do 2 Rewrite <- minus_n_O in H9. -Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))). -Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N). -Cut (minus (S (plus N n)) (S N))=n. -Intro; Rewrite H10 in H9. -Apply H9. -Apply INR_eq; Rewrite minus_INR. -Do 2 Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_n_S; Apply le_plus_l. -Apply sum_eq; Intros. -Reflexivity. -Apply sum_eq; Intros. -Reflexivity. -Apply le_lt_n_Sm. -Apply le_plus_l. -Apply le_O_n. -Apply existTT with ``l2-(sum_f_R0 An N)``. -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; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring]. -Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))). -Apply H3; Unfold ge; Apply le_trans with n. -Apply H4. -Apply le_trans with (plus N n). -Apply le_plus_r. -Apply le_n_Sn. -Cut (le O N). -Cut (lt N (S (plus N n))). -Intros; Assert H7 := (sigma_split An H6 H5). -Unfold sigma in H7. -Do 2 Rewrite <- minus_n_O in H7. -Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))). -Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N). -Cut (minus (S (plus N n)) (S N))=n. -Intro; Rewrite H8 in H7. -Apply H7. -Apply INR_eq; Rewrite minus_INR. -Do 2 Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_n_S; Apply le_plus_l. -Apply sum_eq; Intros. -Reflexivity. -Apply sum_eq; Intros. -Reflexivity. -Apply le_lt_n_Sm. -Apply le_plus_l. -Apply le_O_n. -Apply existTT with ``l1-(SP fn N x)``. -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. -Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring]. -Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))). -Unfold SP in H3; Apply H3. -Unfold ge; Apply le_trans with n. -Apply H4. -Apply le_trans with (plus N n). -Apply le_plus_r. -Apply le_n_Sn. -Cut (le O N). -Cut (lt N (S (plus N n))). -Intros; Assert H7 := (sigma_split [k:nat](fn k x) H6 H5). -Unfold sigma in H7. -Do 2 Rewrite <- minus_n_O in H7. -Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))). -Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N). -Cut (minus (S (plus N n)) (S N))=n. -Intro; Rewrite H8 in H7. -Apply H7. -Apply INR_eq; Rewrite minus_INR. -Do 2 Rewrite S_INR; Rewrite plus_INR; Ring. -Apply le_n_S; Apply le_plus_l. -Apply sum_eq; Intros. -Reflexivity. -Apply sum_eq; Intros. -Reflexivity. -Apply le_lt_n_Sm. -Apply le_plus_l. -Apply le_O_n. +Lemma sum_maj1 : + forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) + (N:nat), + Un_cv (fun n:nat => SP fn n x) l1 -> + Un_cv (fun n:nat => sum_f_R0 An n) l2 -> + (forall n:nat, Rabs (fn n x) <= An n) -> + Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N. +intros; + cut + (sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)). +intro; + cut + (sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)). +intro; elim X; intros l1N H2. +elim X0; intros l2N H3. +cut (l1 - SP fn N x = l1N). +intro; cut (l2 - sum_f_R0 An N = l2N). +intro; rewrite H4; rewrite H5. +apply sum_cv_maj with + (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x. +unfold SP in |- *; apply H2. +apply H3. +intros; apply H1. +symmetry in |- *; eapply UL_sequence. +apply H3. +unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5); + intros N0 H6. +unfold R_dist in H6; exists N0; intros. +unfold R_dist in |- *; + replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) + with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); + [ idtac | ring ]. +replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with + (sum_f_R0 An (S (N + n))). +apply H6; unfold ge in |- *; apply le_trans with n. +apply H7. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H10 := sigma_split An H9 H8). +unfold sigma in H10. +do 2 rewrite <- minus_n_O in H10. +replace (sum_f_R0 An (S (N + n))) with + (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). +replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H11 in H10. +apply H10. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm; apply le_plus_l. +apply le_O_n. +symmetry in |- *; eapply UL_sequence. +apply H2. +unfold Un_cv in H; unfold Un_cv in |- *; intros. +elim (H eps H4); intros N0 H5. +unfold R_dist in H5; exists N0; intros. +unfold R_dist, SP in |- *; + replace + (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - + (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + [ idtac | ring ]. +replace + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with + (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). +unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n. +apply H6. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7). +unfold sigma in H9. +do 2 rewrite <- minus_n_O in H9. +replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). +replace (sum_f_R0 (fun k:nat => fn k x) N) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H10 in H9. +apply H9. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm. +apply le_plus_l. +apply le_O_n. +apply existT with (l2 - sum_f_R0 An N). +unfold Un_cv in H0; unfold Un_cv in |- *; intros. +elim (H0 eps H2); intros N0 H3. +unfold R_dist in H3; exists N0; intros. +unfold R_dist in |- *; + replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) + with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); + [ idtac | ring ]. +replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with + (sum_f_R0 An (S (N + n))). +apply H3; unfold ge in |- *; apply le_trans with n. +apply H4. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H7 := sigma_split An H6 H5). +unfold sigma in H7. +do 2 rewrite <- minus_n_O in H7. +replace (sum_f_R0 An (S (N + n))) with + (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). +replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H8 in H7. +apply H7. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm. +apply le_plus_l. +apply le_O_n. +apply existT with (l1 - SP fn N x). +unfold Un_cv in H; unfold Un_cv in |- *; intros. +elim (H eps H2); intros N0 H3. +unfold R_dist in H3; exists N0; intros. +unfold R_dist, SP in |- *. +replace + (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - + (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + [ idtac | ring ]. +replace + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with + (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). +unfold SP in H3; apply H3. +unfold ge in |- *; apply le_trans with n. +apply H4. +apply le_trans with (N + n)%nat. +apply le_plus_r. +apply le_n_Sn. +cut (0 <= N)%nat. +cut (N < S (N + n))%nat. +intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5). +unfold sigma in H7. +do 2 rewrite <- minus_n_O in H7. +replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). +replace (sum_f_R0 (fun k:nat => fn k x) N) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). +cut ((S (N + n) - S N)%nat = n). +intro; rewrite H8 in H7. +apply H7. +apply INR_eq; rewrite minus_INR. +do 2 rewrite S_INR; rewrite plus_INR; ring. +apply le_n_S; apply le_plus_l. +apply sum_eq; intros. +reflexivity. +apply sum_eq; intros. +reflexivity. +apply le_lt_n_Sm. +apply le_plus_l. +apply le_O_n. Qed. (* Comparaison of convergence for series *) -Lemma Rseries_CV_comp : (An,Bn:nat->R) ((n:nat)``0<=(An n)<=(Bn n)``) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 Bn N) l)) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 An N) l)). -Intros; Apply cv_cauchy_2. -Assert H0 := (cv_cauchy_1 ? X). -Unfold Cauchy_crit_series; Unfold Cauchy_crit. -Intros; Elim (H0 eps H1); Intros. -Exists x; Intros. -Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m))). -Intro; Apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). -Assumption. -Apply H2; Assumption. -Assert H5 := (lt_eq_lt_dec n m). -Elim H5; Intro. -Elim a; Intro. -Rewrite (tech2 An n m); [Idtac | Assumption]. -Rewrite (tech2 Bn n m); [Idtac | Assumption]. -Unfold R_dist; Unfold Rminus; Do 2 Rewrite Ropp_distr1; Do 2 Rewrite <- Rplus_assoc; Do 2 Rewrite Rplus_Ropp_r; Do 2 Rewrite Rplus_Ol; Do 2 Rewrite Rabsolu_Ropp; Repeat Rewrite Rabsolu_right. -Apply sum_Rle; Intros. -Elim (H (plus (S n) n0)); Intros. -Apply H8. -Apply Rle_sym1; Apply cond_pos_sum; Intro. -Elim (H (plus (S n) n0)); Intros. -Apply Rle_trans with (An (plus (S n) n0)); Assumption. -Apply Rle_sym1; Apply cond_pos_sum; Intro. -Elim (H (plus (S n) n0)); Intros; Assumption. -Rewrite b; Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity. -Rewrite (tech2 An m n); [Idtac | Assumption]. -Rewrite (tech2 Bn m n); [Idtac | Assumption]. -Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_assoc; Rewrite (Rplus_sym (sum_f_R0 An m)); Rewrite (Rplus_sym (sum_f_R0 Bn m)); Do 2 Rewrite Rplus_assoc; Do 2 Rewrite Rplus_Ropp_l; Do 2 Rewrite Rplus_Or; Repeat Rewrite Rabsolu_right. -Apply sum_Rle; Intros. -Elim (H (plus (S m) n0)); Intros; Apply H8. -Apply Rle_sym1; Apply cond_pos_sum; Intro. -Elim (H (plus (S m) n0)); Intros. -Apply Rle_trans with (An (plus (S m) n0)); Assumption. -Apply Rle_sym1. -Apply cond_pos_sum; Intro. -Elim (H (plus (S m) n0)); Intros; Assumption. +Lemma Rseries_CV_comp : + forall An Bn:nat -> R, + (forall n:nat, 0 <= An n <= Bn n) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +intros; apply cv_cauchy_2. +assert (H0 := cv_cauchy_1 _ X). +unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. +intros; elim (H0 eps H1); intros. +exists x; intros. +cut + (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= + R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). +intro; apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). +assumption. +apply H2; assumption. +assert (H5 := lt_eq_lt_dec n m). +elim H5; intro. +elim a; intro. +rewrite (tech2 An n m); [ idtac | assumption ]. +rewrite (tech2 Bn n m); [ idtac | assumption ]. +unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr; + do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r; + do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right. +apply sum_Rle; intros. +elim (H (S n + n0)%nat); intros. +apply H8. +apply Rle_ge; apply cond_pos_sum; intro. +elim (H (S n + n0)%nat); intros. +apply Rle_trans with (An (S n + n0)%nat); assumption. +apply Rle_ge; apply cond_pos_sum; intro. +elim (H (S n + n0)%nat); intros; assumption. +rewrite b; unfold R_dist in |- *; unfold Rminus in |- *; + do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; + reflexivity. +rewrite (tech2 An m n); [ idtac | assumption ]. +rewrite (tech2 Bn m n); [ idtac | assumption ]. +unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc; + rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m)); + do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; + do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right. +apply sum_Rle; intros. +elim (H (S m + n0)%nat); intros; apply H8. +apply Rle_ge; apply cond_pos_sum; intro. +elim (H (S m + n0)%nat); intros. +apply Rle_trans with (An (S m + n0)%nat); assumption. +apply Rle_ge. +apply cond_pos_sum; intro. +elim (H (S m + n0)%nat); intros; assumption. Qed. (* Cesaro's theorem *) -Lemma Cesaro : (An,Bn:nat->R;l:R) (Un_cv Bn l) -> ((n:nat)``0<(An n)``) -> (cv_infty [n:nat](sum_f_R0 An n)) -> (Un_cv [n:nat](Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l). -Proof with Trivial. -Unfold Un_cv; Intros; Assert H3 : (n:nat)``0<(sum_f_R0 An n)``. -Intro; Apply tech1. -Assert H4 : (n:nat) ``(sum_f_R0 An n)<>0``. -Intro; Red; Intro; Assert H5 := (H3 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5). -Assert H5 := (cv_infty_cv_R0 ? H4 H1); Assert H6 : ``0<eps/2``. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rlt_Rinv; Sup. -Elim (H ? H6); Clear H; Intros N1 H; Pose C := (Rabsolu (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1)); Assert H7 : (EX N:nat | (n:nat) (le N n) -> ``C/(sum_f_R0 An n)<eps/2``). -Case (Req_EM C R0); Intro. -Exists O; Intros. -Rewrite H7; Unfold Rdiv; Rewrite Rmult_Ol; Apply Rmult_lt_pos. -Apply Rlt_Rinv; Sup. -Assert H8 : ``0<eps/(2*(Rabsolu C))``. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply Rlt_Rinv; Apply Rmult_lt_pos. -Sup. -Apply Rabsolu_pos_lt. -Elim (H5 ? H8); Intros; Exists x; Intros; Assert H11 := (H9 ? H10); Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11. -Apply Rle_lt_trans with (Rabsolu ``C/(sum_f_R0 An n)``). -Apply Rle_Rabsolu. -Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu C)``. -Apply Rlt_Rinv; Apply Rabsolu_pos_lt. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Replace ``/(Rabsolu C)*(eps*/2)`` with ``eps/(2*(Rabsolu C))``. -Unfold Rdiv; Rewrite Rinv_Rmult. -Ring. -DiscrR. -Apply Rabsolu_no_R0. -Apply Rabsolu_no_R0. -Elim H7; Clear H7; Intros N2 H7; Pose N := (max N1 N2); Exists (S N); Intros; Unfold R_dist; Replace (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l) with (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) (sum_f_R0 An n)). -Assert H9 : (lt N1 n). -Apply lt_le_trans with (S N). -Apply le_lt_n_Sm; Unfold N; Apply le_max_l. -Rewrite (tech2 [k:nat]``(An k)*((Bn k)-l)`` ? ? H9); Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Apply Rle_lt_trans with (Rplus (Rabsolu (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1) (sum_f_R0 An n))) (Rabsolu (Rdiv (sum_f_R0 [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))) (sum_f_R0 An n)))). -Apply Rabsolu_triang. -Rewrite (double_var eps); Apply Rplus_lt. -Unfold Rdiv; Rewrite Rabsolu_mult; Fold C; Rewrite Rabsolu_right. -Apply (H7 n); Apply le_trans with (S N). -Apply le_trans with N; [Unfold N; Apply le_max_r | Apply le_n_Sn]. -Apply Rle_sym1; Left; Apply Rlt_Rinv. +Lemma Cesaro : + forall (An Bn:nat -> R) (l:R), + Un_cv Bn l -> + (forall n:nat, 0 < An n) -> + cv_infty (fun n:nat => sum_f_R0 An n) -> + Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n) + l. +Proof with trivial. +unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)... +intro; apply tech1... +assert (H4 : forall n:nat, sum_f_R0 An n <> 0)... +intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5; + elim (Rlt_irrefl _ H5)... +assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)... +unfold Rdiv in |- *; apply Rmult_lt_0_compat... +apply Rinv_0_lt_compat; prove_sup... +elim (H _ H6); clear H; intros N1 H; + pose (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1)); + assert + (H7 : + exists N : nat + | (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))... +case (Req_dec C 0); intro... +exists 0%nat; intros... +rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat... +apply Rinv_0_lt_compat; prove_sup... +assert (H8 : 0 < eps / (2 * Rabs C))... +unfold Rdiv in |- *; apply Rmult_lt_0_compat... +apply Rinv_0_lt_compat; apply Rmult_lt_0_compat... +prove_sup... +apply Rabs_pos_lt... +elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10); + unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11; + rewrite Rplus_0_r in H11... +apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))... +apply RRle_abs... +unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)... +apply Rinv_0_lt_compat; apply Rabs_pos_lt... +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... +rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))... +unfold Rdiv in |- *; rewrite Rinv_mult_distr... +ring... +discrR... +apply Rabs_no_R0... +apply Rabs_no_R0... +elim H7; clear H7; intros N2 H7; pose (N := max N1 N2); exists (S N); intros; + unfold R_dist in |- *; + replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with + (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)... +assert (H9 : (N1 < n)%nat)... +apply lt_le_trans with (S N)... +apply le_lt_n_Sm; unfold N in |- *; apply le_max_l... +rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *; + rewrite Rmult_plus_distr_r; + apply Rle_lt_trans with + (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) + + Rabs + (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) + (n - S N1) / sum_f_R0 An n))... +apply Rabs_triang... +rewrite (double_var eps); apply Rplus_lt_compat... +unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right... +apply (H7 n); apply le_trans with (S N)... +apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]... +apply Rle_ge; left; apply Rinv_0_lt_compat... -Unfold R_dist in H; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(sum_f_R0 An n)``). -Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat](Rabsolu ``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)``) (minus n (S N1))) ``/(sum_f_R0 An n)``). -Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony. -Left; Apply Rlt_Rinv. -Apply (sum_Rabsolu [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))). -Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat]``(An (plus (S N1) i))*eps/2`` (minus n (S N1))) ``/(sum_f_R0 An n)``). -Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony. -Left; Apply Rlt_Rinv. -Apply sum_Rle; Intros; Rewrite Rabsolu_mult; Pattern 2 (An (plus (S N1) n0)); Rewrite <- (Rabsolu_right (An (plus (S N1) n0))). -Apply Rle_monotony. -Apply Rabsolu_pos. -Left; Apply H; Unfold ge; Apply le_trans with (S N1); [Apply le_n_Sn | Apply le_plus_l]. -Apply Rle_sym1; Left. -Rewrite <- (scal_sum [i:nat](An (plus (S N1) i)) (minus n (S N1)) ``eps/2``); Unfold Rdiv; Repeat Rewrite Rmult_assoc; Apply Rlt_monotony. -Pattern 2 ``/2``; Rewrite <- Rmult_1r; Apply Rlt_monotony. -Apply Rlt_Rinv; Sup. -Rewrite Rmult_sym; Apply Rlt_monotony_contra with (sum_f_R0 An n). -Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite Rmult_1r; Rewrite (tech2 An N1 n). -Rewrite Rplus_sym; Pattern 1 (sum_f_R0 [i:nat](An (plus (S N1) i)) (minus n (S N1))); Rewrite <- Rplus_Or; Apply Rlt_compatibility. -Apply Rle_sym1; Left; Apply Rlt_Rinv. -Replace (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) with (Rplus (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 [k:nat]``(An k)*-l`` n)). -Rewrite <- (scal_sum An n ``-l``); Field. -Rewrite <- plus_sum; Apply sum_eq; Intros; Ring. +unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult; + rewrite (Rabs_right (/ sum_f_R0 An n))... +apply Rle_lt_trans with + (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))) + (n - S N1) * / sum_f_R0 An n)... +do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... +left; apply Rinv_0_lt_compat... +apply + (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) + (n - S N1))... +apply Rle_lt_trans with + (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) * + / sum_f_R0 An n)... +do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... +left; apply Rinv_0_lt_compat... +apply sum_Rle; intros; rewrite Rabs_mult; + pattern (An (S N1 + n0)%nat) at 2 in |- *; + rewrite <- (Rabs_right (An (S N1 + n0)%nat))... +apply Rmult_le_compat_l... +apply Rabs_pos... +left; apply H; unfold ge in |- *; apply le_trans with (S N1); + [ apply le_n_Sn | apply le_plus_l ]... +apply Rle_ge; left... +rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2)); + unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l... +pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l... +apply Rinv_0_lt_compat; prove_sup... +rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)... +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... +rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)... +rewrite Rplus_comm; + pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *; + rewrite <- Rplus_0_r; apply Rplus_lt_compat_l... +apply Rle_ge; left; apply Rinv_0_lt_compat... +replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with + (sum_f_R0 (fun k:nat => An k * Bn k) n + + sum_f_R0 (fun k:nat => An k * - l) n)... +rewrite <- (scal_sum An n (- l)); field... +rewrite <- plus_sum; apply sum_eq; intros; ring... Qed. -Lemma Cesaro_1 : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv [n:nat]``(sum_f_R0 An (pred n))/(INR n)`` l). -Proof with Trivial. -Intros Bn l H; Pose An := [_:nat]R1. -Assert H0 : (n:nat) ``0<(An n)``. -Intro; Unfold An; Apply Rlt_R0_R1. -Assert H1 : (n:nat)``0<(sum_f_R0 An n)``. -Intro; Apply tech1. -Assert H2 : (cv_infty [n:nat](sum_f_R0 An n)). -Unfold cv_infty; Intro; Case (total_order_Rle M R0); Intro. -Exists O; Intros; Apply Rle_lt_trans with R0. -Assert H2 : ``0<M``. -Auto with real. -Clear n; Pose m := (up M); Elim (archimed M); Intros; Assert H5 : `0<=m`. -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_1l; Apply Rlt_trans with (IZR (up M)). -Apply Rle_lt_trans with (INR x). -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; 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 (Rabsolu (Rminus (Rdiv (sum_f_R0 [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 (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` (pred n)) (sum_f_R0 An (pred n))) l). -Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rplus_plus_r. -Unfold An; Replace (sum_f_R0 [k:nat]``1*(Bn k)`` (pred n)) with (sum_f_R0 Bn (pred n)). -Rewrite sum_cte; Rewrite Rmult_1l; Replace (S (pred n)) with n. -Apply S_pred with O; Apply lt_le_trans with (S x). -Apply lt_O_Sn. -Apply sum_eq; Intros; Ring. -Apply H5; Unfold ge; Apply le_S_n; Replace (S (pred n)) with n. -Apply S_pred with O; Apply lt_le_trans with (S x). -Apply lt_O_Sn. -Qed. +Lemma Cesaro_1 : + forall (An:nat -> R) (l:R), + Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l. +Proof with trivial. +intros Bn l H; pose (An := fun _:nat => 1)... +assert (H0 : forall n:nat, 0 < An n)... +intro; unfold An in |- *; apply Rlt_0_1... +assert (H1 : forall n:nat, 0 < sum_f_R0 An n)... +intro; apply tech1... +assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))... +unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro... +exists 0%nat; intros; apply Rle_lt_trans with 0... +assert (H2 : 0 < M)... +auto with real... +clear n; pose (m := up M); elim (archimed M); intros; + assert (H5 : (0 <= m)%Z)... +apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M... +elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte; + rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))... +apply Rle_lt_trans with (INR x)... +rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right... +apply lt_INR; apply le_lt_n_Sm... +assert (H3 := Cesaro _ _ _ H H0 H2)... +unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros; + exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5; + apply Rle_lt_trans with + (Rabs + (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))... +right; + replace (sum_f_R0 Bn (pred n) / INR n - l) with + (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)... +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); + apply Rplus_eq_compat_l... +unfold An in |- *; + replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with + (sum_f_R0 Bn (pred n))... +rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n... +apply S_pred with 0%nat; apply lt_le_trans with (S x)... +apply lt_O_Sn... +apply sum_eq; intros; ring... +apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n... +apply S_pred with 0%nat; apply lt_le_trans with (S x)... +apply lt_O_Sn... +Qed.
\ No newline at end of file diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v index bc876692d..5ea76696a 100644 --- a/theories/Reals/SplitAbsolu.v +++ b/theories/Reals/SplitAbsolu.v @@ -8,15 +8,18 @@ (*i $Id$ i*) -Require Rbasic_fun. +Require Import Rbasic_fun. -Recursive Tactic Definition SplitAbs := - Match Context With - | [ |- [(case_Rabsolu ?1)] ] -> - Case (case_Rabsolu ?1); Try SplitAbs. +Ltac split_case_Rabs := + match goal with + | |- context [(Rcase_abs ?X1)] => + case (Rcase_abs X1); try split_case_Rabs + end. -Recursive Tactic Definition SplitAbsolu := - Match Context With - | [ id:[(Rabsolu ?)] |- ? ] -> Generalize id; Clear id;Try SplitAbsolu - | [ |- [(Rabsolu ?1)] ] -> Unfold Rabsolu; Try SplitAbs;Intros. +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 + end.
\ No newline at end of file diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v index 71b2ebf21..281745a11 100644 --- a/theories/Reals/SplitRmult.v +++ b/theories/Reals/SplitRmult.v @@ -11,9 +11,10 @@ (*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*) -Require Rbase. - -Recursive Tactic Definition SplitRmult := - Match Context With - | [ |- ~(Rmult ?1 ?2)==R0 ] -> Apply mult_non_zero; Split;Try SplitRmult. +Require Import Rbase. +Ltac split_Rmult := + match goal with + | |- ((?X1 * ?X2)%R <> 0%R) => + apply Rmult_integral_contrapositive; split; try split_Rmult + end. diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v index 35f6d0f32..def3cd0a4 100644 --- a/theories/Reals/Sqrt_reg.v +++ b/theories/Reals/Sqrt_reg.v @@ -8,290 +8,344 @@ (*i $Id$ i*) -Require Rbase. -Require Rfunctions. -Require Ranalysis1. -Require R_sqrt. -V7only [Import R_scope.]. Open Local Scope R_scope. +Require Import Rbase. +Require Import Rfunctions. +Require Import Ranalysis1. +Require Import R_sqrt. Open Local Scope R_scope. (**********) -Lemma sqrt_var_maj : (h:R) ``(Rabsolu h) <= 1`` -> ``(Rabsolu ((sqrt (1+h))-1))<=(Rabsolu h)``. -Intros; Cut ``0<=1+h``. -Intro; Apply Rle_trans with ``(Rabsolu ((sqrt (Rsqr (1+h)))-1))``. -Case (total_order_T h R0); Intro. -Elim s; Intro. -Repeat Rewrite Rabsolu_left. -Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``). -Do 2 Rewrite Ropp_distr1;Rewrite Ropp_Ropp; Apply Rle_compatibility. -Apply Rle_Ropp1; Apply sqrt_le_1. -Apply pos_Rsqr. -Apply H0. -Pattern 2 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony. -Apply H0. -Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption. -Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or. -Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1. -Apply pos_Rsqr. -Left; Apply Rlt_R0_R1. -Pattern 2 R1; Rewrite <- Rsqr_1; Apply Rsqr_incrst_1. -Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption. -Apply H0. -Left; Apply Rlt_R0_R1. -Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or. -Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1. -Apply H0. -Left; Apply Rlt_R0_R1. -Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption. -Rewrite b; Rewrite Rplus_Or; Rewrite Rsqr_1; Rewrite sqrt_1; Right; Reflexivity. -Repeat Rewrite Rabsolu_right. -Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``); Apply Rle_compatibility. -Apply sqrt_le_1. -Apply H0. -Apply pos_Rsqr. -Pattern 1 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony. -Apply H0. -Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption. -Apply Rle_sym1; Apply Rle_anti_compatibility with R1. -Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or. -Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_le_1. -Left; Apply Rlt_R0_R1. -Apply pos_Rsqr. -Pattern 1 R1; Rewrite <- Rsqr_1; Apply Rsqr_incr_1. -Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption. -Left; Apply Rlt_R0_R1. -Apply H0. -Apply Rle_sym1; Left; Apply Rlt_anti_compatibility with R1. -Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or. -Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1. -Left; Apply Rlt_R0_R1. -Apply H0. -Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption. -Rewrite sqrt_Rsqr. -Replace ``(1+h)-1`` with h; [Right; Reflexivity | Ring]. -Apply H0. -Case (total_order_T h R0); Intro. -Elim s; Intro. -Rewrite (Rabsolu_left h a) in H. -Apply Rle_anti_compatibility with ``-h``. -Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Exact H. -Left; Rewrite b; Rewrite Rplus_Or; Apply Rlt_R0_R1. -Left; Apply gt0_plus_gt0_is_gt0. -Apply Rlt_R0_R1. -Apply r. +Lemma sqrt_var_maj : + forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h. +intros; cut (0 <= 1 + h). +intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)). +case (total_order_T h 0); intro. +elim s; intro. +repeat rewrite Rabs_left. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)). +do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive; + apply Rplus_le_compat_l. +apply Ropp_le_contravar; apply sqrt_le_1. +apply Rle_0_sqr. +apply H0. +pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; + apply Rmult_le_compat_l. +apply H0. +pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. +apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r. +pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. +apply Rle_0_sqr. +left; apply Rlt_0_1. +pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1. +pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +apply H0. +left; apply Rlt_0_1. +apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r. +pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. +apply H0. +left; apply Rlt_0_1. +pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right; + reflexivity. +repeat rewrite Rabs_right. +unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)); + apply Rplus_le_compat_l. +apply sqrt_le_1. +apply H0. +apply Rle_0_sqr. +pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; + apply Rmult_le_compat_l. +apply H0. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. +apply Rle_ge; apply Rplus_le_reg_l with 1. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1. +left; apply Rlt_0_1. +apply Rle_0_sqr. +pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. +left; apply Rlt_0_1. +apply H0. +apply Rle_ge; left; apply Rplus_lt_reg_r with 1. +rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. +pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. +left; apply Rlt_0_1. +apply H0. +pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. +rewrite sqrt_Rsqr. +replace (1 + h - 1) with h; [ right; reflexivity | ring ]. +apply H0. +case (total_order_T h 0); intro. +elim s; intro. +rewrite (Rabs_left h a) in H. +apply Rplus_le_reg_l with (- h). +rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H. +left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1. +left; apply Rplus_lt_0_compat. +apply Rlt_0_1. +apply r. Qed. (* sqrt is continuous in 1 *) -Lemma sqrt_continuity_pt_R1 : (continuity_pt sqrt R1). -Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros. -Pose alpha := (Rmin eps R1). -Exists alpha; Intros. -Split. -Unfold alpha; Unfold Rmin; Case (total_order_Rle eps R1); Intro. -Assumption. -Apply Rlt_R0_R1. -Intros; Elim H0; Intros. -Rewrite sqrt_1; Replace x with ``1+(x-1)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu (x-1))``. -Apply sqrt_var_maj. -Apply Rle_trans with alpha. -Left; Apply H2. -Unfold alpha; Apply Rmin_r. -Apply Rlt_le_trans with alpha; [Apply H2 | Unfold alpha; Apply Rmin_l]. +Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +pose (alpha := Rmin eps 1). +exists alpha; intros. +split. +unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro. +assumption. +apply Rlt_0_1. +intros; elim H0; intros. +rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ]; + apply Rle_lt_trans with (Rabs (x - 1)). +apply sqrt_var_maj. +apply Rle_trans with alpha. +left; apply H2. +unfold alpha in |- *; apply Rmin_r. +apply Rlt_le_trans with alpha; + [ apply H2 | unfold alpha in |- *; apply Rmin_l ]. Qed. (* sqrt is continuous forall x>0 *) -Lemma sqrt_continuity_pt : (x:R) ``0<x`` -> (continuity_pt sqrt x). -Intros; Generalize sqrt_continuity_pt_R1. -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. -Elim H3; Intros. -Pose alpha := ``alp_1*x``. -Exists (Rmin alpha x); Intros. -Split. -Change ``0<(Rmin alpha x)``; Unfold Rmin; Case (total_order_Rle alpha x); Intro. -Unfold alpha; Apply Rmult_lt_pos; Assumption. -Apply H. -Intros; Replace x0 with ``x+(x0-x)``; [Idtac | Ring]; Replace ``(sqrt (x+(x0-x)))-(sqrt x)`` with ``(sqrt x)*((sqrt (1+(x0-x)/x))-(sqrt 1))``. -Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (sqrt x)). -Apply Rlt_monotony_contra with ``/(sqrt x)``. -Apply Rlt_Rinv; Apply sqrt_lt_R0; Assumption. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1l; Rewrite Rmult_sym. -Unfold Rdiv in H5. -Case (Req_EM x x0); Intro. -Rewrite H7; Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Or; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0. -Apply Rmult_lt_pos. -Assumption. -Apply Rlt_Rinv; Rewrite <- H7; Apply sqrt_lt_R0; Assumption. -Apply H5. -Split. -Unfold D_x no_cond. -Split. -Trivial. -Red; Intro. -Cut ``(x0-x)*/x==0``. -Intro. -Elim (without_div_Od ? ? H9); Intro. -Elim H7. -Apply (Rminus_eq_right ? ? H10). -Assert H11 := (without_div_Oi1 ? x H10). -Rewrite <- Rinv_l_sym in H11. -Elim R1_neq_R0; Exact H11. -Red; Intro; Rewrite H12 in H; Elim (Rlt_antirefl ? H). -Symmetry; Apply r_Rplus_plus with R1; Rewrite Rplus_Or; Unfold Rdiv in H8; Exact H8. -Unfold Rminus; Rewrite Rplus_sym; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Elim H6; Intros. -Unfold Rdiv; Rewrite Rabsolu_mult. -Rewrite Rabsolu_Rinv. -Rewrite (Rabsolu_right x). -Rewrite Rmult_sym; Apply Rlt_monotony_contra with x. -Apply H. -Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym. -Rewrite Rmult_1l; Rewrite Rmult_sym; Fold alpha. -Apply Rlt_le_trans with (Rmin alpha x). -Apply H9. -Apply Rmin_l. -Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H). -Apply Rle_sym1; Left; Apply H. -Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H). -Assert H7 := (sqrt_lt_R0 x H). -Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7). -Apply Rle_sym1; Apply sqrt_positivity. -Left; Apply H. -Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Ropp_mul3; Repeat Rewrite <- sqrt_times. -Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Reflexivity. -Red; Intro; Rewrite H7 in H; Elim (Rlt_antirefl ? H). -Left; Apply H. -Left; Apply Rlt_R0_R1. -Left; Apply H. -Elim H6; Intros. -Case (case_Rabsolu ``x0-x``); Intro. -Rewrite (Rabsolu_left ``x0-x`` r) in H8. -Rewrite Rplus_sym. -Apply Rle_anti_compatibility with ``-((x0-x)/x)``. -Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Unfold Rdiv; Rewrite <- Ropp_mul1. -Apply Rle_monotony_contra with x. -Apply H. -Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym. -Rewrite Rmult_1r; Left; Apply Rlt_le_trans with (Rmin alpha x). -Apply H8. -Apply Rmin_r. -Red; Intro; Rewrite H9 in H; Elim (Rlt_antirefl ? H). -Apply ge0_plus_ge0_is_ge0. -Left; Apply Rlt_R0_R1. -Unfold Rdiv; Apply Rmult_le_pos. -Apply Rle_sym2; Exact r. -Left; Apply Rlt_Rinv; Apply H. -Unfold Rdiv; Apply Rmult_lt_pos. -Apply H1. -Apply Rlt_Rinv; Apply sqrt_lt_R0; Apply H. +Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x. +intros; generalize sqrt_continuity_pt_R1. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. +cut (0 < eps / sqrt x). +intro; elim (H0 _ H2); intros alp_1 H3. +elim H3; intros. +pose (alpha := alp_1 * x). +exists (Rmin alpha x); intros. +split. +change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *; + case (Rle_dec alpha x); intro. +unfold alpha in |- *; apply Rmult_lt_0_compat; assumption. +apply H. +intros; replace x0 with (x + (x0 - x)); [ idtac | ring ]; + replace (sqrt (x + (x0 - x)) - sqrt x) with + (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)). +rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)). +apply Rmult_lt_reg_l with (/ sqrt x). +apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption. +rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. +rewrite Rmult_1_l; rewrite Rmult_comm. +unfold Rdiv in H5. +case (Req_dec x x0); intro. +rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; + rewrite Rabs_R0. +apply Rmult_lt_0_compat. +assumption. +apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption. +apply H5. +split. +unfold D_x, no_cond in |- *. +split. +trivial. +red in |- *; intro. +cut ((x0 - x) * / x = 0). +intro. +elim (Rmult_integral _ _ H9); intro. +elim H7. +apply (Rminus_diag_uniq_sym _ _ H10). +assert (H11 := Rmult_eq_0_compat_r _ x H10). +rewrite <- Rinv_l_sym in H11. +elim R1_neq_R0; exact H11. +red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H). +symmetry in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r; + unfold Rdiv in H8; exact H8. +unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros. +unfold Rdiv in |- *; rewrite Rabs_mult. +rewrite Rabs_Rinv. +rewrite (Rabs_right x). +rewrite Rmult_comm; apply Rmult_lt_reg_l with x. +apply H. +rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. +rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *. +apply Rlt_le_trans with (Rmin alpha x). +apply H9. +apply Rmin_l. +red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). +apply Rle_ge; left; apply H. +red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). +assert (H7 := sqrt_lt_R0 x H). +red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7). +apply Rle_ge; apply sqrt_positivity. +left; apply H. +unfold Rminus in |- *; rewrite Rmult_plus_distr_l; + rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult. +rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; reflexivity. +red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H). +left; apply H. +left; apply Rlt_0_1. +left; apply H. +elim H6; intros. +case (Rcase_abs (x0 - x)); intro. +rewrite (Rabs_left (x0 - x) r) in H8. +rewrite Rplus_comm. +apply Rplus_le_reg_l with (- ((x0 - x) / x)). +rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. +apply Rmult_le_reg_l with x. +apply H. +rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. +rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x). +apply H8. +apply Rmin_r. +red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H). +apply Rplus_le_le_0_compat. +left; apply Rlt_0_1. +unfold Rdiv in |- *; apply Rmult_le_pos. +apply Rge_le; exact r. +left; apply Rinv_0_lt_compat; apply H. +unfold Rdiv in |- *; apply Rmult_lt_0_compat. +apply H1. +apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H. Qed. (* sqrt is derivable for all x>0 *) -Lemma derivable_pt_lim_sqrt : (x:R) ``0<x`` -> (derivable_pt_lim sqrt x ``/(2*(sqrt x))``). -Intros; Pose g := [h:R]``(sqrt x)+(sqrt (x+h))``. -Cut (continuity_pt g R0). -Intro; Cut ``(g 0)<>0``. -Intro; Assert H2 := (continuity_pt_inv g R0 H0 H1). -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. -Elim H4; Intros. -Pose alpha1 := (Rmin alpha x). -Cut ``0<alpha1``. -Intro; Exists (mkposreal alpha1 H7); Intros. -Replace ``((sqrt (x+h))-(sqrt x))/h`` with ``/((sqrt x)+(sqrt (x+h)))``. -Unfold inv_fct g in H6; Replace ``2*(sqrt x)`` with ``(sqrt x)+(sqrt (x+0))``. -Apply H6. -Split. -Unfold D_x no_cond. -Split. -Trivial. -Apply not_sym; Exact H8. -Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rlt_le_trans with alpha1. -Exact H9. -Unfold alpha1; Apply Rmin_l. -Rewrite Rplus_Or; Ring. -Cut ``0<=x+h``. -Intro; Cut ``0<(sqrt x)+(sqrt (x+h))``. -Intro; Apply r_Rmult_mult with ``((sqrt x)+(sqrt (x+h)))``. -Rewrite <- Rinv_r_sym. -Rewrite Rplus_sym; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rsqr_plus_minus; Repeat Rewrite Rsqr_sqrt. -Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym. -Reflexivity. -Apply H8. -Left; Apply H. -Assumption. -Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11). -Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11). -Apply gt0_plus_ge0_is_gt0. -Apply sqrt_lt_R0; Apply H. -Apply sqrt_positivity; Apply H10. -Case (case_Rabsolu h); Intro. -Rewrite (Rabsolu_left h r) in H9. -Apply Rle_anti_compatibility with ``-h``. -Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Left; Apply Rlt_le_trans with alpha1. -Apply H9. -Unfold alpha1; Apply Rmin_r. -Apply ge0_plus_ge0_is_ge0. -Left; Assumption. -Apply Rle_sym2; Apply r. -Unfold alpha1; Unfold Rmin; Case (total_order_Rle alpha x); Intro. -Apply H5. -Apply H. -Unfold g; Rewrite Rplus_Or. -Cut ``0<(sqrt x)+(sqrt x)``. -Intro; Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1). -Apply gt0_plus_gt0_is_gt0; Apply sqrt_lt_R0; Apply H. -Replace g with (plus_fct (fct_cte (sqrt x)) (comp sqrt (plus_fct (fct_cte x) id))); [Idtac | Reflexivity]. -Apply continuity_pt_plus. -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; Intro; Reflexivity. -Apply derivable_continuous_pt; Apply derivable_pt_id. -Apply sqrt_continuity_pt. -Unfold plus_fct fct_cte id; Rewrite Rplus_Or; Apply H. +Lemma derivable_pt_lim_sqrt : + forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)). +intros; pose (g := fun h:R => sqrt x + sqrt (x + h)). +cut (continuity_pt g 0). +intro; cut (g 0 <> 0). +intro; assert (H2 := continuity_pt_inv g 0 H0 H1). +unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2; + unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. +elim (H2 eps H3); intros alpha H4. +elim H4; intros. +pose (alpha1 := Rmin alpha x). +cut (0 < alpha1). +intro; exists (mkposreal alpha1 H7); intros. +replace ((sqrt (x + h) - sqrt x) / h) with (/ (sqrt x + sqrt (x + h))). +unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)). +apply H6. +split. +unfold D_x, no_cond in |- *. +split. +trivial. +apply (sym_not_eq (A:=R)); exact H8. +unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + apply Rlt_le_trans with alpha1. +exact H9. +unfold alpha1 in |- *; apply Rmin_l. +rewrite Rplus_0_r; ring. +cut (0 <= x + h). +intro; cut (0 < sqrt x + sqrt (x + h)). +intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)). +rewrite <- Rinv_r_sym. +rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt. +rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym. +reflexivity. +apply H8. +left; apply H. +assumption. +red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). +red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). +apply Rplus_lt_le_0_compat. +apply sqrt_lt_R0; apply H. +apply sqrt_positivity; apply H10. +case (Rcase_abs h); intro. +rewrite (Rabs_left h r) in H9. +apply Rplus_le_reg_l with (- h). +rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1. +apply H9. +unfold alpha1 in |- *; apply Rmin_r. +apply Rplus_le_le_0_compat. +left; assumption. +apply Rge_le; apply r. +unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro. +apply H5. +apply H. +unfold g in |- *; rewrite Rplus_0_r. +cut (0 < sqrt x + sqrt x). +intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). +apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H. +replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F; + [ idtac | reflexivity ]. +apply continuity_pt_plus. +apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + reflexivity. +apply continuity_pt_comp. +apply continuity_pt_plus. +apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + reflexivity. +apply derivable_continuous_pt; apply derivable_pt_id. +apply sqrt_continuity_pt. +unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H. Qed. (**********) -Lemma derivable_pt_sqrt : (x:R) ``0<x`` -> (derivable_pt sqrt x). -Unfold derivable_pt; Intros. -Apply Specif.existT with ``/(2*(sqrt x))``. -Apply derivable_pt_lim_sqrt; Assumption. +Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x. +unfold derivable_pt in |- *; intros. +apply existT with (/ (2 * sqrt x)). +apply derivable_pt_lim_sqrt; assumption. Qed. (**********) -Lemma derive_pt_sqrt : (x:R;pr:``0<x``) ``(derive_pt sqrt x (derivable_pt_sqrt ? pr)) == /(2*(sqrt x))``. -Intros. -Apply derive_pt_eq_0. -Apply derivable_pt_lim_sqrt; Assumption. +Lemma derive_pt_sqrt : + forall (x:R) (pr:0 < x), + derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x). +intros. +apply derive_pt_eq_0. +apply derivable_pt_lim_sqrt; assumption. Qed. (* We show that sqrt is continuous for all x>=0 *) (* Remark : by definition of sqrt (as extension of Rsqrt on |R), *) (* we could also show that sqrt is continuous for all x *) -Lemma continuity_pt_sqrt : (x:R) ``0<=x`` -> (continuity_pt sqrt x). -Intros; Case (total_order R0 x); Intro. -Apply (sqrt_continuity_pt x H0). -Elim H0; Intro. -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)``; Apply Rsqr_pos_lt. -Red; Intro; Rewrite H3 in H2; Elim (Rlt_antirefl ? H2). -Intros; Elim H3; Intros. -Rewrite <- H1; Rewrite sqrt_0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite <- H1 in H5; Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5. -Case (case_Rabsolu x0); Intro. -Unfold sqrt; Case (case_Rabsolu x0); Intro. -Rewrite Rabsolu_R0; Apply H2. -Assert H6 := (Rle_sym2 ? ? r0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 r)). -Rewrite Rabsolu_right. -Apply Rsqr_incrst_0. -Rewrite Rsqr_sqrt. -Rewrite (Rabsolu_right x0 r) in H5; Apply H5. -Apply Rle_sym2; Exact r. -Apply sqrt_positivity; Apply Rle_sym2; Exact r. -Left; Exact H2. -Apply Rle_sym1; Apply sqrt_positivity; Apply Rle_sym2; Exact r. -Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H1 H)). -Qed. +Lemma continuity_pt_sqrt : forall x:R, 0 <= x -> continuity_pt sqrt x. +intros; case (Rtotal_order 0 x); intro. +apply (sqrt_continuity_pt x H0). +elim H0; intro. +unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. +exists (Rsqr eps); intros. +split. +change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt. +red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2). +intros; elim H3; intros. +rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5; + rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5. +case (Rcase_abs x0); intro. +unfold sqrt in |- *; case (Rcase_abs x0); intro. +rewrite Rabs_R0; apply H2. +assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)). +rewrite Rabs_right. +apply Rsqr_incrst_0. +rewrite Rsqr_sqrt. +rewrite (Rabs_right x0 r) in H5; apply H5. +apply Rge_le; exact r. +apply sqrt_positivity; apply Rge_le; exact r. +left; exact H2. +apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r. +elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)). +Qed.
\ No newline at end of file diff --git a/theories/Relations/Newman.v b/theories/Relations/Newman.v index 57e93240a..7de49f62f 100755 --- a/theories/Relations/Newman.v +++ b/theories/Relations/Newman.v @@ -8,108 +8,116 @@ (*i $Id$ i*) -Require Rstar. +Require Import Rstar. Section Newman. -Variable A: Type. -Variable R: A->A->Prop. +Variable A : Type. +Variable R : A -> A -> Prop. -Local Rstar := (Rstar A R). -Local Rstar_reflexive := (Rstar_reflexive A R). -Local Rstar_transitive := (Rstar_transitive A R). -Local Rstar_Rstar' := (Rstar_Rstar' A R). +Let Rstar := Rstar A R. +Let Rstar_reflexive := Rstar_reflexive A R. +Let Rstar_transitive := Rstar_transitive A R. +Let Rstar_Rstar' := Rstar_Rstar' A R. -Definition coherence := [x:A][y:A] (exT2 ? (Rstar x) (Rstar y)). +Definition coherence (x y:A) := ex2 (Rstar x) (Rstar y). -Theorem coherence_intro : (x:A)(y:A)(z:A)(Rstar x z)->(Rstar y z)->(coherence x y). -Proof [x:A][y:A][z:A][h1:(Rstar x z)][h2:(Rstar y z)] - (exT_intro2 A (Rstar x) (Rstar y) z h1 h2). +Theorem coherence_intro : + forall x y z:A, Rstar x z -> Rstar y z -> coherence x y. +Proof + fun (x y z:A) (h1:Rstar x z) (h2:Rstar y z) => + ex_intro2 (Rstar x) (Rstar y) z h1 h2. (** A very simple case of coherence : *) -Lemma Rstar_coherence : (x:A)(y:A)(Rstar x y)->(coherence x y). - Proof [x:A][y:A][h:(Rstar x y)](coherence_intro x y y h (Rstar_reflexive y)). +Lemma Rstar_coherence : forall x y:A, Rstar x y -> coherence x y. + Proof + fun (x y:A) (h:Rstar x y) => coherence_intro x y y h (Rstar_reflexive y). (** coherence is symmetric *) -Lemma coherence_sym: (x:A)(y:A)(coherence x y)->(coherence y x). - Proof [x:A][y:A][h:(coherence x y)] - (exT2_ind A (Rstar x) (Rstar y) (coherence y x) - [w:A][h1:(Rstar x w)][h2:(Rstar y w)] - (coherence_intro y x w h2 h1) h). - -Definition confluence := - [x:A](y:A)(z:A)(Rstar x y)->(Rstar x z)->(coherence y z). +Lemma coherence_sym : forall x y:A, coherence x y -> coherence y x. + Proof + fun (x y:A) (h:coherence x y) => + ex2_ind + (fun (w:A) (h1:Rstar x w) (h2:Rstar y w) => + coherence_intro y x w h2 h1) h. + +Definition confluence (x:A) := + forall y z:A, Rstar x y -> Rstar x z -> coherence y z. -Definition local_confluence := - [x:A](y:A)(z:A)(R x y)->(R x z)->(coherence y z). +Definition local_confluence (x:A) := + forall y z:A, R x y -> R x z -> coherence y z. Definition noetherian := - (x:A)(P:A->Prop)((y:A)((z:A)(R y z)->(P z))->(P y))->(P x). + forall (x:A) (P:A -> Prop), + (forall y:A, (forall z:A, R y z -> P z) -> P y) -> P x. Section Newman_section. (** The general hypotheses of the theorem *) -Hypothesis Hyp1:noetherian. -Hypothesis Hyp2:(x:A)(local_confluence x). +Hypothesis Hyp1 : noetherian. +Hypothesis Hyp2 : forall x:A, local_confluence x. (** The induction hypothesis *) Section Induct. - Variable x:A. - Hypothesis hyp_ind:(u:A)(R x u)->(confluence u). + Variable x : A. + Hypothesis hyp_ind : forall u:A, R x u -> confluence u. (** Confluence in [x] *) - Variables y,z:A. - Hypothesis h1:(Rstar x y). - Hypothesis h2:(Rstar x z). + Variables y z : A. + Hypothesis h1 : Rstar x y. + Hypothesis h2 : Rstar x z. (** particular case [x->u] and [u->*y] *) Section Newman_. - Variable u:A. - Hypothesis t1:(R x u). - Hypothesis t2:(Rstar u y). + Variable u : A. + Hypothesis t1 : R x u. + Hypothesis t2 : Rstar u y. (** In the usual diagram, we assume also [x->v] and [v->*z] *) -Theorem Diagram : (v:A)(u1:(R x v))(u2:(Rstar v z))(coherence y z). - -Proof (* We draw the diagram ! *) - [v:A][u1:(R x v)][u2:(Rstar v z)] - (exT2_ind A (Rstar u) (Rstar v) (* local confluence in x for u,v *) - (coherence y z) (* gives w, u->*w and v->*w *) - ([w:A][s1:(Rstar u w)][s2:(Rstar v w)] - (exT2_ind A (Rstar y) (Rstar w) (* confluence in u => coherence(y,w) *) - (coherence y z) (* gives a, y->*a and z->*a *) - ([a:A][v1:(Rstar y a)][v2:(Rstar w a)] - (exT2_ind A (Rstar a) (Rstar z) (* confluence in v => coherence(a,z) *) - (coherence y z) (* gives b, a->*b and z->*b *) - ([b:A][w1:(Rstar a b)][w2:(Rstar z b)] - (coherence_intro y z b (Rstar_transitive y a b v1 w1) w2)) - (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2))) - (hyp_ind u t1 y w t2 s1))) - (Hyp2 x u v t1 u1)). +Theorem Diagram : forall (v:A) (u1:R x v) (u2:Rstar v z), coherence y z. + +Proof + (* We draw the diagram ! *) + fun (v:A) (u1:R x v) (u2:Rstar v z) => + ex2_ind + (* local confluence in x for u,v *) + (* gives w, u->*w and v->*w *) + (fun (w:A) (s1:Rstar u w) (s2:Rstar v w) => + ex2_ind + (* confluence in u => coherence(y,w) *) + (* gives a, y->*a and z->*a *) + (fun (a:A) (v1:Rstar y a) (v2:Rstar w a) => + ex2_ind + (* confluence in v => coherence(a,z) *) + (* gives b, a->*b and z->*b *) + (fun (b:A) (w1:Rstar a b) (w2:Rstar z b) => + coherence_intro y z b (Rstar_transitive y a b v1 w1) w2) + (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2)) + (hyp_ind u t1 y w t2 s1)) (Hyp2 x u v t1 u1). -Theorem caseRxy : (coherence y z). -Proof (Rstar_Rstar' x z h2 - ([v:A][w:A](coherence y w)) - (coherence_sym x y (Rstar_coherence x y h1)) (*i case x=z i*) - Diagram). (*i case x->v->*z i*) +Theorem caseRxy : coherence y z. +Proof + Rstar_Rstar' x z h2 (fun v w:A => coherence y w) + (coherence_sym x y (Rstar_coherence x y h1)) (*i case x=z i*) + Diagram. (*i case x->v->*z i*) End Newman_. -Theorem Ind_proof : (coherence y z). -Proof (Rstar_Rstar' x y h1 ([u:A][v:A](coherence v z)) - (Rstar_coherence x z h2) (*i case x=y i*) - caseRxy). (*i case x->u->*z i*) +Theorem Ind_proof : coherence y z. +Proof + Rstar_Rstar' x y h1 (fun u v:A => coherence v z) + (Rstar_coherence x z h2) (*i case x=y i*) + caseRxy. (*i case x->u->*z i*) End Induct. -Theorem Newman : (x:A)(confluence x). -Proof [x:A](Hyp1 x confluence Ind_proof). +Theorem Newman : forall x:A, confluence x. +Proof fun x:A => Hyp1 x confluence Ind_proof. End Newman_section. End Newman. - diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v index 0ca819b84..9534f707f 100755 --- a/theories/Relations/Operators_Properties.v +++ b/theories/Relations/Operators_Properties.v @@ -12,55 +12,53 @@ (* Bruno Barras *) (****************************************************************************) -Require Relation_Definitions. -Require Relation_Operators. +Require Import Relation_Definitions. +Require Import Relation_Operators. Section Properties. - Variable A: Set. - Variable R: (relation A). + Variable A : Set. + Variable R : relation A. - Local incl : (relation A)->(relation A)->Prop := - [R1,R2: (relation A)] (x,y:A) (R1 x y) -> (R2 x y). + Let incl (R1 R2:relation A) : Prop := forall x y:A, R1 x y -> R2 x y. Section Clos_Refl_Trans. - Lemma clos_rt_is_preorder: (preorder A (clos_refl_trans A R)). -Apply Build_preorder. -Exact (rt_refl A R). + Lemma clos_rt_is_preorder : preorder A (clos_refl_trans A R). +apply Build_preorder. +exact (rt_refl A R). -Exact (rt_trans A R). +exact (rt_trans A R). Qed. -Lemma clos_rt_idempotent: - (incl (clos_refl_trans A (clos_refl_trans A R)) - (clos_refl_trans A R)). -Red. -NewInduction 1; Auto with sets. -Intros. -Apply rt_trans with y; Auto with sets. +Lemma clos_rt_idempotent : + incl (clos_refl_trans A (clos_refl_trans A R)) (clos_refl_trans A R). +red in |- *. +induction 1; auto with sets. +intros. +apply rt_trans with y; auto with sets. Qed. - Lemma clos_refl_trans_ind_left: (A:Set)(R:A->A->Prop)(M:A)(P:A->Prop) - (P M) - ->((P0,N:A) - (clos_refl_trans A R M P0)->(P P0)->(R P0 N)->(P N)) - ->(a:A)(clos_refl_trans A R M a)->(P a). -Intros. -Generalize H H0 . -Clear H H0. -Elim H1; Intros; Auto with sets. -Apply H2 with x; Auto with sets. - -Apply H3. -Apply H0; Auto with sets. - -Intros. -Apply H5 with P0; Auto with sets. -Apply rt_trans with y; Auto with sets. + Lemma clos_refl_trans_ind_left : + forall (A:Set) (R:A -> A -> Prop) (M:A) (P:A -> Prop), + P M -> + (forall P0 N:A, clos_refl_trans A R M P0 -> P P0 -> R P0 N -> P N) -> + forall a:A, clos_refl_trans A R M a -> P a. +intros. +generalize H H0. +clear H H0. +elim H1; intros; auto with sets. +apply H2 with x; auto with sets. + +apply H3. +apply H0; auto with sets. + +intros. +apply H5 with P0; auto with sets. +apply rt_trans with y; auto with sets. Qed. @@ -69,30 +67,30 @@ End Clos_Refl_Trans. Section Clos_Refl_Sym_Trans. - Lemma clos_rt_clos_rst: (inclusion A (clos_refl_trans A R) - (clos_refl_sym_trans A R)). -Red. -NewInduction 1; Auto with sets. -Apply rst_trans with y; Auto with sets. + Lemma clos_rt_clos_rst : + inclusion A (clos_refl_trans A R) (clos_refl_sym_trans A R). +red in |- *. +induction 1; auto with sets. +apply rst_trans with y; auto with sets. Qed. - Lemma clos_rst_is_equiv: (equivalence A (clos_refl_sym_trans A R)). -Apply Build_equivalence. -Exact (rst_refl A R). + Lemma clos_rst_is_equiv : equivalence A (clos_refl_sym_trans A R). +apply Build_equivalence. +exact (rst_refl A R). -Exact (rst_trans A R). +exact (rst_trans A R). -Exact (rst_sym A R). +exact (rst_sym A R). Qed. - Lemma clos_rst_idempotent: - (incl (clos_refl_sym_trans A (clos_refl_sym_trans A R)) - (clos_refl_sym_trans A R)). -Red. -NewInduction 1; Auto with sets. -Apply rst_trans with y; Auto with sets. + Lemma clos_rst_idempotent : + incl (clos_refl_sym_trans A (clos_refl_sym_trans A R)) + (clos_refl_sym_trans A R). +red in |- *. +induction 1; auto with sets. +apply rst_trans with y; auto with sets. Qed. End Clos_Refl_Sym_Trans. -End Properties. +End Properties.
\ No newline at end of file diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v index 32f433d07..06440fd86 100755 --- a/theories/Relations/Relation_Definitions.v +++ b/theories/Relations/Relation_Definitions.v @@ -10,19 +10,19 @@ Section Relation_Definition. - Variable A: Type. + Variable A : Type. - Definition relation := A -> A -> Prop. + Definition relation := A -> A -> Prop. - Variable R: relation. + Variable R : relation. Section General_Properties_of_Relations. - Definition reflexive : Prop := (x: A) (R x x). - Definition transitive : Prop := (x,y,z: A) (R x y) -> (R y z) -> (R x z). - Definition symmetric : Prop := (x,y: A) (R x y) -> (R y x). - Definition antisymmetric : Prop := (x,y: A) (R x y) -> (R y x) -> x=y. + Definition reflexive : Prop := forall x:A, R x x. + Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z. + Definition symmetric : Prop := forall x y:A, R x y -> R y x. + Definition antisymmetric : Prop := forall x y:A, R x y -> R y x -> x = y. (* for compatibility with Equivalence in ../PROGRAMS/ALG/ *) Definition equiv := reflexive /\ transitive /\ symmetric. @@ -33,23 +33,20 @@ End General_Properties_of_Relations. Section Sets_of_Relations. - Record preorder : Prop := { - preord_refl : reflexive; - preord_trans : transitive }. + Record preorder : Prop := + {preord_refl : reflexive; preord_trans : transitive}. - Record order : Prop := { - ord_refl : reflexive; - ord_trans : transitive; - ord_antisym : antisymmetric }. + Record order : Prop := + {ord_refl : reflexive; + ord_trans : transitive; + ord_antisym : antisymmetric}. - Record equivalence : Prop := { - equiv_refl : reflexive; - equiv_trans : transitive; - equiv_sym : symmetric }. + Record equivalence : Prop := + {equiv_refl : reflexive; + equiv_trans : transitive; + equiv_sym : symmetric}. - Record PER : Prop := { - per_sym : symmetric; - per_trans : transitive }. + Record PER : Prop := {per_sym : symmetric; per_trans : transitive}. End Sets_of_Relations. @@ -57,27 +54,25 @@ End Sets_of_Relations. Section Relations_of_Relations. - Definition inclusion : relation -> relation -> Prop := - [R1,R2: relation] (x,y:A) (R1 x y) -> (R2 x y). + Definition inclusion (R1 R2:relation) : Prop := + forall x y:A, R1 x y -> R2 x y. - Definition same_relation : relation -> relation -> Prop := - [R1,R2: relation] (inclusion R1 R2) /\ (inclusion R2 R1). + Definition same_relation (R1 R2:relation) : Prop := + inclusion R1 R2 /\ inclusion R2 R1. - Definition commut : relation -> relation -> Prop := - [R1,R2:relation] (x,y:A) (R1 y x) -> (z:A) (R2 z y) - -> (EX y':A |(R2 y' x) & (R1 z y')). + Definition commut (R1 R2:relation) : Prop := + forall x y:A, + R1 y x -> forall z:A, R2 z y -> exists2 y' : A | R2 y' x & R1 z y'. End Relations_of_Relations. End Relation_Definition. -Hints Unfold reflexive transitive antisymmetric symmetric : sets v62. +Hint Unfold reflexive transitive antisymmetric symmetric: sets v62. -Hints Resolve Build_preorder Build_order Build_equivalence - Build_PER preord_refl preord_trans - ord_refl ord_trans ord_antisym - equiv_refl equiv_trans equiv_sym - per_sym per_trans : sets v62. +Hint Resolve Build_preorder Build_order Build_equivalence Build_PER + preord_refl preord_trans ord_refl ord_trans ord_antisym equiv_refl + equiv_trans equiv_sym per_sym per_trans: sets v62. -Hints Unfold inclusion same_relation commut : sets v62. +Hint Unfold inclusion same_relation commut: sets v62.
\ No newline at end of file diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v index 7b07ac0db..0d5f2fd97 100755 --- a/theories/Relations/Relation_Operators.v +++ b/theories/Relations/Relation_Operators.v @@ -16,72 +16,76 @@ (* L. Paulson JSC (1986) 2, 325-355 *) (****************************************************************************) -Require Relation_Definitions. -Require PolyList. -Require PolyListSyntax. +Require Import Relation_Definitions. +Require Import List. (** Some operators to build relations *) Section Transitive_Closure. - Variable A: Set. - Variable R: (relation A). + Variable A : Set. + Variable R : relation A. - Inductive clos_trans : A->A->Prop := - t_step: (x,y:A)(R x y)->(clos_trans x y) - | t_trans: (x,y,z:A)(clos_trans x y)->(clos_trans y z)->(clos_trans x z). + Inductive clos_trans : A -> A -> Prop := + | t_step : forall x y:A, R x y -> clos_trans x y + | t_trans : + forall x y z:A, clos_trans x y -> clos_trans y z -> clos_trans x z. End Transitive_Closure. Section Reflexive_Transitive_Closure. - Variable A: Set. - Variable R: (relation A). - - Inductive clos_refl_trans: (relation A) := - rt_step: (x,y:A)(R x y)->(clos_refl_trans x y) - | rt_refl: (x:A)(clos_refl_trans x x) - | rt_trans: (x,y,z: A)(clos_refl_trans x y)->(clos_refl_trans y z) - ->(clos_refl_trans x z). + Variable A : Set. + Variable R : relation A. + + Inductive clos_refl_trans : relation A := + | rt_step : forall x y:A, R x y -> clos_refl_trans x y + | rt_refl : forall x:A, clos_refl_trans x x + | rt_trans : + forall x y z:A, + clos_refl_trans x y -> clos_refl_trans y z -> clos_refl_trans x z. End Reflexive_Transitive_Closure. Section Reflexive_Symetric_Transitive_Closure. - Variable A: Set. - Variable R: (relation A). - - Inductive clos_refl_sym_trans: (relation A) := - rst_step: (x,y:A)(R x y)->(clos_refl_sym_trans x y) - | rst_refl: (x:A)(clos_refl_sym_trans x x) - | rst_sym: (x,y:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y x) - | rst_trans: (x,y,z:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y z) - ->(clos_refl_sym_trans x z). + Variable A : Set. + Variable R : relation A. + + Inductive clos_refl_sym_trans : relation A := + | rst_step : forall x y:A, R x y -> clos_refl_sym_trans x y + | rst_refl : forall x:A, clos_refl_sym_trans x x + | rst_sym : + forall x y:A, clos_refl_sym_trans x y -> clos_refl_sym_trans y x + | rst_trans : + forall x y z:A, + clos_refl_sym_trans x y -> + clos_refl_sym_trans y z -> clos_refl_sym_trans x z. End Reflexive_Symetric_Transitive_Closure. Section Transposee. - Variable A: Set. - Variable R: (relation A). + Variable A : Set. + Variable R : relation A. - Definition transp := [x,y:A](R y x). + Definition transp (x y:A) := R y x. End Transposee. Section Union. - Variable A: Set. - Variable R1,R2: (relation A). + Variable A : Set. + Variables R1 R2 : relation A. - Definition union := [x,y:A](R1 x y)\/(R2 x y). + Definition union (x y:A) := R1 x y \/ R2 x y. End Union. Section Disjoint_Union. -Variable A,B:Set. -Variable leA: A->A->Prop. -Variable leB: B->B->Prop. +Variables A B : Set. +Variable leA : A -> A -> Prop. +Variable leB : B -> B -> Prop. -Inductive le_AsB : A+B->A+B->Prop := - le_aa: (x,y:A) (leA x y) -> (le_AsB (inl A B x) (inl A B y)) -| le_ab: (x:A)(y:B) (le_AsB (inl A B x) (inr A B y)) -| le_bb: (x,y:B) (leB x y) -> (le_AsB (inr A B x) (inr A B y)). +Inductive le_AsB : A + B -> A + B -> Prop := + | le_aa : forall x y:A, leA x y -> le_AsB (inl B x) (inl B y) + | le_ab : forall (x:A) (y:B), le_AsB (inl B x) (inr A y) + | le_bb : forall x y:B, leB x y -> le_AsB (inr A x) (inr A y). End Disjoint_Union. @@ -90,68 +94,74 @@ End Disjoint_Union. Section Lexicographic_Product. (* Lexicographic order on dependent pairs *) -Variable A:Set. -Variable B:A->Set. -Variable leA: A->A->Prop. -Variable leB: (x:A)(B x)->(B x)->Prop. - -Inductive lexprod : (sigS A B) -> (sigS A B) ->Prop := - left_lex : (x,x':A)(y:(B x)) (y':(B x')) - (leA x x') ->(lexprod (existS A B x y) (existS A B x' y')) -| right_lex : (x:A) (y,y':(B x)) - (leB x y y') -> (lexprod (existS A B x y) (existS A B x y')). +Variable A : Set. +Variable B : A -> Set. +Variable leA : A -> A -> Prop. +Variable leB : forall x:A, B x -> B x -> Prop. + +Inductive lexprod : sigS B -> sigS B -> Prop := + | left_lex : + forall (x x':A) (y:B x) (y':B x'), + leA x x' -> lexprod (existS B x y) (existS 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'). End Lexicographic_Product. Section Symmetric_Product. - Variable A:Set. - Variable B:Set. - Variable leA: A->A->Prop. - Variable leB: B->B->Prop. + Variable A : Set. + Variable B : Set. + Variable leA : A -> A -> Prop. + Variable leB : B -> B -> Prop. - Inductive symprod : (A*B) -> (A*B) ->Prop := - left_sym : (x,x':A)(leA x x')->(y:B)(symprod (x,y) (x',y)) - | right_sym : (y,y':B)(leB y y')->(x:A)(symprod (x,y) (x,y')). + Inductive symprod : A * B -> A * B -> Prop := + | left_sym : + forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y) + | right_sym : + forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y'). End Symmetric_Product. Section Swap. - Variable A:Set. - Variable R:A->A->Prop. - - Inductive swapprod: (A*A)->(A*A)->Prop := - sp_noswap: (x,x':A*A)(symprod A A R R x x')->(swapprod x x') - | sp_swap: (x,y:A)(p:A*A)(symprod A A R R (x,y) p)->(swapprod (y,x) p). + Variable A : Set. + Variable R : A -> A -> Prop. + + Inductive swapprod : A * A -> A * A -> Prop := + | sp_noswap : forall x x':A * A, symprod A A R R x x' -> swapprod x x' + | sp_swap : + forall (x y:A) (p:A * A), + symprod A A R R (x, y) p -> swapprod (y, x) p. End Swap. Section Lexicographic_Exponentiation. Variable A : Set. -Variable leA : A->A->Prop. -Local Nil := (nil A). -Local List := (list A). +Variable leA : A -> A -> Prop. +Let Nil := nil (A:=A). +Let List := list A. -Inductive Ltl : List->List->Prop := - Lt_nil: (a:A)(x:List)(Ltl Nil (cons a x)) -| Lt_hd : (a,b:A) (leA a b)-> (x,y:(list A))(Ltl (cons a x) (cons b y)) -| Lt_tl : (a:A)(x,y:List)(Ltl x y) -> (Ltl (cons a x) (cons a y)). +Inductive Ltl : List -> List -> Prop := + | Lt_nil : forall (a:A) (x:List), Ltl Nil (a :: x) + | Lt_hd : forall a b:A, leA a b -> forall x y:list A, Ltl (a :: x) (b :: y) + | Lt_tl : forall (a:A) (x y:List), Ltl x y -> Ltl (a :: x) (a :: y). -Inductive Desc : List->Prop := - d_nil : (Desc Nil) -| d_one : (x:A)(Desc (cons x Nil)) -| d_conc : (x,y:A)(l:List)(leA x y) - -> (Desc l^(cons y Nil))->(Desc (l^(cons y Nil))^(cons x Nil)). +Inductive Desc : List -> Prop := + | d_nil : Desc Nil + | d_one : forall x:A, Desc (x :: Nil) + | d_conc : + forall (x y:A) (l:List), + leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil). -Definition Pow :Set := (sig List Desc). +Definition Pow : Set := sig Desc. -Definition lex_exp : Pow -> Pow ->Prop := - [a,b:Pow](Ltl (proj1_sig List Desc a) (proj1_sig List Desc b)). +Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b). End Lexicographic_Exponentiation. -Hints Unfold transp union : sets v62. -Hints Resolve t_step rt_step rt_refl rst_step rst_refl : sets v62. -Hints Immediate rst_sym : sets v62. +Hint Unfold transp union: sets v62. +Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets v62. +Hint Immediate rst_sym: sets v62.
\ No newline at end of file diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v index f792e4c2a..d2c3e2776 100755 --- a/theories/Relations/Relations.v +++ b/theories/Relations/Relations.v @@ -12,17 +12,17 @@ Require Export Relation_Definitions. Require Export Relation_Operators. Require Export Operators_Properties. -Lemma inverse_image_of_equivalence : (A,B:Set)(f:A->B) - (r:(relation B))(equivalence B r)->(equivalence A [x,y:A](r (f x) (f y))). -Intros; Split; Elim H; Red; Auto. -Intros _ equiv_trans _ x y z H0 H1; Apply equiv_trans with (f y); Assumption. +Lemma inverse_image_of_equivalence : + forall (A B:Set) (f:A -> B) (r:relation B), + equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)). +intros; split; elim H; red in |- *; auto. +intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption. Qed. -Lemma inverse_image_of_eq : (A,B:Set)(f:A->B) - (equivalence A [x,y:A](f x)=(f y)). -Split; Red; -[ (* reflexivity *) Reflexivity -| (* transitivity *) Intros; Transitivity (f y); Assumption -| (* symmetry *) Intros; Symmetry; Assumption -]. -Qed. +Lemma inverse_image_of_eq : + forall (A B:Set) (f:A -> B), equivalence A (fun x y:A => f x = f y). +split; red in |- *; + [ (* reflexivity *) reflexivity + | (* transitivity *) intros; transitivity (f y); assumption + | (* symmetry *) intros; symmetry in |- *; assumption ]. +Qed.
\ No newline at end of file diff --git a/theories/Relations/Rstar.v b/theories/Relations/Rstar.v index 90ab6d6c2..349650629 100755 --- a/theories/Relations/Rstar.v +++ b/theories/Relations/Rstar.v @@ -13,66 +13,75 @@ Section Rstar. Variable A : Type. -Variable R : A->A->Prop. +Variable R : A -> A -> Prop. (** Definition of the reflexive-transitive closure [R*] of [R] *) (** Smallest reflexive [P] containing [R o P] *) -Definition Rstar := [x,y:A](P:A->A->Prop) - ((u:A)(P u u))->((u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)) -> (P x y). +Definition Rstar (x y:A) := + forall P:A -> A -> Prop, + (forall u:A, P u u) -> (forall u v w:A, R u v -> P v w -> P u w) -> P x y. -Theorem Rstar_reflexive: (x:A)(Rstar x x). - Proof [x:A][P:A->A->Prop] - [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)] - (h1 x). +Theorem Rstar_reflexive : forall x:A, Rstar x x. + Proof + fun (x:A) (P:A -> A -> Prop) (h1:forall u:A, P u u) + (h2:forall u v w:A, R u v -> P v w -> P u w) => + h1 x. -Theorem Rstar_R: (x:A)(y:A)(z:A)(R x y)->(Rstar y z)->(Rstar x z). - Proof [x:A][y:A][z:A][t1:(R x y)][t2:(Rstar y z)] - [P:A->A->Prop] - [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)] - (h2 x y z t1 (t2 P h1 h2)). +Theorem Rstar_R : forall x y z:A, R x y -> Rstar y z -> Rstar x z. + Proof + fun (x y z:A) (t1:R x y) (t2:Rstar y z) (P:A -> A -> Prop) + (h1:forall u:A, P u u) (h2:forall u v w:A, R u v -> P v w -> P u w) => + h2 x y z t1 (t2 P h1 h2). (** We conclude with transitivity of [Rstar] : *) -Theorem Rstar_transitive: (x:A)(y:A)(z:A)(Rstar x y)->(Rstar y z)->(Rstar x z). - Proof [x:A][y:A][z:A][h:(Rstar x y)] - (h ([u:A][v:A](Rstar v z)->(Rstar u z)) - ([u:A][t:(Rstar u z)]t) - ([u:A][v:A][w:A][t1:(R u v)][t2:(Rstar w z)->(Rstar v z)] - [t3:(Rstar w z)](Rstar_R u v z t1 (t2 t3)))). +Theorem Rstar_transitive : + forall x y z:A, Rstar x y -> Rstar y z -> Rstar x z. + Proof + fun (x y z:A) (h:Rstar x y) => + h (fun u v:A => Rstar v z -> Rstar u z) (fun (u:A) (t:Rstar u z) => t) + (fun (u v w:A) (t1:R u v) (t2:Rstar w z -> Rstar v z) + (t3:Rstar w z) => Rstar_R u v z t1 (t2 t3)). (** Another characterization of [R*] *) (** Smallest reflexive [P] containing [R o R*] *) -Definition Rstar' := [x:A][y:A](P:A->A->Prop) - ((P x x))->((u:A)(R x u)->(Rstar u y)->(P x y)) -> (P x y). +Definition Rstar' (x y:A) := + forall P:A -> A -> Prop, + P x x -> (forall u:A, R x u -> Rstar u y -> P x y) -> P x y. -Theorem Rstar'_reflexive: (x:A)(Rstar' x x). - Proof [x:A][P:A->A->Prop][h:(P x x)][h':(u:A)(R x u)->(Rstar u x)->(P x x)]h. +Theorem Rstar'_reflexive : forall x:A, Rstar' x x. + Proof + fun (x:A) (P:A -> A -> Prop) (h:P x x) + (h':forall u:A, R x u -> Rstar u x -> P x x) => h. -Theorem Rstar'_R: (x:A)(y:A)(z:A)(R x z)->(Rstar z y)->(Rstar' x y). - Proof [x:A][y:A][z:A][t1:(R x z)][t2:(Rstar z y)] - [P:A->A->Prop][h1:(P x x)] - [h2:(u:A)(R x u)->(Rstar u y)->(P x y)](h2 z t1 t2). +Theorem Rstar'_R : forall x y z:A, R x z -> Rstar z y -> Rstar' x y. + Proof + fun (x y z:A) (t1:R x z) (t2:Rstar z y) (P:A -> A -> Prop) + (h1:P x x) (h2:forall u:A, R x u -> Rstar u y -> P x y) => + h2 z t1 t2. (** Equivalence of the two definitions: *) -Theorem Rstar'_Rstar: (x:A)(y:A)(Rstar' x y)->(Rstar x y). - Proof [x:A][y:A][h:(Rstar' x y)] - (h Rstar (Rstar_reflexive x) ([u:A](Rstar_R x u y))). +Theorem Rstar'_Rstar : forall x y:A, Rstar' x y -> Rstar x y. + Proof + fun (x y:A) (h:Rstar' x y) => + h Rstar (Rstar_reflexive x) (fun u:A => Rstar_R x u y). -Theorem Rstar_Rstar': (x:A)(y:A)(Rstar x y)->(Rstar' x y). - Proof [x:A][y:A][h:(Rstar x y)](h Rstar' ([u:A](Rstar'_reflexive u)) - ([u:A][v:A][w:A][h1:(R u v)][h2:(Rstar' v w)] - (Rstar'_R u w v h1 (Rstar'_Rstar v w h2)))). +Theorem Rstar_Rstar' : forall x y:A, Rstar x y -> Rstar' x y. + Proof + fun (x y:A) (h:Rstar x y) => + h Rstar' (fun u:A => Rstar'_reflexive u) + (fun (u v w:A) (h1:R u v) (h2:Rstar' v w) => + Rstar'_R u w v h1 (Rstar'_Rstar v w h2)). (** Property of Commutativity of two relations *) -Definition commut := [A:Set][R1,R2:A->A->Prop] - (x,y:A)(R1 y x)->(z:A)(R2 z y) - ->(EX y':A |(R2 y' x) & (R1 z y')). +Definition commut (A:Set) (R1 R2:A -> A -> Prop) := + forall x y:A, + R1 y x -> forall z:A, R2 z y -> exists2 y' : A | R2 y' x & R1 z y'. End Rstar. - diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index 8a5a9892a..0051c4e00 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -13,61 +13,59 @@ Section Setoid. Variable A : Type. Variable Aeq : A -> A -> Prop. -Record Setoid_Theory : Prop := -{ Seq_refl : (x:A) (Aeq x x); - Seq_sym : (x,y:A) (Aeq x y) -> (Aeq y x); - Seq_trans : (x,y,z:A) (Aeq x y) -> (Aeq y z) -> (Aeq x z) -}. +Record Setoid_Theory : Prop := + {Seq_refl : forall x:A, Aeq x x; + Seq_sym : forall x y:A, Aeq x y -> Aeq y x; + Seq_trans : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z}. End Setoid. -Definition Prop_S : (Setoid_Theory Prop iff). -Split; [Exact iff_refl | Exact iff_sym | Exact iff_trans]. +Definition Prop_S : Setoid_Theory Prop iff. +split; [ exact iff_refl | exact iff_sym | exact iff_trans ]. Qed. Add Setoid Prop iff Prop_S. -Hint prop_set : setoid := Resolve (Seq_refl Prop iff Prop_S). -Hint prop_set : setoid := Resolve (Seq_sym Prop iff Prop_S). -Hint prop_set : setoid := Resolve (Seq_trans Prop iff Prop_S). +Hint Resolve (Seq_refl Prop iff Prop_S): setoid. +Hint Resolve (Seq_sym Prop iff Prop_S): setoid. +Hint Resolve (Seq_trans Prop iff Prop_S): setoid. Add Morphism or : or_ext. -Intros. -Inversion H1. -Left. -Inversion H. -Apply (H3 H2). - -Right. -Inversion H0. -Apply (H3 H2). +intros. +inversion H1. +left. +inversion H. +apply (H3 H2). + +right. +inversion H0. +apply (H3 H2). Qed. Add Morphism and : and_ext. -Intros. -Inversion H1. -Split. -Inversion H. -Apply (H4 H2). - -Inversion H0. -Apply (H4 H3). +intros. +inversion H1. +split. +inversion H. +apply (H4 H2). + +inversion H0. +apply (H4 H3). Qed. Add Morphism not : not_ext. -Red ; Intros. -Apply H0. -Inversion H. -Apply (H3 H1). +red in |- *; intros. +apply H0. +inversion H. +apply (H3 H1). Qed. -Definition fleche [A,B:Prop] := A -> B. +Definition fleche (A B:Prop) := A -> B. Add Morphism fleche : fleche_ext. -Unfold fleche. -Intros. -Inversion H0. -Inversion H. -Apply (H3 (H1 (H6 H2))). +unfold fleche in |- *. +intros. +inversion H0. +inversion H. +apply (H3 (H1 (H6 H2))). Qed. - diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v index cd72483a3..e2d707367 100755 --- a/theories/Sets/Classical_sets.v +++ b/theories/Sets/Classical_sets.v @@ -33,101 +33,100 @@ Require Export Classical_Type. (* Hints Unfold not . *) Section Ensembles_classical. -Variable U: Type. +Variable U : Type. -Lemma not_included_empty_Inhabited: - (A: (Ensemble U)) ~ (Included U A (Empty_set U)) -> (Inhabited U A). +Lemma not_included_empty_Inhabited : + forall A:Ensemble U, ~ Included U A (Empty_set U) -> Inhabited U A. Proof. -Intros A NI. -Elim (not_all_ex_not U [x:U]~(In U A x)). -Intros x H; Apply Inhabited_intro with x. -Apply NNPP; Auto with sets. -Red; Intro. -Apply NI; Red. -Intros x H'; Elim (H x); Trivial with sets. +intros A NI. +elim (not_all_ex_not U (fun x:U => ~ In U A x)). +intros x H; apply Inhabited_intro with x. +apply NNPP; auto with sets. +red in |- *; intro. +apply NI; red in |- *. +intros x H'; elim (H x); trivial with sets. Qed. -Hints Resolve not_included_empty_Inhabited. +Hint Resolve not_included_empty_Inhabited. -Lemma not_empty_Inhabited: - (A: (Ensemble U)) ~ A == (Empty_set U) -> (Inhabited U A). +Lemma not_empty_Inhabited : + forall A:Ensemble U, A <> Empty_set U -> Inhabited U A. Proof. -Intros; Apply not_included_empty_Inhabited. -Red; Auto with sets. +intros; apply not_included_empty_Inhabited. +red in |- *; auto with sets. Qed. Lemma Inhabited_Setminus : -(X, Y: (Ensemble U)) (Included U X Y) -> ~ (Included U Y X) -> - (Inhabited U (Setminus U Y X)). + forall X Y:Ensemble U, + Included U X Y -> ~ Included U Y X -> Inhabited U (Setminus U Y X). Proof. -Intros X Y I NI. -Elim (not_all_ex_not U [x:U](In U Y x)->(In U X x) NI). -Intros x YX. -Apply Inhabited_intro with x. -Apply Setminus_intro. -Apply not_imply_elim with (In U X x); Trivial with sets. -Auto with sets. +intros X Y I NI. +elim (not_all_ex_not U (fun x:U => In U Y x -> In U X x) NI). +intros x YX. +apply Inhabited_intro with x. +apply Setminus_intro. +apply not_imply_elim with (In U X x); trivial with sets. +auto with sets. Qed. -Hints Resolve Inhabited_Setminus. +Hint Resolve Inhabited_Setminus. -Lemma Strict_super_set_contains_new_element: - (X, Y: (Ensemble U)) (Included U X Y) -> ~ X == Y -> - (Inhabited U (Setminus U Y X)). +Lemma Strict_super_set_contains_new_element : + forall X Y:Ensemble U, + Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X). Proof. -Auto 7 with sets. +auto 7 with sets. Qed. -Hints Resolve Strict_super_set_contains_new_element. +Hint Resolve Strict_super_set_contains_new_element. -Lemma Subtract_intro: - (A: (Ensemble U)) (x, y: U) (In U A y) -> ~ x == y -> - (In U (Subtract U A x) y). +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 1 Subtract; Auto with sets. +unfold Subtract at 1 in |- *; auto with sets. Qed. -Hints Resolve Subtract_intro. +Hint Resolve Subtract_intro. -Lemma Subtract_inv: - (A: (Ensemble U)) (x, y: U) (In U (Subtract U A x) y) -> - (In U A y) /\ ~ x == y. +Lemma Subtract_inv : + forall (A:Ensemble U) (x y:U), In U (Subtract U A x) y -> In U A y /\ x <> y. Proof. -Intros A x y H'; Elim H'; Auto with sets. +intros A x y H'; elim H'; auto with sets. Qed. -Lemma Included_Strict_Included: - (X, Y: (Ensemble U)) (Included U X Y) -> (Strict_Included U X Y) \/ X == Y. +Lemma Included_Strict_Included : + forall X Y:Ensemble U, Included U X Y -> Strict_Included U X Y \/ X = Y. Proof. -Intros X Y H'; Try Assumption. -Elim (classic X == Y); Auto with sets. +intros X Y H'; try assumption. +elim (classic (X = Y)); auto with sets. Qed. -Lemma Strict_Included_inv: - (X, Y: (Ensemble U)) (Strict_Included U X Y) -> - (Included U X Y) /\ (Inhabited U (Setminus U Y X)). +Lemma Strict_Included_inv : + forall X Y:Ensemble U, + Strict_Included U X Y -> Included U X Y /\ Inhabited U (Setminus U Y X). Proof. -Intros X Y H'; Red in H'. -Split; [Tauto | Idtac]. -Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'. -Apply Strict_super_set_contains_new_element; Auto with sets. +intros X Y H'; red in H'. +split; [ tauto | idtac ]. +elim H'; intros H'0 H'1; try exact H'1; clear H'. +apply Strict_super_set_contains_new_element; auto with sets. Qed. -Lemma not_SIncl_empty: - (X: (Ensemble U)) ~ (Strict_Included U X (Empty_set U)). +Lemma not_SIncl_empty : + forall X:Ensemble U, ~ Strict_Included U X (Empty_set U). Proof. -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. -Intro H'3; Elim H'3. +intro X; red in |- *; intro H'; try exact H'. +lapply (Strict_Included_inv X (Empty_set U)); auto with sets. +intro H'0; elim H'0; intros H'1 H'2; elim H'2; clear H'0. +intros x H'0; elim H'0. +intro H'3; elim H'3. Qed. Lemma Complement_Complement : - (A: (Ensemble U)) (Complement U (Complement U A)) == A. + forall A:Ensemble U, Complement U (Complement U A) = A. Proof. -Unfold Complement; Intros; Apply Extensionality_Ensembles; Auto with sets. -Red; Split; Auto with sets. -Red; Intros; Apply NNPP; Auto with sets. +unfold Complement in |- *; intros; apply Extensionality_Ensembles; + auto with sets. +red in |- *; split; auto with sets. +red in |- *; intros; apply NNPP; auto with sets. Qed. End Ensembles_classical. -Hints Resolve Strict_super_set_contains_new_element Subtract_intro - not_SIncl_empty : sets v62. +Hint Resolve Strict_super_set_contains_new_element Subtract_intro + not_SIncl_empty: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v index 78ad3d2f2..b4250be92 100755 --- a/theories/Sets/Constructive_sets.v +++ b/theories/Sets/Constructive_sets.v @@ -29,134 +29,131 @@ Require Export Ensembles. Section Ensembles_facts. -Variable U: Type. +Variable U : Type. -Lemma Extension: (B, C: (Ensemble U)) B == C -> (Same_set U B C). +Lemma Extension : forall B C:Ensemble U, B = C -> Same_set U B C. Proof. -Intros B C H'; Rewrite H'; Auto with sets. +intros B C H'; rewrite H'; auto with sets. Qed. -Lemma Noone_in_empty: (x: U) ~ (In U (Empty_set U) x). +Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x. Proof. -Red; NewDestruct 1. +red in |- *; destruct 1. Qed. -Hints Resolve Noone_in_empty. +Hint Resolve Noone_in_empty. -Lemma Included_Empty: (A: (Ensemble U))(Included U (Empty_set U) A). +Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A. Proof. -Intro; Red. -Intros x H; Elim (Noone_in_empty x); Auto with sets. +intro; red in |- *. +intros x H; elim (Noone_in_empty x); auto with sets. Qed. -Hints Resolve Included_Empty. +Hint Resolve Included_Empty. -Lemma Add_intro1: - (A: (Ensemble U)) (x, y: U) (In U A y) -> (In U (Add U A x) y). +Lemma Add_intro1 : + forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y. Proof. -Unfold 1 Add; Auto with sets. +unfold Add at 1 in |- *; auto with sets. Qed. -Hints Resolve Add_intro1. +Hint Resolve Add_intro1. -Lemma Add_intro2: (A: (Ensemble U)) (x: U) (In U (Add U A x) x). +Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x. Proof. -Unfold 1 Add; Auto with sets. +unfold Add at 1 in |- *; auto with sets. Qed. -Hints Resolve Add_intro2. +Hint Resolve Add_intro2. -Lemma Inhabited_add: (A: (Ensemble U)) (x: U) (Inhabited U (Add U A x)). +Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x). Proof. -Intros A x. -Apply Inhabited_intro with x := x; Auto with sets. +intros A x. +apply Inhabited_intro with (x := x); auto with sets. Qed. -Hints Resolve Inhabited_add. +Hint Resolve Inhabited_add. -Lemma Inhabited_not_empty: - (X: (Ensemble U)) (Inhabited U X) -> ~ X == (Empty_set U). +Lemma Inhabited_not_empty : + forall X:Ensemble U, Inhabited U X -> X <> Empty_set U. Proof. -Intros X H'; Elim H'. -Intros x H'0; Red; Intro H'1. -Absurd (In U X x); Auto with sets. -Rewrite H'1; Auto with sets. +intros X H'; elim H'. +intros x H'0; red in |- *; intro H'1. +absurd (In U X x); auto with sets. +rewrite H'1; auto with sets. Qed. -Hints Resolve Inhabited_not_empty. +Hint Resolve Inhabited_not_empty. -Lemma Add_not_Empty : - (A: (Ensemble U)) (x: U) ~ (Add U A x) == (Empty_set U). +Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U. Proof. -Auto with sets. +auto with sets. Qed. -Hints Resolve Add_not_Empty. +Hint Resolve Add_not_Empty. -Lemma not_Empty_Add : - (A: (Ensemble U)) (x: U) ~ (Empty_set U) == (Add U A x). +Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x. Proof. -Intros; Red; Intro H; Generalize (Add_not_Empty A x); Auto with sets. +intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets. Qed. -Hints Resolve not_Empty_Add. +Hint Resolve not_Empty_Add. -Lemma Singleton_inv: (x, y: U) (In U (Singleton U x) y) -> x == y. +Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y. Proof. -Intros x y H'; Elim H'; Trivial with sets. +intros x y H'; elim H'; trivial with sets. Qed. -Hints Resolve Singleton_inv. +Hint Resolve Singleton_inv. -Lemma Singleton_intro: (x, y: U) x == y -> (In U (Singleton U x) y). +Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y. Proof. -Intros x y H'; Rewrite H'; Trivial with sets. +intros x y H'; rewrite H'; trivial with sets. Qed. -Hints Resolve Singleton_intro. +Hint Resolve Singleton_intro. -Lemma Union_inv: (B, C: (Ensemble U)) (x: U) - (In U (Union U B C) x) -> (In U B x) \/ (In U C x). +Lemma Union_inv : + forall (B C:Ensemble U) (x:U), In U (Union U B C) x -> In U B x \/ In U C x. Proof. -Intros B C x H'; Elim H'; Auto with sets. +intros B C x H'; elim H'; auto with sets. Qed. -Lemma Add_inv: - (A: (Ensemble U)) (x, y: U) (In U (Add U A x) y) -> (In U A y) \/ x == y. +Lemma Add_inv : + forall (A:Ensemble U) (x y:U), In U (Add U A x) y -> In U A y \/ x = y. Proof. -Intros A x y H'; Elim H'; Auto with sets. +intros A x y H'; elim H'; auto with sets. Qed. -Lemma Intersection_inv: - (B, C: (Ensemble U)) (x: U) (In U (Intersection U B C) x) -> - (In U B x) /\ (In U C x). +Lemma Intersection_inv : + forall (B C:Ensemble U) (x:U), + In U (Intersection U B C) x -> In U B x /\ In U C x. Proof. -Intros B C x H'; Elim H'; Auto with sets. +intros B C x H'; elim H'; auto with sets. Qed. -Hints Resolve Intersection_inv. +Hint Resolve Intersection_inv. -Lemma Couple_inv: (x, y, z: U) (In U (Couple U x y) z) -> z == x \/ z == y. +Lemma Couple_inv : forall x y z:U, In U (Couple U x y) z -> z = x \/ z = y. Proof. -Intros x y z H'; Elim H'; Auto with sets. +intros x y z H'; elim H'; auto with sets. Qed. -Hints Resolve Couple_inv. +Hint Resolve Couple_inv. -Lemma Setminus_intro: - (A, B: (Ensemble U)) (x: U) (In U A x) -> ~ (In U B x) -> - (In U (Setminus U A B) x). +Lemma Setminus_intro : + forall (A B:Ensemble U) (x:U), + In U A x -> ~ In U B x -> In U (Setminus U A B) x. Proof. -Unfold 1 Setminus; Red; Auto with sets. +unfold Setminus at 1 in |- *; red in |- *; auto with sets. Qed. -Hints Resolve Setminus_intro. +Hint Resolve Setminus_intro. -Lemma Strict_Included_intro: - (X, Y: (Ensemble U)) (Included U X Y) /\ ~ X == Y -> - (Strict_Included U X Y). +Lemma Strict_Included_intro : + forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y. Proof. -Auto with sets. +auto with sets. Qed. -Hints Resolve Strict_Included_intro. +Hint Resolve Strict_Included_intro. -Lemma Strict_Included_strict: (X: (Ensemble U)) ~ (Strict_Included U X X). +Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X. Proof. -Intro X; Red; Intro H'; Elim H'. -Intros H'0 H'1; Elim H'1; Auto with sets. +intro X; red in |- *; intro H'; elim H'. +intros H'0 H'1; elim H'1; auto with sets. Qed. -Hints Resolve Strict_Included_strict. +Hint Resolve Strict_Included_strict. End Ensembles_facts. -Hints Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 - Intersection_inv Couple_inv Setminus_intro Strict_Included_intro - Strict_Included_strict Noone_in_empty Inhabited_not_empty - Add_not_Empty not_Empty_Add Inhabited_add Included_Empty : sets v62. +Hint Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 + Intersection_inv Couple_inv Setminus_intro Strict_Included_intro + Strict_Included_strict Noone_in_empty Inhabited_not_empty Add_not_Empty + not_Empty_Add Inhabited_add Included_Empty: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v index c234bd1c7..0d77c0617 100755 --- a/theories/Sets/Cpo.v +++ b/theories/Sets/Cpo.v @@ -31,77 +31,79 @@ Require Export Relations_1. Require Export Partial_Order. Section Bounds. -Variable U: Type. -Variable D: (PO U). +Variable U : Type. +Variable D : PO U. -Local C := (Carrier_of U D). +Let C := Carrier_of U D. -Local R := (Rel_of U D). +Let R := Rel_of U D. -Inductive Upper_Bound [B:(Ensemble U); x:U]: Prop := - Upper_Bound_definition: - (In U C x) -> ((y: U) (In U B y) -> (R y x)) -> (Upper_Bound B x). +Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop := + Upper_Bound_definition : + In U C x -> (forall y:U, In U B y -> R y x) -> Upper_Bound B x. -Inductive Lower_Bound [B:(Ensemble U); x:U]: Prop := - Lower_Bound_definition: - (In U C x) -> ((y: U) (In U B y) -> (R x y)) -> (Lower_Bound B x). +Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop := + Lower_Bound_definition : + In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x. -Inductive Lub [B:(Ensemble U); x:U]: Prop := - Lub_definition: - (Upper_Bound B x) -> ((y: U) (Upper_Bound B y) -> (R x y)) -> (Lub B x). +Inductive Lub (B:Ensemble U) (x:U) : Prop := + Lub_definition : + Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x. -Inductive Glb [B:(Ensemble U); x:U]: Prop := - Glb_definition: - (Lower_Bound B x) -> ((y: U) (Lower_Bound B y) -> (R y x)) -> (Glb B x). +Inductive Glb (B:Ensemble U) (x:U) : Prop := + Glb_definition : + Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x. -Inductive Bottom [bot:U]: Prop := - Bottom_definition: - (In U C bot) -> ((y: U) (In U C y) -> (R bot y)) -> (Bottom bot). +Inductive Bottom (bot:U) : Prop := + Bottom_definition : + In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot. -Inductive Totally_ordered [B:(Ensemble U)]: Prop := - Totally_ordered_definition: - ((Included U B C) -> - (x: U) (y: U) (Included U (Couple U x y) B) -> (R x y) \/ (R y x)) -> - (Totally_ordered B). +Inductive Totally_ordered (B:Ensemble U) : Prop := + Totally_ordered_definition : + (Included U B C -> + forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) -> + Totally_ordered B. -Definition Compatible : (Relation U) := - [x: U] [y: U] (In U C x) -> (In U C y) -> - (EXT z | (In U C z) /\ (Upper_Bound (Couple U x y) z)). +Definition Compatible : Relation U := + fun x y:U => + In U C x -> + In U C y -> exists z : _ | In U C z /\ Upper_Bound (Couple U x y) z. -Inductive Directed [X:(Ensemble U)]: Prop := - Definition_of_Directed: - (Included U X C) -> - (Inhabited U X) -> - ((x1: U) (x2: U) (Included U (Couple U x1 x2) X) -> - (EXT x3 | (In U X x3) /\ (Upper_Bound (Couple U x1 x2) x3))) -> - (Directed X). +Inductive Directed (X:Ensemble U) : Prop := + Definition_of_Directed : + Included U X C -> + Inhabited U X -> + (forall x1 x2:U, + Included U (Couple U x1 x2) X -> + exists x3 : _ | In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) -> + Directed X. Inductive Complete : Prop := - Definition_of_Complete: - ((EXT bot | (Bottom bot))) -> - ((X: (Ensemble U)) (Directed X) -> (EXT bsup | (Lub X bsup))) -> - Complete. + Definition_of_Complete : + ( exists bot : _ | Bottom bot) -> + (forall X:Ensemble U, Directed X -> exists bsup : _ | Lub X bsup) -> + Complete. Inductive Conditionally_complete : Prop := - Definition_of_Conditionally_complete: - ((X: (Ensemble U)) - (Included U X C) -> (EXT maj | (Upper_Bound X maj)) -> - (EXT bsup | (Lub X bsup))) -> Conditionally_complete. + Definition_of_Conditionally_complete : + (forall X:Ensemble U, + Included U X C -> + ( exists maj : _ | Upper_Bound X maj) -> + exists bsup : _ | Lub X bsup) -> Conditionally_complete. End Bounds. -Hints Resolve Totally_ordered_definition Upper_Bound_definition - Lower_Bound_definition Lub_definition Glb_definition - Bottom_definition Definition_of_Complete - Definition_of_Complete Definition_of_Conditionally_complete. +Hint Resolve Totally_ordered_definition Upper_Bound_definition + Lower_Bound_definition Lub_definition Glb_definition Bottom_definition + Definition_of_Complete Definition_of_Complete + Definition_of_Conditionally_complete. Section Specific_orders. -Variable U: Type. +Variable U : Type. -Record Cpo : Type := Definition_of_cpo { - PO_of_cpo: (PO U); - Cpo_cond: (Complete U PO_of_cpo) }. +Record Cpo : Type := Definition_of_cpo + {PO_of_cpo : PO U; Cpo_cond : Complete U PO_of_cpo}. -Record Chain : Type := Definition_of_chain { - PO_of_chain: (PO U); - Chain_cond: (Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)) }. +Record Chain : Type := Definition_of_chain + {PO_of_chain : PO U; + Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}. -End Specific_orders. +End Specific_orders.
\ No newline at end of file diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v index af202239e..eae50a3d1 100755 --- a/theories/Sets/Ensembles.v +++ b/theories/Sets/Ensembles.v @@ -27,20 +27,18 @@ (*i $Id$ i*) Section Ensembles. -Variable U: Type. +Variable U : Type. -Definition Ensemble := U -> Prop. +Definition Ensemble := U -> Prop. -Definition In : Ensemble -> U -> Prop := [A: Ensemble] [x: U] (A x). +Definition In (A:Ensemble) (x:U) : Prop := A x. -Definition Included : Ensemble -> Ensemble -> Prop := - [B, C: Ensemble] (x: U) (In B x) -> (In C x). +Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x. -Inductive Empty_set : Ensemble := - . +Inductive Empty_set : Ensemble :=. Inductive Full_set : Ensemble := - Full_intro: (x: U) (In Full_set x). + Full_intro : forall x:U, In Full_set x. (** NB: The following definition builds-in equality of elements in [U] as Leibniz equality. @@ -49,60 +47,55 @@ Inductive Full_set : Ensemble := with its own equality [eqs], with [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *) -Inductive Singleton [x:U] : Ensemble := - In_singleton: (In (Singleton x) x). +Inductive Singleton (x:U) : Ensemble := + In_singleton : In (Singleton x) x. -Inductive Union [B, C: Ensemble] : Ensemble := - Union_introl: (x: U) (In B x) -> (In (Union B C) x) - | Union_intror: (x: U) (In C x) -> (In (Union B C) x). +Inductive Union (B C:Ensemble) : Ensemble := + | Union_introl : forall x:U, In B x -> In (Union B C) x + | Union_intror : forall x:U, In C x -> In (Union B C) x. -Definition Add : Ensemble -> U -> Ensemble := - [B: Ensemble] [x: U] (Union B (Singleton x)). +Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x). -Inductive Intersection [B, C:Ensemble] : Ensemble := - Intersection_intro: - (x: U) (In B x) -> (In C x) -> (In (Intersection B C) x). +Inductive Intersection (B C:Ensemble) : Ensemble := + Intersection_intro : + forall x:U, In B x -> In C x -> In (Intersection B C) x. -Inductive Couple [x,y:U] : Ensemble := - Couple_l: (In (Couple x y) x) - | Couple_r: (In (Couple x y) y). +Inductive Couple (x y:U) : Ensemble := + | Couple_l : In (Couple x y) x + | Couple_r : In (Couple x y) y. -Inductive Triple[x, y, z:U] : Ensemble := - Triple_l: (In (Triple x y z) x) - | Triple_m: (In (Triple x y z) y) - | Triple_r: (In (Triple x y z) z). +Inductive Triple (x y z:U) : Ensemble := + | Triple_l : In (Triple x y z) x + | Triple_m : In (Triple x y z) y + | Triple_r : In (Triple x y z) z. -Definition Complement : Ensemble -> Ensemble := - [A: Ensemble] [x: U] ~ (In A x). +Definition Complement (A:Ensemble) : Ensemble := fun x:U => ~ In A x. -Definition Setminus : Ensemble -> Ensemble -> Ensemble := - [B: Ensemble] [C: Ensemble] [x: U] (In B x) /\ ~ (In C x). +Definition Setminus (B C:Ensemble) : Ensemble := + fun x:U => In B x /\ ~ In C x. -Definition Subtract : Ensemble -> U -> Ensemble := - [B: Ensemble] [x: U] (Setminus B (Singleton x)). +Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x). -Inductive Disjoint [B, C:Ensemble] : Prop := - Disjoint_intro: ((x: U) ~ (In (Intersection B C) x)) -> (Disjoint B C). +Inductive Disjoint (B C:Ensemble) : Prop := + Disjoint_intro : (forall x:U, ~ In (Intersection B C) x) -> Disjoint B C. -Inductive Inhabited [B:Ensemble] : Prop := - Inhabited_intro: (x: U) (In B x) -> (Inhabited B). +Inductive Inhabited (B:Ensemble) : Prop := + Inhabited_intro : forall x:U, In B x -> Inhabited B. -Definition Strict_Included : Ensemble -> Ensemble -> Prop := - [B, C: Ensemble] (Included B C) /\ ~ B == C. +Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C. -Definition Same_set : Ensemble -> Ensemble -> Prop := - [B, C: Ensemble] (Included B C) /\ (Included C B). +Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B. (** Extensionality Axiom *) -Axiom Extensionality_Ensembles: - (A,B: Ensemble) (Same_set A B) -> A == B. -Hints Resolve Extensionality_Ensembles. +Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B. +Hint Resolve Extensionality_Ensembles. End Ensembles. -Hints Unfold In Included Same_set Strict_Included Add Setminus Subtract : sets v62. +Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets + v62. -Hints Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l - Couple_r Triple_l Triple_m Triple_r Disjoint_intro - Extensionality_Ensembles : sets v62. +Hint Resolve Union_introl Union_intror Intersection_intro In_singleton + Couple_l Couple_r Triple_l Triple_m Triple_r Disjoint_intro + Extensionality_Ensembles: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v index 1e7168791..28b2d6fb9 100755 --- a/theories/Sets/Finite_sets.v +++ b/theories/Sets/Finite_sets.v @@ -26,49 +26,56 @@ (*i $Id$ i*) -Require Ensembles. +Require Import Ensembles. Section Ensembles_finis. -Variable U: Type. +Variable U : Type. -Inductive Finite : (Ensemble U) -> Prop := - Empty_is_finite: (Finite (Empty_set U)) - | Union_is_finite: - (A: (Ensemble U)) (Finite A) -> - (x: U) ~ (In U A x) -> (Finite (Add U A x)). +Inductive Finite : Ensemble U -> Prop := + | Empty_is_finite : Finite (Empty_set U) + | Union_is_finite : + forall A:Ensemble U, + Finite A -> forall x:U, ~ In U A x -> Finite (Add U A x). -Inductive cardinal : (Ensemble U) -> nat -> Prop := - card_empty: (cardinal (Empty_set U) O) - | card_add: - (A: (Ensemble U)) (n: nat) (cardinal A n) -> - (x: U) ~ (In U A x) -> (cardinal (Add U A x) (S n)). +Inductive cardinal : Ensemble U -> nat -> Prop := + | card_empty : cardinal (Empty_set U) 0 + | card_add : + forall (A:Ensemble U) (n:nat), + cardinal A n -> forall x:U, ~ In U A x -> cardinal (Add U A x) (S n). End Ensembles_finis. -Hints Resolve Empty_is_finite Union_is_finite : sets v62. -Hints Resolve card_empty card_add : sets v62. +Hint Resolve Empty_is_finite Union_is_finite: sets v62. +Hint Resolve card_empty card_add: sets v62. -Require Constructive_sets. +Require Import Constructive_sets. Section Ensembles_finis_facts. -Variable U: Type. +Variable U : Type. Lemma cardinal_invert : - (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of - X == (Empty_set U) - [n:nat] (EXT A | (EXT x | - X == (Add U A x) /\ ~ (In U A x) /\ (cardinal U A n))) end. + forall (X:Ensemble U) (p:nat), + cardinal U X p -> + match p with + | O => X = Empty_set U + | S n => + exists A : _ + | ( exists x : _ | X = Add U A x /\ ~ In U A x /\ cardinal U A n) + end. Proof. -NewInduction 1; Simpl; Auto. -Exists A; Exists x; Auto. +induction 1; simpl in |- *; auto. +exists A; exists x; auto. Qed. Lemma cardinal_elim : - (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of - X == (Empty_set U) - [n:nat](Inhabited U X) end. + forall (X:Ensemble U) (p:nat), + cardinal U X p -> + match p with + | O => X = Empty_set U + | S n => Inhabited U X + end. Proof. -Intros X p C; Elim C; Simpl; Trivial with sets. +intros X p C; elim C; simpl in |- *; trivial with sets. Qed. -End Ensembles_finis_facts. +End Ensembles_finis_facts.
\ No newline at end of file diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v index 4e7b6931f..2849bce6c 100755 --- a/theories/Sets/Finite_sets_facts.v +++ b/theories/Sets/Finite_sets_facts.v @@ -37,309 +37,311 @@ Require Export Gt. Require Export Lt. Section Finite_sets_facts. -Variable U: Type. +Variable U : Type. Lemma finite_cardinal : - (X: (Ensemble U)) (Finite U X) -> (EX n:nat |(cardinal U X n)). + forall X:Ensemble U, Finite U X -> exists n : nat | cardinal U X n. Proof. -NewInduction 1 as [|A _ [n H]]. -Exists O; Auto with sets. -Exists (S n); Auto with sets. +induction 1 as [| A _ [n H]]. +exists 0; auto with sets. +exists (S n); auto with sets. Qed. -Lemma cardinal_finite: - (X: (Ensemble U)) (n: nat) (cardinal U X n) -> (Finite U X). +Lemma cardinal_finite : + forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X. Proof. -NewInduction 1; Auto with sets. +induction 1; auto with sets. Qed. -Theorem Add_preserves_Finite: - (X: (Ensemble U)) (x: U) (Finite U X) -> (Finite U (Add U X x)). +Theorem Add_preserves_Finite : + forall (X:Ensemble U) (x:U), Finite U X -> Finite U (Add U X x). Proof. -Intros X x H'. -Elim (classic (In U X x)); Intro H'0; Auto with sets. -Rewrite (Non_disjoint_union U X x); Auto with sets. +intros X x H'. +elim (classic (In U X x)); intro H'0; auto with sets. +rewrite (Non_disjoint_union U X x); auto with sets. Qed. -Hints Resolve Add_preserves_Finite. +Hint Resolve Add_preserves_Finite. -Theorem Singleton_is_finite: (x: U) (Finite U (Singleton U x)). +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)); Auto with sets. +intro x; rewrite <- (Empty_set_zero U (Singleton U x)). +change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets. Qed. -Hints Resolve Singleton_is_finite. +Hint Resolve Singleton_is_finite. -Theorem Union_preserves_Finite: - (X, Y: (Ensemble U)) (Finite U X) -> (Finite U Y) -> - (Finite U (Union U X Y)). +Theorem Union_preserves_Finite : + forall X Y:Ensemble U, Finite U X -> Finite U Y -> Finite U (Union U X Y). Proof. -Intros X Y H'; Elim H'. -Rewrite (Empty_set_zero U Y); Auto with sets. -Intros A H'0 H'1 x H'2 H'3. -Rewrite (Union_commutative U (Add U A x) Y). -Rewrite <- (Union_add U Y A x). -Rewrite (Union_commutative U Y A); Auto with sets. +intros X Y H'; elim H'. +rewrite (Empty_set_zero U Y); auto with sets. +intros A H'0 H'1 x H'2 H'3. +rewrite (Union_commutative U (Add U A x) Y). +rewrite <- (Union_add U Y A x). +rewrite (Union_commutative U Y A); auto with sets. Qed. -Lemma Finite_downward_closed: - (A: (Ensemble U)) (Finite U A) -> - (X: (Ensemble U)) (Included U X A) -> (Finite U X). +Lemma Finite_downward_closed : + forall A:Ensemble U, + Finite U A -> forall X:Ensemble U, Included U X A -> Finite U X. Proof. -Intros A H'; Elim H'; Auto with sets. -Intros X H'0. -Rewrite (less_than_empty U X H'0); Auto with sets. -Intros; Elim Included_Add with U X A0 x; Auto with sets. -NewDestruct 1 as [A' [H5 H6]]. -Rewrite H5; Auto with sets. +intros A H'; elim H'; auto with sets. +intros X H'0. +rewrite (less_than_empty U X H'0); auto with sets. +intros; elim Included_Add with U X A0 x; auto with sets. +destruct 1 as [A' [H5 H6]]. +rewrite H5; auto with sets. Qed. -Lemma Intersection_preserves_finite: - (A: (Ensemble U)) (Finite U A) -> - (X: (Ensemble U)) (Finite U (Intersection U X A)). +Lemma Intersection_preserves_finite : + forall A:Ensemble U, + Finite U A -> forall X:Ensemble U, Finite U (Intersection U X A). Proof. -Intros A H' X; Apply Finite_downward_closed with A; Auto with sets. +intros A H' X; apply Finite_downward_closed with A; auto with sets. Qed. -Lemma cardinalO_empty: - (X: (Ensemble U)) (cardinal U X O) -> X == (Empty_set U). +Lemma cardinalO_empty : + forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U. Proof. -Intros X H; Apply (cardinal_invert U X O); Trivial with sets. +intros X H; apply (cardinal_invert U X 0); trivial with sets. Qed. -Hints Resolve cardinalO_empty. +Hint Resolve cardinalO_empty. -Lemma inh_card_gt_O: - (X: (Ensemble U)) (Inhabited U X) -> (n: nat) (cardinal U X n) -> (gt n O). +Lemma inh_card_gt_O : + forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0. Proof. -NewInduction 1 as [x H']. -Intros n H'0. -Elim (gt_O_eq n); Auto with sets. -Intro H'1; Generalize H'; Generalize H'0. -Rewrite <- H'1; Intro H'2. -Rewrite (cardinalO_empty X); Auto with sets. -Intro H'3; Elim H'3. +induction 1 as [x H']. +intros n H'0. +elim (gt_O_eq n); auto with sets. +intro H'1; generalize H'; generalize H'0. +rewrite <- H'1; intro H'2. +rewrite (cardinalO_empty X); auto with sets. +intro H'3; elim H'3. Qed. -Lemma card_soustr_1: - (X: (Ensemble U)) (n: nat) (cardinal U X n) -> - (x: U) (In U X x) -> (cardinal U (Subtract U X x) (pred n)). +Lemma card_soustr_1 : + forall (X:Ensemble U) (n:nat), + cardinal U X n -> + forall x:U, In U X x -> cardinal U (Subtract U X x) (pred n). Proof. -Intros X n H'; Elim H'. -Intros x H'0; Elim H'0. -Clear H' n X. -Intros X n H' H'0 x H'1 x0 H'2. -Elim (classic (In U X x0)). -Intro H'4; Rewrite (add_soustr_xy U X x x0). -Elim (classic x == x0). -Intro H'5. -Absurd (In U X x0); Auto with sets. -Rewrite <- H'5; Auto with sets. -Intro H'3; Try Assumption. -Cut (S (pred n)) = (pred (S n)). -Intro H'5; Rewrite <- H'5. -Apply card_add; Auto with sets. -Red; Intro H'6; Elim H'6. -Intros H'7 H'8; Try Assumption. -Elim H'1; Auto with sets. -Unfold 2 pred; Symmetry. -Apply S_pred with m := O. -Change (gt n O). -Apply inh_card_gt_O with X := X; Auto with sets. -Apply Inhabited_intro with x := x0; Auto with sets. -Red; Intro H'3. -Apply H'1. -Elim H'3; Auto with sets. -Rewrite H'3; Auto with sets. -Elim (classic x == x0). -Intro H'3; Rewrite <- H'3. -Cut (Subtract U (Add U X x) x) == X; Auto with sets. -Intro H'4; Rewrite H'4; Auto with sets. -Intros H'3 H'4; Try Assumption. -Absurd (In U (Add U X x) x0); Auto with sets. -Red; Intro H'5; Try Exact H'5. -LApply (Add_inv U X x x0); Tauto. +intros X n H'; elim H'. +intros x H'0; elim H'0. +clear H' n X. +intros X n H' H'0 x H'1 x0 H'2. +elim (classic (In U X x0)). +intro H'4; rewrite (add_soustr_xy U X x x0). +elim (classic (x = x0)). +intro H'5. +absurd (In U X x0); auto with sets. +rewrite <- H'5; auto with sets. +intro H'3; try assumption. +cut (S (pred n) = pred (S n)). +intro H'5; rewrite <- H'5. +apply card_add; auto with sets. +red in |- *; intro H'6; elim H'6. +intros H'7 H'8; try assumption. +elim H'1; auto with sets. +unfold pred at 2 in |- *; symmetry in |- *. +apply S_pred with (m := 0). +change (n > 0) in |- *. +apply inh_card_gt_O with (X := X); auto with sets. +apply Inhabited_intro with (x := x0); auto with sets. +red in |- *; intro H'3. +apply H'1. +elim H'3; auto with sets. +rewrite H'3; auto with sets. +elim (classic (x = x0)). +intro H'3; rewrite <- H'3. +cut (Subtract U (Add U X x) x = X); auto with sets. +intro H'4; rewrite H'4; auto with sets. +intros H'3 H'4; try assumption. +absurd (In U (Add U X x) x0); auto with sets. +red in |- *; intro H'5; try exact H'5. +lapply (Add_inv U X x x0); tauto. Qed. -Lemma cardinal_is_functional: - (X: (Ensemble U)) (c1: nat) (cardinal U X c1) -> - (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> X == Y -> - c1 = c2. +Lemma cardinal_is_functional : + forall (X:Ensemble U) (c1:nat), + cardinal U X c1 -> + forall (Y:Ensemble U) (c2:nat), cardinal U Y c2 -> X = Y -> c1 = c2. Proof. -Intros X c1 H'; Elim H'. -Intros Y c2 H'0; Elim H'0; Auto with sets. -Intros A n H'1 H'2 x H'3 H'5. -Elim (not_Empty_Add U A x); Auto with sets. -Clear H' c1 X. -Intros X n H' H'0 x H'1 Y c2 H'2. -Elim H'2. -Intro H'3. -Elim (not_Empty_Add U X x); Auto with sets. -Clear H'2 c2 Y. -Intros X0 c2 H'2 H'3 x0 H'4 H'5. -Elim (classic (In U X0 x)). -Intro H'6; Apply f_equal with nat. -Apply H'0 with Y := (Subtract U (Add U X0 x0) x). -ElimType (pred (S c2)) = c2; Auto with sets. -Apply card_soustr_1; Auto with sets. -Rewrite <- H'5. -Apply Sub_Add_new; Auto with sets. -Elim (classic x == x0). -Intros H'6 H'7; Apply f_equal with nat. -Apply H'0 with Y := X0; Auto with sets. -Apply Simplify_add with x := x; Auto with sets. -Pattern 2 x; 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; Intro H'. -LApply (Extension U (Add U X x) (Add U X0 x0)); Auto with sets. -Clear H'. -Intro H'; Red in H'. -Elim H'; Intros H'0 H'1; Red in H'0; Clear H' H'1. -Absurd (In U (Add U X0 x0) x); Auto with sets. -LApply (Add_inv U X0 x0 x); [ Intuition | Apply (H'0 x); Apply Add_intro2 ]. +intros X c1 H'; elim H'. +intros Y c2 H'0; elim H'0; auto with sets. +intros A n H'1 H'2 x H'3 H'5. +elim (not_Empty_Add U A x); auto with sets. +clear H' c1 X. +intros X n H' H'0 x H'1 Y c2 H'2. +elim H'2. +intro H'3. +elim (not_Empty_Add U X x); auto with sets. +clear H'2 c2 Y. +intros X0 c2 H'2 H'3 x0 H'4 H'5. +elim (classic (In U X0 x)). +intro H'6; apply f_equal with nat. +apply H'0 with (Y := Subtract U (Add U X0 x0) x). +elimtype (pred (S c2) = c2); auto with sets. +apply card_soustr_1; auto with sets. +rewrite <- H'5. +apply Sub_Add_new; auto with sets. +elim (classic (x = x0)). +intros H'6 H'7; apply f_equal with nat. +apply H'0 with (Y := X0); auto with sets. +apply Simplify_add with (x := x); auto with sets. +pattern x at 2 in |- *; rewrite H'6; auto with sets. +intros H'6 H'7. +absurd (Add U X x = Add U X0 x0); auto with sets. +clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2. +red in |- *; intro H'. +lapply (Extension U (Add U X x) (Add U X0 x0)); auto with sets. +clear H'. +intro H'; red in H'. +elim H'; intros H'0 H'1; red in H'0; clear H' H'1. +absurd (In U (Add U X0 x0) x); auto with sets. +lapply (Add_inv U X0 x0 x); [ intuition | apply (H'0 x); apply Add_intro2 ]. Qed. -Lemma cardinal_Empty : (m:nat)(cardinal U (Empty_set U) m) -> O = m. +Lemma cardinal_Empty : forall m:nat, cardinal U (Empty_set U) m -> 0 = m. Proof. -Intros m Cm; Generalize (cardinal_invert U (Empty_set U) m Cm). -Elim m; Auto with sets. -Intros; Elim H0; Intros; Elim H1; Intros; Elim H2; Intros. -Elim (not_Empty_Add U x x0 H3). +intros m Cm; generalize (cardinal_invert U (Empty_set U) m Cm). +elim m; auto with sets. +intros; elim H0; intros; elim H1; intros; elim H2; intros. +elim (not_Empty_Add U x x0 H3). Qed. Lemma cardinal_unicity : - (X: (Ensemble U)) (n: nat) (cardinal U X n) -> - (m: nat) (cardinal U X m) -> n = m. + forall (X:Ensemble U) (n:nat), + cardinal U X n -> forall m:nat, cardinal U X m -> n = m. Proof. -Intros; Apply cardinal_is_functional with X X; Auto with sets. +intros; apply cardinal_is_functional with X X; auto with sets. Qed. -Lemma card_Add_gen: - (A: (Ensemble U)) - (x: U) (n, n': nat) (cardinal U A n) -> (cardinal U (Add U A x) n') -> - (le n' (S n)). +Lemma card_Add_gen : + forall (A:Ensemble U) (x:U) (n n':nat), + cardinal U A n -> cardinal U (Add U A x) n' -> n' <= S n. Proof. -Intros A x n n' H'. -Elim (classic (In U A x)). -Intro H'0. -Rewrite (Non_disjoint_union U A x H'0). -Intro H'1; Cut n = n'. -Intro E; Rewrite E; Auto with sets. -Apply cardinal_unicity with A; Auto with sets. -Intros H'0 H'1. -Cut n'=(S n). -Intro E; Rewrite E; Auto with sets. -Apply cardinal_unicity with (Add U A x); Auto with sets. +intros A x n n' H'. +elim (classic (In U A x)). +intro H'0. +rewrite (Non_disjoint_union U A x H'0). +intro H'1; cut (n = n'). +intro E; rewrite E; auto with sets. +apply cardinal_unicity with A; auto with sets. +intros H'0 H'1. +cut (n' = S n). +intro E; rewrite E; auto with sets. +apply cardinal_unicity with (Add U A x); auto with sets. Qed. -Lemma incl_st_card_lt: - (X: (Ensemble U)) (c1: nat) (cardinal U X c1) -> - (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> (Strict_Included U X Y) -> - (gt c2 c1). +Lemma incl_st_card_lt : + forall (X:Ensemble U) (c1:nat), + cardinal U X c1 -> + forall (Y:Ensemble U) (c2:nat), + cardinal U Y c2 -> Strict_Included U X Y -> c2 > c1. Proof. -Intros X c1 H'; Elim H'. -Intros Y c2 H'0; Elim H'0; Auto with sets arith. -Intro H'1. -Elim (Strict_Included_strict U (Empty_set U)); Auto with sets arith. -Clear H' c1 X. -Intros X n H' H'0 x H'1 Y c2 H'2. -Elim H'2. -Intro H'3; Elim (not_SIncl_empty U (Add U X x)); Auto with sets arith. -Clear H'2 c2 Y. -Intros X0 c2 H'2 H'3 x0 H'4 H'5; Elim (classic (In U X0 x)). -Intro H'6; Apply gt_n_S. -Apply H'0 with Y := (Subtract U (Add U X0 x0) x). -ElimType (pred (S c2)) = c2; Auto with sets arith. -Apply card_soustr_1; Auto with sets arith. -Apply incl_st_add_soustr; Auto with sets arith. -Elim (classic x == x0). -Intros H'6 H'7; Apply gt_n_S. -Apply H'0 with Y := X0; Auto with sets arith. -Apply sincl_add_x with x := x0. -Rewrite <- H'6; Auto with sets arith. -Pattern 1 x0; Rewrite <- H'6; Trivial with sets arith. -Intros H'6 H'7; Red in H'5. -Elim H'5; Intros H'8 H'9; Try Exact H'8; Clear H'5. -Red in H'8. -Generalize (H'8 x). -Intro H'5; LApply H'5; Auto with sets arith. -Intro H; Elim Add_inv with U X0 x0 x; Auto with sets arith. -Intro; Absurd (In U X0 x); Auto with sets arith. -Intro; Absurd x==x0; Auto with sets arith. +intros X c1 H'; elim H'. +intros Y c2 H'0; elim H'0; auto with sets arith. +intro H'1. +elim (Strict_Included_strict U (Empty_set U)); auto with sets arith. +clear H' c1 X. +intros X n H' H'0 x H'1 Y c2 H'2. +elim H'2. +intro H'3; elim (not_SIncl_empty U (Add U X x)); auto with sets arith. +clear H'2 c2 Y. +intros X0 c2 H'2 H'3 x0 H'4 H'5; elim (classic (In U X0 x)). +intro H'6; apply gt_n_S. +apply H'0 with (Y := Subtract U (Add U X0 x0) x). +elimtype (pred (S c2) = c2); auto with sets arith. +apply card_soustr_1; auto with sets arith. +apply incl_st_add_soustr; auto with sets arith. +elim (classic (x = x0)). +intros H'6 H'7; apply gt_n_S. +apply H'0 with (Y := X0); auto with sets arith. +apply sincl_add_x with (x := x0). +rewrite <- H'6; auto with sets arith. +pattern x0 at 1 in |- *; rewrite <- H'6; trivial with sets arith. +intros H'6 H'7; red in H'5. +elim H'5; intros H'8 H'9; try exact H'8; clear H'5. +red in H'8. +generalize (H'8 x). +intro H'5; lapply H'5; auto with sets arith. +intro H; elim Add_inv with U X0 x0 x; auto with sets arith. +intro; absurd (In U X0 x); auto with sets arith. +intro; absurd (x = x0); auto with sets arith. Qed. -Lemma incl_card_le: - (X,Y: (Ensemble U)) (n,m: nat) (cardinal U X n) -> (cardinal U Y m) -> - (Included U X Y) -> (le n m). +Lemma incl_card_le : + forall (X Y:Ensemble U) (n m:nat), + cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m. Proof. -Intros; -Elim Included_Strict_Included with U X Y; Auto with sets arith; Intro. -Cut (gt m n); Auto with sets arith. -Apply incl_st_card_lt with X := X Y := Y; Auto with sets arith. -Generalize H0; Rewrite <- H2; Intro. -Cut n=m. -Intro E; Rewrite E; Auto with sets arith. -Apply cardinal_unicity with X; Auto with sets arith. +intros; elim Included_Strict_Included with U X Y; auto with sets arith; intro. +cut (m > n); auto with sets arith. +apply incl_st_card_lt with (X := X) (Y := Y); auto with sets arith. +generalize H0; rewrite <- H2; intro. +cut (n = m). +intro E; rewrite E; auto with sets arith. +apply cardinal_unicity with X; auto with sets arith. Qed. -Lemma G_aux: - (P:(Ensemble U) ->Prop) - ((X:(Ensemble U)) - (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) -> - (P (Empty_set U)). +Lemma G_aux : + forall P:Ensemble U -> Prop, + (forall X:Ensemble U, + Finite U X -> + (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> + P (Empty_set U). Proof. -Intros P H'; Try Assumption. -Apply H'; Auto with sets. -Clear H'; Auto with sets. -Intros Y H'; Try Assumption. -Red in H'. -Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'. -LApply (less_than_empty U Y); [Intro H'3; Try Exact H'3 | Assumption]. -Elim H'1; Auto with sets. +intros P H'; try assumption. +apply H'; auto with sets. +clear H'; auto with sets. +intros Y H'; try assumption. +red in H'. +elim H'; intros H'0 H'1; try exact H'1; clear H'. +lapply (less_than_empty U Y); [ intro H'3; try exact H'3 | assumption ]. +elim H'1; auto with sets. Qed. -Hints Unfold not. +Hint Unfold not. -Lemma Generalized_induction_on_finite_sets: - (P:(Ensemble U) ->Prop) - ((X:(Ensemble U)) - (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) -> - (X:(Ensemble U)) (Finite U X) ->(P X). +Lemma Generalized_induction_on_finite_sets : + forall P:Ensemble U -> Prop, + (forall X:Ensemble U, + Finite U X -> + (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> + forall X:Ensemble U, Finite U X -> P X. Proof. -Intros P H'0 X H'1. -Generalize P H'0; Clear H'0 P. -Elim H'1. -Intros P H'0. -Apply G_aux; Auto with sets. -Clear H'1 X. -Intros A H' H'0 x H'1 P H'3. -Cut (Y:(Ensemble U)) (Included U Y (Add U A x)) ->(P Y); Auto with sets. -Generalize H'1. -Apply H'0. -Intros X K H'5 L Y H'6; Apply H'3; Auto with sets. -Apply Finite_downward_closed with A := (Add U X x); Auto with sets. -Intros Y0 H'7. -Elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); Auto with sets. -Intros H'2 H'4. -Elim (Included_Add U Y0 X x); - [Intro H'14 | - Intro H'14; Elim H'14; Intros A' E; Elim E; Intros H'15 H'16; Clear E H'14 | - Idtac]; Auto with sets. -Elim (Included_Strict_Included U Y0 X); Auto with sets. -Intro H'9; Apply H'5 with Y := Y0; Auto with sets. -Intro H'9; Rewrite H'9. -Apply H'3; Auto with sets. -Intros Y1 H'8; Elim H'8. -Intros H'10 H'11; Apply H'5 with Y := Y1; Auto with sets. -Elim (Included_Strict_Included U A' X); Auto with sets. -Intro H'8; Apply H'5 with Y := A'; Auto with sets. -Rewrite <- H'15; Auto with sets. -Intro H'8. -Elim H'7. -Intros H'9 H'10; Apply H'10 Orelse Elim H'10; Try Assumption. -Generalize H'6. -Rewrite <- H'8. -Rewrite <- H'15; Auto with sets. +intros P H'0 X H'1. +generalize P H'0; clear H'0 P. +elim H'1. +intros P H'0. +apply G_aux; auto with sets. +clear H'1 X. +intros A H' H'0 x H'1 P H'3. +cut (forall Y:Ensemble U, Included U Y (Add U A x) -> P Y); auto with sets. +generalize H'1. +apply H'0. +intros X K H'5 L Y H'6; apply H'3; auto with sets. +apply Finite_downward_closed with (A := Add U X x); auto with sets. +intros Y0 H'7. +elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); + auto with sets. +intros H'2 H'4. +elim (Included_Add U Y0 X x); + [ intro H'14 + | intro H'14; elim H'14; intros A' E; elim E; intros H'15 H'16; clear E H'14 + | idtac ]; auto with sets. +elim (Included_Strict_Included U Y0 X); auto with sets. +intro H'9; apply H'5 with (Y := Y0); auto with sets. +intro H'9; rewrite H'9. +apply H'3; auto with sets. +intros Y1 H'8; elim H'8. +intros H'10 H'11; apply H'5 with (Y := Y1); auto with sets. +elim (Included_Strict_Included U A' X); auto with sets. +intro H'8; apply H'5 with (Y := A'); auto with sets. +rewrite <- H'15; auto with sets. +intro H'8. +elim H'7. +intros H'9 H'10; apply H'10 || elim H'10; try assumption. +generalize H'6. +rewrite <- H'8. +rewrite <- H'15; auto with sets. Qed. -End Finite_sets_facts. +End Finite_sets_facts.
\ No newline at end of file diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v index d5f42e3f9..85b83d3ab 100755 --- a/theories/Sets/Image.v +++ b/theories/Sets/Image.v @@ -39,161 +39,167 @@ Require Export Le. Require Export Finite_sets_facts. Section Image. -Variables U, V: Type. +Variables U V : Type. -Inductive Im [X:(Ensemble U); f:U -> V]: (Ensemble V) := - Im_intro: (x: U) (In ? X x) -> (y: V) y == (f x) -> (In ? (Im X f) y). +Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V := + Im_intro : forall x:U, In _ X x -> forall y:V, y = f x -> In _ (Im X f) y. -Lemma Im_def: - (X: (Ensemble U)) (f: U -> V) (x: U) (In ? X x) -> (In ? (Im X f) (f x)). +Lemma Im_def : + forall (X:Ensemble U) (f:U -> V) (x:U), In _ X x -> In _ (Im X f) (f x). Proof. -Intros X f x H'; Try Assumption. -Apply Im_intro with x := x; Auto with sets. +intros X f x H'; try assumption. +apply Im_intro with (x := x); auto with sets. Qed. -Hints Resolve Im_def. +Hint Resolve Im_def. -Lemma Im_add: - (X: (Ensemble U)) (x: U) (f: U -> V) - (Im (Add ? X x) f) == (Add ? (Im X f) (f x)). +Lemma Im_add : + forall (X:Ensemble U) (x:U) (f:U -> V), + Im (Add _ X x) f = Add _ (Im X f) (f x). Proof. -Intros X x f. -Apply Extensionality_Ensembles. -Split; Red; Intros x0 H'. -Elim H'; Intros. -Rewrite H0. -Elim Add_inv with U X x x1; Auto with sets. -NewDestruct 1; Auto with sets. -Elim Add_inv with V (Im X f) (f x) x0; Auto with sets. -NewDestruct 1 as [x0 H y H0]. -Rewrite H0; Auto with sets. -NewDestruct 1; Auto with sets. +intros X x f. +apply Extensionality_Ensembles. +split; red in |- *; intros x0 H'. +elim H'; intros. +rewrite H0. +elim Add_inv with U X x x1; auto with sets. +destruct 1; auto with sets. +elim Add_inv with V (Im X f) (f x) x0; auto with sets. +destruct 1 as [x0 H y H0]. +rewrite H0; auto with sets. +destruct 1; auto with sets. Qed. -Lemma image_empty: (f: U -> V) (Im (Empty_set U) f) == (Empty_set V). +Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V. Proof. -Intro f; Try Assumption. -Apply Extensionality_Ensembles. -Split; Auto with sets. -Red. -Intros x H'; Elim H'. -Intros x0 H'0; Elim H'0; Auto with sets. +intro f; try assumption. +apply Extensionality_Ensembles. +split; auto with sets. +red in |- *. +intros x H'; elim H'. +intros x0 H'0; elim H'0; auto with sets. Qed. -Hints Resolve image_empty. +Hint Resolve image_empty. -Lemma finite_image: - (X: (Ensemble U)) (f: U -> V) (Finite ? X) -> (Finite ? (Im X f)). +Lemma finite_image : + forall (X:Ensemble U) (f:U -> V), Finite _ X -> Finite _ (Im X f). Proof. -Intros X f H'; Elim H'. -Rewrite (image_empty f); Auto with sets. -Intros A H'0 H'1 x H'2; Clear H' X. -Rewrite (Im_add A x f); Auto with sets. -Apply Add_preserves_Finite; Auto with sets. +intros X f H'; elim H'. +rewrite (image_empty f); auto with sets. +intros A H'0 H'1 x H'2; clear H' X. +rewrite (Im_add A x f); auto with sets. +apply Add_preserves_Finite; auto with sets. Qed. -Hints Resolve finite_image. +Hint Resolve finite_image. -Lemma Im_inv: - (X: (Ensemble U)) (f: U -> V) (y: V) (In ? (Im X f) y) -> - (exT ? [x: U] (In ? X x) /\ (f x) == y). +Lemma Im_inv : + forall (X:Ensemble U) (f:U -> V) (y:V), + In _ (Im X f) y -> exists x : U | In _ X x /\ f x = y. Proof. -Intros X f y H'; Elim H'. -Intros x H'0 y0 H'1; Rewrite H'1. -Exists x; Auto with sets. +intros X f y H'; elim H'. +intros x H'0 y0 H'1; rewrite H'1. +exists x; auto with sets. Qed. -Definition injective := [f: U -> V] (x, y: U) (f x) == (f y) -> x == y. +Definition injective (f:U -> V) := forall x y:U, f x = f y -> x = y. -Lemma not_injective_elim: - (f: U -> V) ~ (injective f) -> - (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)). +Lemma not_injective_elim : + forall f:U -> V, + ~ injective f -> exists x : _ | ( exists y : _ | f x = f y /\ x <> y). Proof. -Unfold injective; Intros f H. -Cut (EXT x | ~ ((y: U) (f x) == (f y) -> x == y)). -2: Apply not_all_ex_not with P:=[x:U](y: U) (f x) == (f y) -> x == y; - Trivial with sets. -NewDestruct 1 as [x C]; Exists x. -Cut (EXT y | ~((f x)==(f y)->x==y)). -2: Apply not_all_ex_not with P:=[y:U](f x)==(f y)->x==y; Trivial with sets. -NewDestruct 1 as [y D]; Exists y. -Apply imply_to_and; Trivial with sets. +unfold injective in |- *; intros f H. +cut ( exists x : _ | ~ (forall y:U, f x = f y -> x = y)). +2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y); + trivial with sets. +destruct 1 as [x C]; exists x. +cut ( exists y : _ | ~ (f x = f y -> x = y)). +2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y); + trivial with sets. +destruct 1 as [y D]; exists y. +apply imply_to_and; trivial with sets. Qed. -Lemma cardinal_Im_intro: - (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) -> - (EX p: nat | (cardinal ? (Im A f) p)). +Lemma cardinal_Im_intro : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal _ A n -> exists p : nat | cardinal _ (Im A f) p. Proof. -Intros. -Apply finite_cardinal; Apply finite_image. -Apply cardinal_finite with n; Trivial with sets. +intros. +apply finite_cardinal; apply finite_image. +apply cardinal_finite with n; trivial with sets. Qed. -Lemma In_Image_elim: - (A: (Ensemble U)) (f: U -> V) (injective f) -> - (x: U) (In ? (Im A f) (f x)) -> (In ? A x). +Lemma In_Image_elim : + forall (A:Ensemble U) (f:U -> V), + injective f -> forall x:U, In _ (Im A f) (f x) -> In _ A x. Proof. -Intros. -Elim Im_inv with A f (f x); Trivial with sets. -Intros z C; Elim C; Intros InAz E. -Elim (H z x E); Trivial with sets. +intros. +elim Im_inv with A f (f x); trivial with sets. +intros z C; elim C; intros InAz E. +elim (H z x E); trivial with sets. Qed. -Lemma injective_preserves_cardinal: - (A: (Ensemble U)) (f: U -> V) (n: nat) (injective f) -> (cardinal ? A n) -> - (n': nat) (cardinal ? (Im A f) n') -> n' = n. +Lemma injective_preserves_cardinal : + forall (A:Ensemble U) (f:U -> V) (n:nat), + injective f -> + cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n. Proof. -NewInduction 2 as [|A n H'0 H'1 x H'2]; Auto with sets. -Rewrite (image_empty f). -Intros n' CE. -Apply cardinal_unicity with V (Empty_set V); Auto with sets. -Intro n'. -Rewrite (Im_add A x f). -Intro H'3. -Elim cardinal_Im_intro with A f n; Trivial with sets. -Intros i CI. -LApply (H'1 i); Trivial with sets. -Cut ~ (In ? (Im A f) (f x)). -Intros H0 H1. -Apply cardinal_unicity with V (Add ? (Im A f) (f x)); Trivial with sets. -Apply card_add; Auto with sets. -Rewrite <- H1; Trivial with sets. -Red; Intro; Apply H'2. -Apply In_Image_elim with f; Trivial with sets. +induction 2 as [| A n H'0 H'1 x H'2]; auto with sets. +rewrite (image_empty f). +intros n' CE. +apply cardinal_unicity with V (Empty_set V); auto with sets. +intro n'. +rewrite (Im_add A x f). +intro H'3. +elim cardinal_Im_intro with A f n; trivial with sets. +intros i CI. +lapply (H'1 i); trivial with sets. +cut (~ In _ (Im A f) (f x)). +intros H0 H1. +apply cardinal_unicity with V (Add _ (Im A f) (f x)); trivial with sets. +apply card_add; auto with sets. +rewrite <- H1; trivial with sets. +red in |- *; intro; apply H'2. +apply In_Image_elim with f; trivial with sets. Qed. -Lemma cardinal_decreases: - (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) -> - (n': nat) (cardinal V (Im A f) n') -> (le n' n). +Lemma cardinal_decreases : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n. Proof. -NewInduction 1 as [|A n H'0 H'1 x H'2]; Auto with sets. -Rewrite (image_empty f); Intros. -Cut n' = O. -Intro E; Rewrite E; Trivial with sets. -Apply cardinal_unicity with V (Empty_set V); Auto with sets. -Intro n'. -Rewrite (Im_add A x f). -Elim cardinal_Im_intro with A f n; Trivial with sets. -Intros p C H'3. -Apply le_trans with (S p). -Apply card_Add_gen with V (Im A f) (f x); Trivial with sets. -Apply le_n_S; Auto with sets. +induction 1 as [| A n H'0 H'1 x H'2]; auto with sets. +rewrite (image_empty f); intros. +cut (n' = 0). +intro E; rewrite E; trivial with sets. +apply cardinal_unicity with V (Empty_set V); auto with sets. +intro n'. +rewrite (Im_add A x f). +elim cardinal_Im_intro with A f n; trivial with sets. +intros p C H'3. +apply le_trans with (S p). +apply card_Add_gen with V (Im A f) (f x); trivial with sets. +apply le_n_S; auto with sets. Qed. -Theorem Pigeonhole: - (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) -> - (n': nat) (cardinal V (Im A f) n') -> (lt n' n) -> ~ (injective f). +Theorem Pigeonhole : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal U A n -> + forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f. Proof. -Unfold not; Intros A f n CAn n' CIfn' ltn'n I. -Cut n' = n. -Intro E; Generalize ltn'n; Rewrite E; Exact (lt_n_n n). -Apply injective_preserves_cardinal with A := A f := f n := n; Trivial with sets. +unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I. +cut (n' = n). +intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n). +apply injective_preserves_cardinal with (A := A) (f := f) (n := n); + trivial with sets. Qed. -Lemma Pigeonhole_principle: - (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) -> - (n': nat) (cardinal ? (Im A f) n') -> (lt n' n) -> - (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)). +Lemma Pigeonhole_principle : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal _ A n -> + forall n':nat, + cardinal _ (Im A f) n' -> + n' < n -> exists x : _ | ( exists y : _ | f x = f y /\ x <> y). Proof. -Intros; Apply not_injective_elim. -Apply Pigeonhole with A n n'; Trivial with sets. +intros; apply not_injective_elim. +apply Pigeonhole with A n n'; trivial with sets. Qed. End Image. -Hints Resolve Im_def image_empty finite_image : sets v62. +Hint Resolve Im_def image_empty finite_image: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v index c6233453a..20ec73fa6 100755 --- a/theories/Sets/Infinite_sets.v +++ b/theories/Sets/Infinite_sets.v @@ -40,193 +40,205 @@ Require Export Finite_sets_facts. Require Export Image. Section Approx. -Variable U: Type. +Variable U : Type. -Inductive Approximant [A, X:(Ensemble U)] : Prop := - Defn_of_Approximant: (Finite U X) -> (Included U X A) -> (Approximant A X). +Inductive Approximant (A X:Ensemble U) : Prop := + Defn_of_Approximant : Finite U X -> Included U X A -> Approximant A X. End Approx. -Hints Resolve Defn_of_Approximant. +Hint Resolve Defn_of_Approximant. Section Infinite_sets. -Variable U: Type. +Variable U : Type. -Lemma make_new_approximant: - (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> (Approximant U A X) -> - (Inhabited U (Setminus U A X)). +Lemma make_new_approximant : + forall A X:Ensemble U, + ~ Finite U A -> Approximant U A X -> Inhabited U (Setminus U A X). Proof. -Intros A X H' H'0. -Elim H'0; Intros H'1 H'2. -Apply Strict_super_set_contains_new_element; Auto with sets. -Red; Intro H'3; Apply H'. -Rewrite <- H'3; Auto with 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'. +rewrite <- H'3; auto with sets. Qed. -Lemma approximants_grow: - (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> - (n: nat) (cardinal U X n) -> (Included U X A) -> - (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)). +Lemma approximants_grow : + forall A X:Ensemble U, + ~ Finite U A -> + forall n:nat, + cardinal U X n -> + Included U X A -> exists Y : _ | cardinal U Y (S n) /\ Included U Y A. Proof. -Intros A X H' n H'0; Elim H'0; Auto with sets. -Intro H'1. -Cut (Inhabited U (Setminus U A (Empty_set U))). -Intro H'2; Elim H'2. -Intros x H'3. -Exists (Add U (Empty_set U) x); Auto with sets. -Split. -Apply card_add; Auto with sets. -Cut (In U A x). -Intro H'4; Red; Auto with sets. -Intros x0 H'5; Elim H'5; Auto with sets. -Intros x1 H'6; Elim H'6; Auto with sets. -Elim H'3; Auto with sets. -Apply make_new_approximant; Auto with sets. -Intros A0 n0 H'1 H'2 x H'3 H'5. -LApply H'2; [Intro H'6; Elim H'6; Clear H'2 | Clear H'2]; Auto with sets. -Intros x0 H'2; Try Assumption. -Elim H'2; Intros H'7 H'8; Try Exact H'8; Clear H'2. -Elim (make_new_approximant A x0); Auto with sets. -Intros x1 H'2; Try Assumption. -Exists (Add U x0 x1); Auto with sets. -Split. -Apply card_add; Auto with sets. -Elim H'2; Auto with sets. -Red. -Intros x2 H'9; Elim H'9; Auto with sets. -Intros x3 H'10; Elim H'10; Auto with sets. -Elim H'2; Auto with sets. -Auto with sets. -Apply Defn_of_Approximant; Auto with sets. -Apply cardinal_finite with n := (S n0); Auto with sets. +intros A X H' n H'0; elim H'0; auto with sets. +intro H'1. +cut (Inhabited U (Setminus U A (Empty_set U))). +intro H'2; elim H'2. +intros x H'3. +exists (Add U (Empty_set U) x); auto with sets. +split. +apply card_add; auto with sets. +cut (In U A x). +intro H'4; red in |- *; auto with sets. +intros x0 H'5; elim H'5; auto with sets. +intros x1 H'6; elim H'6; auto with sets. +elim H'3; auto with sets. +apply make_new_approximant; auto with sets. +intros A0 n0 H'1 H'2 x H'3 H'5. +lapply H'2; [ intro H'6; elim H'6; clear H'2 | clear H'2 ]; auto with sets. +intros x0 H'2; try assumption. +elim H'2; intros H'7 H'8; try exact H'8; clear H'2. +elim (make_new_approximant A x0); auto with sets. +intros x1 H'2; try assumption. +exists (Add U x0 x1); auto with sets. +split. +apply card_add; auto with sets. +elim H'2; auto with sets. +red in |- *. +intros x2 H'9; elim H'9; auto with sets. +intros x3 H'10; elim H'10; auto with sets. +elim H'2; auto with sets. +auto with sets. +apply Defn_of_Approximant; auto with sets. +apply cardinal_finite with (n := S n0); auto with sets. Qed. -Lemma approximants_grow': - (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> - (n: nat) (cardinal U X n) -> (Approximant U A X) -> - (EXT Y | (cardinal U Y (S n)) /\ (Approximant U A Y)). +Lemma approximants_grow' : + forall A X:Ensemble U, + ~ Finite U A -> + forall n:nat, + cardinal U X n -> + Approximant U A X -> + exists Y : _ | cardinal U Y (S n) /\ Approximant U A Y. Proof. -Intros A X H' n H'0 H'1; Try Assumption. -Elim H'1. -Intros H'2 H'3. -ElimType (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)). -Intros x H'4; Elim H'4; Intros H'5 H'6; Try Exact H'5; Clear H'4. -Exists x; Auto with sets. -Split; [Auto with sets | Idtac]. -Apply Defn_of_Approximant; Auto with sets. -Apply cardinal_finite with n := (S n); Auto with sets. -Apply approximants_grow with X := X; Auto with sets. +intros A X H' n H'0 H'1; try assumption. +elim H'1. +intros H'2 H'3. +elimtype ( exists Y : _ | cardinal U Y (S n) /\ Included U Y A). +intros x H'4; elim H'4; intros H'5 H'6; try exact H'5; clear H'4. +exists x; auto with sets. +split; [ auto with sets | idtac ]. +apply Defn_of_Approximant; auto with sets. +apply cardinal_finite with (n := S n); auto with sets. +apply approximants_grow with (X := X); auto with sets. Qed. -Lemma approximant_can_be_any_size: - (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> - (n: nat) (EXT Y | (cardinal U Y n) /\ (Approximant U A Y)). +Lemma approximant_can_be_any_size : + forall A X:Ensemble U, + ~ Finite U A -> + forall n:nat, exists Y : _ | cardinal U Y n /\ Approximant U A Y. Proof. -Intros A H' H'0 n; Elim n. -Exists (Empty_set U); Auto with sets. -Intros n0 H'1; Elim H'1. -Intros x H'2. -Apply approximants_grow' with X := x; Tauto. +intros A H' H'0 n; elim n. +exists (Empty_set U); auto with sets. +intros n0 H'1; elim H'1. +intros x H'2. +apply approximants_grow' with (X := x); tauto. Qed. -Variable V: Type. +Variable V : Type. -Theorem Image_set_continuous: - (A: (Ensemble U)) - (f: U -> V) (X: (Ensemble V)) (Finite V X) -> (Included V X (Im U V A f)) -> - (EX n | - (EXT Y | ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)). +Theorem Image_set_continuous : + forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), + Finite V X -> + Included V X (Im U V A f) -> + exists n : _ + | ( exists Y : _ | (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X). Proof. -Intros A f X H'; Elim H'. -Intro H'0; Exists O. -Exists (Empty_set U); Auto with sets. -Intros A0 H'0 H'1 x H'2 H'3; Try Assumption. -LApply H'1; - [Intro H'4; Elim H'4; Intros n E; Elim E; Clear H'4 H'1 | Clear H'1]; Auto with sets. -Intros x0 H'1; Try Assumption. -Exists (S n); Try Assumption. -Elim H'1; Intros H'4 H'5; Elim H'4; Intros H'6 H'7; Try Exact H'6; Clear H'4 H'1. -Clear E. -Generalize H'2. -Rewrite <- H'5. -Intro H'1; Try Assumption. -Red in H'3. -Generalize (H'3 x). -Intro H'4; LApply H'4; [Intro H'8; Try Exact H'8; Clear H'4 | Clear H'4]; Auto with sets. -Specialize 5 Im_inv with U := U V:=V X := A f := f y := x; Intro H'11; - LApply H'11; [Intro H'13; Elim H'11; Clear H'11 | Clear H'11]; Auto with sets. -Intros x1 H'4; Try Assumption. -Apply exT_intro with x := (Add U x0 x1). -Split; [Split; [Try Assumption | Idtac] | Idtac]. -Apply card_add; Auto with sets. -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; Auto with sets. -Intros x2 H'4; Elim H'4; Auto with sets. -Intros x3 H'11; Elim H'11; Auto with sets. -Elim H'4; Intros H'9 H'10; Rewrite <- H'10; Clear H'4; Auto with sets. -Apply Im_add; Auto with sets. +intros A f X H'; elim H'. +intro H'0; exists 0. +exists (Empty_set U); auto with sets. +intros A0 H'0 H'1 x H'2 H'3; try assumption. +lapply H'1; + [ intro H'4; elim H'4; intros n E; elim E; clear H'4 H'1 | clear H'1 ]; + auto with sets. +intros x0 H'1; try assumption. +exists (S n); try assumption. +elim H'1; intros H'4 H'5; elim H'4; intros H'6 H'7; try exact H'6; + clear H'4 H'1. +clear E. +generalize H'2. +rewrite <- H'5. +intro H'1; try assumption. +red in H'3. +generalize (H'3 x). +intro H'4; lapply H'4; [ intro H'8; try exact H'8; clear H'4 | clear H'4 ]; + auto with sets. +specialize 5Im_inv with (U := U) (V := V) (X := A) (f := f) (y := x); + intro H'11; lapply H'11; [ intro H'13; elim H'11; clear H'11 | clear H'11 ]; + auto with sets. +intros x1 H'4; try assumption. +apply ex_intro with (x := Add U x0 x1). +split; [ split; [ try assumption | idtac ] | idtac ]. +apply card_add; auto with sets. +red in |- *; intro H'9; try exact H'9. +apply H'1. +elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets. +elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets. +red in |- *; auto with sets. +intros x2 H'4; elim H'4; auto with sets. +intros x3 H'11; elim H'11; auto with sets. +elim H'4; intros H'9 H'10; rewrite <- H'10; clear H'4; auto with sets. +apply Im_add; auto with sets. Qed. -Theorem Image_set_continuous': - (A: (Ensemble U)) - (f: U -> V) (X: (Ensemble V)) (Approximant V (Im U V A f) X) -> - (EXT Y | (Approximant U A Y) /\ (Im U V Y f) == X). +Theorem Image_set_continuous' : + forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), + Approximant V (Im U V A f) X -> + exists Y : _ | Approximant U A Y /\ Im U V Y f = X. Proof. -Intros A f X H'; Try Assumption. -Cut (EX n | (EXT Y | - ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)). -Intro H'0; Elim H'0; Intros n E; Elim E; Clear H'0. -Intros x H'0; Try Assumption. -Elim H'0; Intros H'1 H'2; Elim H'1; Intros H'3 H'4; Try Exact H'3; - Clear H'1 H'0; Auto with sets. -Exists x. -Split; [Idtac | Try Assumption]. -Apply Defn_of_Approximant; Auto with sets. -Apply cardinal_finite with n := n; Auto with sets. -Apply Image_set_continuous; Auto with sets. -Elim H'; Auto with sets. -Elim H'; Auto with sets. +intros A f X H'; try assumption. +cut + ( exists n : _ + | ( exists Y : _ | (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X)). +intro H'0; elim H'0; intros n E; elim E; clear H'0. +intros x H'0; try assumption. +elim H'0; intros H'1 H'2; elim H'1; intros H'3 H'4; try exact H'3; + clear H'1 H'0; auto with sets. +exists x. +split; [ idtac | try assumption ]. +apply Defn_of_Approximant; auto with sets. +apply cardinal_finite with (n := n); auto with sets. +apply Image_set_continuous; auto with sets. +elim H'; auto with sets. +elim H'; auto with sets. Qed. -Theorem Pigeonhole_bis: - (A: (Ensemble U)) (f: U -> V) ~ (Finite U A) -> (Finite V (Im U V A f)) -> - ~ (injective U V f). +Theorem Pigeonhole_bis : + forall (A:Ensemble U) (f:U -> V), + ~ Finite U A -> Finite V (Im U V A f) -> ~ injective U V f. Proof. -Intros A f H'0 H'1; Try Assumption. -Elim (Image_set_continuous' A f (Im U V A f)); Auto with sets. -Intros x H'2; Elim H'2; Intros H'3 H'4; Try Exact H'3; Clear H'2. -Elim (make_new_approximant A x); Auto with sets. -Intros x0 H'2; Elim H'2. -Intros H'5 H'6. -Elim (finite_cardinal V (Im U V A f)); Auto with sets. -Intros n E. -Elim (finite_cardinal U x); Auto with sets. -Intros n0 E0. -Apply Pigeonhole with A := (Add U x x0) n := (S n0) n' := n. -Apply card_add; Auto with sets. -Rewrite (Im_add U V x x0 f); Auto with sets. -Cut (In V (Im U V x f) (f x0)). -Intro H'8. -Rewrite (Non_disjoint_union V (Im U V x f) (f x0)); Auto with sets. -Rewrite H'4; Auto with sets. -Elim (Extension V (Im U V x f) (Im U V A f)); Auto with sets. -Apply le_lt_n_Sm. -Apply cardinal_decreases with U := U V := V A := x f := f; Auto with sets. -Rewrite H'4; Auto with sets. -Elim H'3; Auto with sets. +intros A f H'0 H'1; try assumption. +elim (Image_set_continuous' A f (Im U V A f)); auto with sets. +intros x H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. +elim (make_new_approximant A x); auto with sets. +intros x0 H'2; elim H'2. +intros H'5 H'6. +elim (finite_cardinal V (Im U V A f)); auto with sets. +intros n E. +elim (finite_cardinal U x); auto with sets. +intros n0 E0. +apply Pigeonhole with (A := Add U x x0) (n := S n0) (n' := n). +apply card_add; auto with sets. +rewrite (Im_add U V x x0 f); auto with sets. +cut (In V (Im U V x f) (f x0)). +intro H'8. +rewrite (Non_disjoint_union V (Im U V x f) (f x0)); auto with sets. +rewrite H'4; auto with sets. +elim (Extension V (Im U V x f) (Im U V A f)); auto with sets. +apply le_lt_n_Sm. +apply cardinal_decreases with (U := U) (V := V) (A := x) (f := f); + auto with sets. +rewrite H'4; auto with sets. +elim H'3; auto with sets. Qed. -Theorem Pigeonhole_ter: - (A: (Ensemble U)) - (f: U -> V) (n: nat) (injective U V f) -> (Finite V (Im U V A f)) -> - (Finite U A). +Theorem Pigeonhole_ter : + forall (A:Ensemble U) (f:U -> V) (n:nat), + injective U V f -> Finite V (Im U V A f) -> Finite U A. Proof. -Intros A f H' H'0 H'1. -Apply NNPP. -Red; Intro H'2. -Elim (Pigeonhole_bis A f); Auto with sets. +intros A f H' H'0 H'1. +apply NNPP. +red in |- *; intro H'2. +elim (Pigeonhole_bis A f); auto with sets. Qed. -End Infinite_sets. +End Infinite_sets.
\ No newline at end of file diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v index dbfc6b463..7f8e1695a 100755 --- a/theories/Sets/Integers.v +++ b/theories/Sets/Integers.v @@ -46,116 +46,118 @@ Require Export Cpo. Section Integers_sect. -Inductive Integers : (Ensemble nat) := - Integers_defn: (x: nat) (In nat Integers x). -Hints Resolve Integers_defn. +Inductive Integers : Ensemble nat := + Integers_defn : forall x:nat, In nat Integers x. +Hint Resolve Integers_defn. -Lemma le_reflexive: (Reflexive nat le). +Lemma le_reflexive : Reflexive nat le. Proof. -Red; Auto with arith. +red in |- *; auto with arith. Qed. -Lemma le_antisym: (Antisymmetric nat le). +Lemma le_antisym : Antisymmetric nat le. Proof. -Red; Intros x y H H';Rewrite (le_antisym x y);Auto. +red in |- *; intros x y H H'; rewrite (le_antisym x y); auto. Qed. -Lemma le_trans: (Transitive nat le). +Lemma le_trans : Transitive nat le. Proof. -Red; Intros; Apply le_trans with y;Auto. +red in |- *; intros; apply le_trans with y; auto. Qed. -Hints Resolve le_reflexive le_antisym le_trans. +Hint Resolve le_reflexive le_antisym le_trans. -Lemma le_Order: (Order nat le). +Lemma le_Order : Order nat le. Proof. -Auto with sets arith. +auto with sets arith. Qed. -Hints Resolve le_Order. +Hint Resolve le_Order. -Lemma triv_nat: (n: nat) (In nat Integers n). +Lemma triv_nat : forall n:nat, In nat Integers n. Proof. -Auto with sets arith. +auto with sets arith. Qed. -Hints Resolve triv_nat. +Hint Resolve triv_nat. -Definition nat_po: (PO nat). -Apply Definition_of_PO with Carrier_of := Integers Rel_of := le; Auto with sets arith. -Apply Inhabited_intro with x := O; Auto with sets arith. +Definition nat_po : PO nat. +apply Definition_of_PO with (Carrier_of := Integers) (Rel_of := le); + auto with sets arith. +apply Inhabited_intro with (x := 0); auto with sets arith. Defined. -Hints Unfold nat_po. +Hint Unfold nat_po. -Lemma le_total_order: (Totally_ordered nat nat_po Integers). +Lemma le_total_order : Totally_ordered nat nat_po Integers. Proof. -Apply Totally_ordered_definition. -Simpl. -Intros H' x y H'0. -Specialize 2 le_or_lt with n := x m := y; Intro H'2; Elim H'2. -Intro H'1; Left; Auto with sets arith. -Intro H'1; Right. -Cut (le y x); Auto with sets arith. +apply Totally_ordered_definition. +simpl in |- *. +intros H' x y H'0. +specialize 2le_or_lt with (n := x) (m := y); intro H'2; elim H'2. +intro H'1; left; auto with sets arith. +intro H'1; right. +cut (y <= x); auto with sets arith. Qed. -Hints Resolve le_total_order. +Hint Resolve le_total_order. -Lemma Finite_subset_has_lub: - (X: (Ensemble nat)) (Finite nat X) -> - (EXT m: nat | (Upper_Bound nat nat_po X m)). +Lemma Finite_subset_has_lub : + forall X:Ensemble nat, + Finite nat X -> exists m : nat | Upper_Bound nat nat_po X m. Proof. -Intros X H'; Elim H'. -Exists O. -Apply Upper_Bound_definition; Auto with sets arith. -Intros y H'0; Elim H'0; Auto with sets arith. -Intros A H'0 H'1 x H'2; Try Assumption. -Elim H'1; Intros x0 H'3; Clear H'1. -Elim le_total_order. -Simpl. -Intro H'1; Try Assumption. -LApply H'1; [Intro H'4; Idtac | Try Assumption]; Auto with sets arith. -Generalize (H'4 x0 x). -Clear H'4. -Clear H'1. -Intro H'1; LApply H'1; - [Intro H'4; Elim H'4; - [Intro H'5; Try Exact H'5; Clear H'4 H'1 | Intro H'5; Clear H'4 H'1] | - Clear H'1]. -Exists x. -Apply Upper_Bound_definition; Auto with sets arith; Simpl. -Intros y H'1; Elim H'1. -Generalize le_trans. -Intro H'4; Red in H'4. -Intros x1 H'6; Try Assumption. -Apply H'4 with y := x0; Auto with sets arith. -Elim H'3; Simpl; Auto with sets arith. -Intros x1 H'4; Elim H'4; Auto with sets arith. -Exists x0. -Apply Upper_Bound_definition; Auto with sets arith; Simpl. -Intros y H'1; Elim H'1. -Intros x1 H'4; Try Assumption. -Elim H'3; Simpl; Auto with sets arith. -Intros x1 H'4; Elim H'4; Auto with sets arith. -Red. -Intros x1 H'1; Elim H'1; Auto with sets arith. +intros X H'; elim H'. +exists 0. +apply Upper_Bound_definition; auto with sets arith. +intros y H'0; elim H'0; auto with sets arith. +intros A H'0 H'1 x H'2; try assumption. +elim H'1; intros x0 H'3; clear H'1. +elim le_total_order. +simpl in |- *. +intro H'1; try assumption. +lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith. +generalize (H'4 x0 x). +clear H'4. +clear H'1. +intro H'1; lapply H'1; + [ intro H'4; elim H'4; + [ intro H'5; try exact H'5; clear H'4 H'1 | intro H'5; clear H'4 H'1 ] + | clear H'1 ]. +exists x. +apply Upper_Bound_definition; auto with sets arith; simpl in |- *. +intros y H'1; elim H'1. +generalize le_trans. +intro H'4; red in H'4. +intros x1 H'6; try assumption. +apply H'4 with (y := x0); auto with sets arith. +elim H'3; simpl in |- *; auto with sets arith. +intros x1 H'4; elim H'4; auto with sets arith. +exists x0. +apply Upper_Bound_definition; auto with sets arith; simpl in |- *. +intros y H'1; elim H'1. +intros x1 H'4; try assumption. +elim H'3; simpl in |- *; auto with sets arith. +intros x1 H'4; elim H'4; auto with sets arith. +red in |- *. +intros x1 H'1; elim H'1; auto with sets arith. Qed. -Lemma Integers_has_no_ub: ~ (EXT m:nat | (Upper_Bound nat nat_po Integers m)). +Lemma Integers_has_no_ub : + ~ ( exists m : nat | Upper_Bound nat nat_po Integers m). Proof. -Red; Intro H'; Elim H'. -Intros x H'0. -Elim H'0; Intros H'1 H'2. -Cut (In nat Integers (S x)). -Intro H'3. -Specialize 1 H'2 with y := (S x); Intro H'4; LApply H'4; - [Intro H'5; Clear H'4 | Try Assumption; Clear H'4]. -Simpl in H'5. -Absurd (le (S x) x); Auto with arith. -Auto with sets arith. +red in |- *; intro H'; elim H'. +intros x H'0. +elim H'0; intros H'1 H'2. +cut (In nat Integers (S x)). +intro H'3. +specialize 1H'2 with (y := S x); intro H'4; lapply H'4; + [ intro H'5; clear H'4 | try assumption; clear H'4 ]. +simpl in H'5. +absurd (S x <= x); auto with arith. +auto with sets arith. Qed. -Lemma Integers_infinite: ~ (Finite nat Integers). +Lemma Integers_infinite : ~ Finite nat Integers. Proof. -Generalize Integers_has_no_ub. -Intro H'; Red; Intro H'0; Try Exact H'0. -Apply H'. -Apply Finite_subset_has_lub; Auto with sets arith. +generalize Integers_has_no_ub. +intro H'; red in |- *; intro H'0; try exact H'0. +apply H'. +apply Finite_subset_has_lub; auto with sets arith. Qed. End Integers_sect. @@ -163,4 +165,3 @@ End Integers_sect. - diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v index 37fb47e27..a3ae98d0a 100755 --- a/theories/Sets/Multiset.v +++ b/theories/Sets/Multiset.v @@ -10,7 +10,7 @@ (* G. Huet 1-9-95 *) -Require Permut. +Require Import Permut. Set Implicit Arguments. @@ -18,155 +18,159 @@ Section multiset_defs. Variable A : Set. Variable eqA : A -> A -> Prop. -Hypothesis Aeq_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}. +Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}. -Inductive multiset : Set := - Bag : (A->nat) -> multiset. +Inductive multiset : Set := + Bag : (A -> nat) -> multiset. -Definition EmptyBag := (Bag [a:A]O). -Definition SingletonBag := [a:A] - (Bag [a':A]Cases (Aeq_dec a a') of - (left _) => (S O) - | (right _) => O - end - ). +Definition EmptyBag := Bag (fun a:A => 0). +Definition SingletonBag (a:A) := + Bag (fun a':A => match Aeq_dec a a' with + | left _ => 1 + | right _ => 0 + end). -Definition multiplicity : multiset -> A -> nat := - [m:multiset][a:A]let (f) = m in (f a). +Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a. (** multiset equality *) -Definition meq := [m1,m2:multiset] - (a:A)(multiplicity m1 a)=(multiplicity m2 a). +Definition meq (m1 m2:multiset) := + forall a:A, multiplicity m1 a = multiplicity m2 a. -Hints Unfold meq multiplicity. +Hint Unfold meq multiplicity. -Lemma meq_refl : (x:multiset)(meq x x). +Lemma meq_refl : forall x:multiset, meq x x. Proof. -NewDestruct x; Auto. +destruct x; auto. Qed. -Hints Resolve meq_refl. +Hint Resolve meq_refl. -Lemma meq_trans : (x,y,z:multiset)(meq x y)->(meq y z)->(meq x z). +Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z. Proof. -Unfold meq. -NewDestruct x; NewDestruct y; NewDestruct z. -Intros; Rewrite H; Auto. +unfold meq in |- *. +destruct x; destruct y; destruct z. +intros; rewrite H; auto. Qed. -Lemma meq_sym : (x,y:multiset)(meq x y)->(meq y x). +Lemma meq_sym : forall x y:multiset, meq x y -> meq y x. Proof. -Unfold meq. -NewDestruct x; NewDestruct y; Auto. +unfold meq in |- *. +destruct x; destruct y; auto. Qed. -Hints Immediate meq_sym. +Hint Immediate meq_sym. (** multiset union *) -Definition munion := [m1,m2:multiset] - (Bag [a:A](plus (multiplicity m1 a)(multiplicity m2 a))). +Definition munion (m1 m2:multiset) := + Bag (fun a:A => multiplicity m1 a + multiplicity m2 a). -Lemma munion_empty_left : - (x:multiset)(meq x (munion EmptyBag x)). +Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x). Proof. -Unfold meq; Unfold munion; Simpl; Auto. +unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. Qed. -Hints Resolve munion_empty_left. +Hint Resolve munion_empty_left. -Lemma munion_empty_right : - (x:multiset)(meq x (munion x EmptyBag)). +Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag). Proof. -Unfold meq; Unfold munion; Simpl; Auto. +unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. Qed. -Require Plus. (* comm. and ass. of plus *) +Require Import Plus. (* comm. and ass. of plus *) -Lemma munion_comm : (x,y:multiset)(meq (munion x y) (munion y x)). +Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x). Proof. -Unfold meq; Unfold multiplicity; Unfold munion. -NewDestruct x; NewDestruct y; Auto with arith. +unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *. +destruct x; destruct y; auto with arith. Qed. -Hints Resolve munion_comm. +Hint Resolve munion_comm. -Lemma munion_ass : - (x,y,z:multiset)(meq (munion (munion x y) z) (munion x (munion y z))). +Lemma munion_ass : + forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)). Proof. -Unfold meq; Unfold munion; Unfold multiplicity. -NewDestruct x; NewDestruct y; NewDestruct z; Auto with arith. +unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. +destruct x; destruct y; destruct z; auto with arith. Qed. -Hints Resolve munion_ass. +Hint Resolve munion_ass. -Lemma meq_left : (x,y,z:multiset)(meq x y)->(meq (munion x z) (munion y z)). +Lemma meq_left : + forall x y z:multiset, meq x y -> meq (munion x z) (munion y z). Proof. -Unfold meq; Unfold munion; Unfold multiplicity. -NewDestruct x; NewDestruct y; NewDestruct z. -Intros; Elim H; Auto with arith. +unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. +destruct x; destruct y; destruct z. +intros; elim H; auto with arith. Qed. -Hints Resolve meq_left. +Hint Resolve meq_left. -Lemma meq_right : (x,y,z:multiset)(meq x y)->(meq (munion z x) (munion z y)). +Lemma meq_right : + forall x y z:multiset, meq x y -> meq (munion z x) (munion z y). Proof. -Unfold meq; Unfold munion; Unfold multiplicity. -NewDestruct x; NewDestruct y; NewDestruct z. -Intros; Elim H; Auto. +unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. +destruct x; destruct y; destruct z. +intros; elim H; auto. Qed. -Hints Resolve meq_right. +Hint Resolve meq_right. (** Here we should make multiset an abstract datatype, by hiding [Bag], [munion], [multiplicity]; all further properties are proved abstractly *) Lemma munion_rotate : - (x,y,z:multiset)(meq (munion x (munion y z)) (munion z (munion x y))). + forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)). Proof. -Intros; Apply (op_rotate multiset munion meq); Auto. -Exact meq_trans. +intros; apply (op_rotate multiset munion meq); auto. +exact meq_trans. Qed. -Lemma meq_congr : (x,y,z,t:multiset)(meq x y)->(meq z t)-> - (meq (munion x z) (munion y t)). +Lemma meq_congr : + forall x y z t:multiset, meq x y -> meq z t -> meq (munion x z) (munion y t). Proof. -Intros; Apply (cong_congr multiset munion meq); Auto. -Exact meq_trans. +intros; apply (cong_congr multiset munion meq); auto. +exact meq_trans. Qed. Lemma munion_perm_left : - (x,y,z:multiset)(meq (munion x (munion y z)) (munion y (munion x z))). + forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)). Proof. -Intros; Apply (perm_left multiset munion meq); Auto. -Exact meq_trans. +intros; apply (perm_left multiset munion meq); auto. +exact meq_trans. Qed. -Lemma multiset_twist1 : (x,y,z,t:multiset) - (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z)). +Lemma multiset_twist1 : + forall x y z t:multiset, + meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z). Proof. -Intros; Apply (twist multiset munion meq); Auto. -Exact meq_trans. +intros; apply (twist multiset munion meq); auto. +exact meq_trans. Qed. -Lemma multiset_twist2 : (x,y,z,t:multiset) - (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t)). +Lemma multiset_twist2 : + forall x y z t:multiset, + meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t). Proof. -Intros; Apply meq_trans with (munion (munion x (munion y z)) t). -Apply meq_sym; Apply munion_ass. -Apply meq_left; Apply munion_perm_left. +intros; apply meq_trans with (munion (munion x (munion y z)) t). +apply meq_sym; apply munion_ass. +apply meq_left; apply munion_perm_left. Qed. (** specific for treesort *) -Lemma treesort_twist1 : (x,y,z,t,u:multiset) (meq u (munion y z)) -> - (meq (munion x (munion u t)) (munion (munion y (munion x t)) z)). +Lemma treesort_twist1 : + forall x y z t u:multiset, + meq u (munion y z) -> + meq (munion x (munion u t)) (munion (munion y (munion x t)) z). Proof. -Intros; Apply meq_trans with (munion x (munion (munion y z) t)). -Apply meq_right; Apply meq_left; Trivial. -Apply multiset_twist1. +intros; apply meq_trans with (munion x (munion (munion y z) t)). +apply meq_right; apply meq_left; trivial. +apply multiset_twist1. Qed. -Lemma treesort_twist2 : (x,y,z,t,u:multiset) (meq u (munion y z)) -> - (meq (munion x (munion u t)) (munion (munion y (munion x z)) t)). +Lemma treesort_twist2 : + forall x y z t u:multiset, + meq u (munion y z) -> + meq (munion x (munion u t)) (munion (munion y (munion x z)) t). Proof. -Intros; Apply meq_trans with (munion x (munion (munion y z) t)). -Apply meq_right; Apply meq_left; Trivial. -Apply multiset_twist2. +intros; apply meq_trans with (munion x (munion (munion y z) t)). +apply meq_right; apply meq_left; trivial. +apply multiset_twist2. Qed. @@ -181,6 +185,7 @@ End multiset_defs. Unset Implicit Arguments. -Hints Unfold meq multiplicity : v62 datatypes. -Hints Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left : v62 datatypes. -Hints Immediate meq_sym : v62 datatypes. +Hint Unfold meq multiplicity: v62 datatypes. +Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right + munion_empty_left: v62 datatypes. +Hint Immediate meq_sym: v62 datatypes.
\ No newline at end of file diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v index f3d692b85..5ef6bc9b0 100755 --- a/theories/Sets/Partial_Order.v +++ b/theories/Sets/Partial_Order.v @@ -30,71 +30,71 @@ Require Export Ensembles. Require Export Relations_1. Section Partial_orders. -Variable U: Type. +Variable U : Type. -Definition Carrier := (Ensemble U). +Definition Carrier := Ensemble U. -Definition Rel := (Relation U). +Definition Rel := Relation U. -Record PO : Type := Definition_of_PO { - Carrier_of: (Ensemble U); - Rel_of: (Relation U); - PO_cond1: (Inhabited U Carrier_of); - PO_cond2: (Order U Rel_of) }. -Variable p: PO. +Record PO : Type := Definition_of_PO + {Carrier_of : Ensemble U; + Rel_of : Relation U; + PO_cond1 : Inhabited U Carrier_of; + PO_cond2 : Order U Rel_of}. +Variable p : PO. -Definition Strict_Rel_of : Rel := [x, y: U] (Rel_of p x y) /\ ~ x == y. +Definition Strict_Rel_of : Rel := fun x y:U => Rel_of p x y /\ x <> y. -Inductive covers [y, x:U]: Prop := - Definition_of_covers: - (Strict_Rel_of x y) -> - ~ (EXT z | (Strict_Rel_of x z) /\ (Strict_Rel_of z y)) -> - (covers y x). +Inductive covers (y x:U) : Prop := + Definition_of_covers : + Strict_Rel_of x y -> + ~ ( exists z : _ | Strict_Rel_of x z /\ Strict_Rel_of z y) -> + covers y x. End Partial_orders. -Hints Unfold Carrier_of Rel_of Strict_Rel_of : sets v62. -Hints Resolve Definition_of_covers : sets v62. +Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets v62. +Hint Resolve Definition_of_covers: sets v62. Section Partial_order_facts. -Variable U:Type. -Variable D:(PO U). +Variable U : Type. +Variable D : PO U. -Lemma Strict_Rel_Transitive_with_Rel: - (x:U) (y:U) (z:U) (Strict_Rel_of U D x y) -> (Rel_of U D y z) -> - (Strict_Rel_of U D x z). -Unfold 1 Strict_Rel_of. -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; 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. +Lemma Strict_Rel_Transitive_with_Rel : + forall x y z:U, + Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z. +unfold Strict_Rel_of at 1 in |- *. +red in |- *. +elim D; simpl in |- *. +intros C R H' H'0; elim H'0. +intros H'1 H'2 H'3 x y z H'4 H'5; split. +apply H'2 with (y := y); tauto. +red in |- *; intro H'6. +elim H'4; intros H'7 H'8; apply H'8; clear H'4. +apply H'3; auto. +rewrite H'6; tauto. Qed. -Lemma Strict_Rel_Transitive_with_Rel_left: - (x:U) (y:U) (z:U) (Rel_of U D x y) -> (Strict_Rel_of U D y z) -> - (Strict_Rel_of U D x z). -Unfold 1 Strict_Rel_of. -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; 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. +Lemma Strict_Rel_Transitive_with_Rel_left : + forall x y z:U, + Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z. +unfold Strict_Rel_of at 1 in |- *. +red in |- *. +elim D; simpl in |- *. +intros C R H' H'0; elim H'0. +intros H'1 H'2 H'3 x y z H'4 H'5; split. +apply H'2 with (y := y); tauto. +red in |- *; intro H'6. +elim H'5; intros H'7 H'8; apply H'8; clear H'5. +apply H'3; auto. +rewrite <- H'6; auto. Qed. -Lemma Strict_Rel_Transitive: (Transitive U (Strict_Rel_of U D)). -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 ]. +Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D). +red in |- *. +intros x y z H' H'0. +apply Strict_Rel_Transitive_with_Rel with (y := y); + [ intuition | unfold Strict_Rel_of in H', H'0; intuition ]. Qed. -End Partial_order_facts. +End Partial_order_facts.
\ No newline at end of file diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v index 03a8b7428..c3a1da01c 100755 --- a/theories/Sets/Permut.v +++ b/theories/Sets/Permut.v @@ -15,77 +15,77 @@ Section Axiomatisation. -Variable U: Set. +Variable U : Set. -Variable op: U -> U -> U. +Variable op : U -> U -> U. Variable cong : U -> U -> Prop. -Hypothesis op_comm : (x,y:U)(cong (op x y) (op y x)). -Hypothesis op_ass : (x,y,z:U)(cong (op (op x y) z) (op x (op y z))). +Hypothesis op_comm : forall x y:U, cong (op x y) (op y x). +Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)). -Hypothesis cong_left : (x,y,z:U)(cong x y)->(cong (op x z) (op y z)). -Hypothesis cong_right : (x,y,z:U)(cong x y)->(cong (op z x) (op z y)). -Hypothesis cong_trans : (x,y,z:U)(cong x y)->(cong y z)->(cong x z). -Hypothesis cong_sym : (x,y:U)(cong x y)->(cong y x). +Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z). +Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y). +Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z. +Hypothesis cong_sym : forall x y:U, cong x y -> cong y x. (** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *) Lemma cong_congr : - (x,y,z,t:U)(cong x y)->(cong z t)->(cong (op x z) (op y t)). + forall x y z t:U, cong x y -> cong z t -> cong (op x z) (op y t). Proof. -Intros; Apply cong_trans with (op y z). -Apply cong_left; Trivial. -Apply cong_right; Trivial. +intros; apply cong_trans with (op y z). +apply cong_left; trivial. +apply cong_right; trivial. Qed. -Lemma comm_right : (x,y,z:U)(cong (op x (op y z)) (op x (op z y))). +Lemma comm_right : forall x y z:U, cong (op x (op y z)) (op x (op z y)). Proof. -Intros; Apply cong_right; Apply op_comm. +intros; apply cong_right; apply op_comm. Qed. -Lemma comm_left : (x,y,z:U)(cong (op (op x y) z) (op (op y x) z)). +Lemma comm_left : forall x y z:U, cong (op (op x y) z) (op (op y x) z). Proof. -Intros; Apply cong_left; Apply op_comm. +intros; apply cong_left; apply op_comm. Qed. -Lemma perm_right : (x,y,z:U)(cong (op (op x y) z) (op (op x z) y)). +Lemma perm_right : forall x y z:U, cong (op (op x y) z) (op (op x z) y). Proof. -Intros. -Apply cong_trans with (op x (op y z)). -Apply op_ass. -Apply cong_trans with (op x (op z y)). -Apply cong_right; Apply op_comm. -Apply cong_sym; Apply op_ass. +intros. +apply cong_trans with (op x (op y z)). +apply op_ass. +apply cong_trans with (op x (op z y)). +apply cong_right; apply op_comm. +apply cong_sym; apply op_ass. Qed. -Lemma perm_left : (x,y,z:U)(cong (op x (op y z)) (op y (op x z))). +Lemma perm_left : forall x y z:U, cong (op x (op y z)) (op y (op x z)). Proof. -Intros. -Apply cong_trans with (op (op x y) z). -Apply cong_sym; Apply op_ass. -Apply cong_trans with (op (op y x) z). -Apply cong_left; Apply op_comm. -Apply op_ass. +intros. +apply cong_trans with (op (op x y) z). +apply cong_sym; apply op_ass. +apply cong_trans with (op (op y x) z). +apply cong_left; apply op_comm. +apply op_ass. Qed. -Lemma op_rotate : (x,y,z,t:U)(cong (op x (op y z)) (op z (op x y))). +Lemma op_rotate : forall x y z t:U, cong (op x (op y z)) (op z (op x y)). Proof. -Intros; Apply cong_trans with (op (op x y) z). -Apply cong_sym; Apply op_ass. -Apply op_comm. +intros; apply cong_trans with (op (op x y) z). +apply cong_sym; apply op_ass. +apply op_comm. Qed. (* Needed for treesort ... *) -Lemma twist : (x,y,z,t:U) - (cong (op x (op (op y z) t)) (op (op y (op x t)) z)). +Lemma twist : + forall x y z t:U, cong (op x (op (op y z) t)) (op (op y (op x t)) z). Proof. -Intros. -Apply cong_trans with (op x (op (op y t) z)). -Apply cong_right; Apply perm_right. -Apply cong_trans with (op (op x (op y t)) z). -Apply cong_sym; Apply op_ass. -Apply cong_left; Apply perm_left. +intros. +apply cong_trans with (op x (op (op y t) z)). +apply cong_right; apply perm_right. +apply cong_trans with (op (op x (op y t)) z). +apply cong_sym; apply op_ass. +apply cong_left; apply perm_left. Qed. -End Axiomatisation. +End Axiomatisation.
\ No newline at end of file diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v index c9c7188b1..543702276 100755 --- a/theories/Sets/Powerset.v +++ b/theories/Sets/Powerset.v @@ -33,156 +33,158 @@ Require Export Partial_Order. Require Export Cpo. Section The_power_set_partial_order. -Variable U: Type. +Variable U : Type. -Inductive Power_set [A:(Ensemble U)]: (Ensemble (Ensemble U)) := - Definition_of_Power_set: - (X: (Ensemble U)) (Included U X A) -> (In (Ensemble U) (Power_set A) X). -Hints Resolve Definition_of_Power_set. +Inductive Power_set (A:Ensemble U) : Ensemble (Ensemble U) := + Definition_of_Power_set : + forall X:Ensemble U, Included U X A -> In (Ensemble U) (Power_set A) X. +Hint Resolve Definition_of_Power_set. -Theorem Empty_set_minimal: (X: (Ensemble U)) (Included U (Empty_set U) X). -Intro X; Red. -Intros x H'; Elim H'. +Theorem Empty_set_minimal : forall X:Ensemble U, Included U (Empty_set U) X. +intro X; red in |- *. +intros x H'; elim H'. Qed. -Hints Resolve Empty_set_minimal. +Hint Resolve Empty_set_minimal. -Theorem Power_set_Inhabited: - (X: (Ensemble U)) (Inhabited (Ensemble U) (Power_set X)). -Intro X. -Apply Inhabited_intro with (Empty_set U); Auto with sets. +Theorem Power_set_Inhabited : + forall X:Ensemble U, Inhabited (Ensemble U) (Power_set X). +intro X. +apply Inhabited_intro with (Empty_set U); auto with sets. Qed. -Hints Resolve Power_set_Inhabited. +Hint Resolve Power_set_Inhabited. -Theorem Inclusion_is_an_order: (Order (Ensemble U) (Included U)). -Auto 6 with sets. +Theorem Inclusion_is_an_order : Order (Ensemble U) (Included U). +auto 6 with sets. Qed. -Hints Resolve Inclusion_is_an_order. +Hint Resolve Inclusion_is_an_order. -Theorem Inclusion_is_transitive: (Transitive (Ensemble U) (Included U)). -Elim Inclusion_is_an_order; Auto with sets. +Theorem Inclusion_is_transitive : Transitive (Ensemble U) (Included U). +elim Inclusion_is_an_order; auto with sets. Qed. -Hints Resolve Inclusion_is_transitive. +Hint Resolve Inclusion_is_transitive. -Definition Power_set_PO: (Ensemble U) -> (PO (Ensemble U)). -Intro A; Try Assumption. -Apply Definition_of_PO with (Power_set A) (Included U); Auto with sets. +Definition Power_set_PO : Ensemble U -> PO (Ensemble U). +intro A; try assumption. +apply Definition_of_PO with (Power_set A) (Included U); auto with sets. Defined. -Hints Unfold Power_set_PO. +Hint Unfold Power_set_PO. -Theorem Strict_Rel_is_Strict_Included: - (same_relation - (Ensemble U) (Strict_Included U) - (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U)))). -Auto with sets. +Theorem Strict_Rel_is_Strict_Included : + same_relation (Ensemble U) (Strict_Included U) + (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))). +auto with sets. Qed. -Hints Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included. +Hint Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included. -Lemma Strict_inclusion_is_transitive_with_inclusion: - (x, y, z:(Ensemble U)) (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. -Intros H'1 H'2; Try Assumption. -Apply H'1. -Apply Strict_Rel_Transitive_with_Rel with y := y; Auto with sets. +Lemma Strict_inclusion_is_transitive_with_inclusion : + forall x y z:Ensemble U, + 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 |- *. +intros H'1 H'2; try assumption. +apply H'1. +apply Strict_Rel_Transitive_with_Rel with (y := y); auto with sets. Qed. -Lemma Strict_inclusion_is_transitive_with_inclusion_left: - (x, y, z:(Ensemble U)) (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. -Intros H'1 H'2; Try Assumption. -Apply H'1. -Apply Strict_Rel_Transitive_with_Rel_left with y := y; Auto with sets. +Lemma Strict_inclusion_is_transitive_with_inclusion_left : + forall x y z:Ensemble U, + 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 |- *. +intros H'1 H'2; try assumption. +apply H'1. +apply Strict_Rel_Transitive_with_Rel_left with (y := y); auto with sets. Qed. -Lemma Strict_inclusion_is_transitive: - (Transitive (Ensemble U) (Strict_Included U)). -Apply cong_transitive_same_relation - with R := (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))); Auto with sets. +Lemma Strict_inclusion_is_transitive : + Transitive (Ensemble U) (Strict_Included U). +apply cong_transitive_same_relation with + (R := Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))); + auto with sets. Qed. -Theorem Empty_set_is_Bottom: - (A: (Ensemble U)) (Bottom (Ensemble U) (Power_set_PO A) (Empty_set U)). -Intro A; Apply Bottom_definition; Simpl; Auto with sets. +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. Qed. -Hints Resolve Empty_set_is_Bottom. +Hint Resolve Empty_set_is_Bottom. -Theorem Union_minimal: - (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. -Intros x H'1; Elim H'1; Auto with sets. +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 x H'1; elim H'1; auto with sets. Qed. -Hints Resolve Union_minimal. +Hint Resolve Union_minimal. -Theorem Intersection_maximal: - (a, b, X: (Ensemble U)) (Included U X a) -> (Included U X b) -> - (Included U X (Intersection U a b)). -Auto with sets. +Theorem Intersection_maximal : + forall a b X:Ensemble U, + Included U X a -> Included U X b -> Included U X (Intersection U a b). +auto with sets. Qed. -Theorem Union_increases_l: (a, b: (Ensemble U)) (Included U a (Union U a b)). -Auto with sets. +Theorem Union_increases_l : forall a b:Ensemble U, Included U a (Union U a b). +auto with sets. Qed. -Theorem Union_increases_r: (a, b: (Ensemble U)) (Included U b (Union U a b)). -Auto with sets. +Theorem Union_increases_r : forall a b:Ensemble U, Included U b (Union U a b). +auto with sets. Qed. -Theorem Intersection_decreases_l: - (a, b: (Ensemble U)) (Included U (Intersection U a b) a). -Intros a b; Red. -Intros x H'; Elim H'; Auto with sets. +Theorem Intersection_decreases_l : + forall a b:Ensemble U, Included U (Intersection U a b) a. +intros a b; red in |- *. +intros x H'; elim H'; auto with sets. Qed. -Theorem Intersection_decreases_r: - (a, b: (Ensemble U)) (Included U (Intersection U a b) b). -Intros a b; Red. -Intros x H'; Elim H'; Auto with sets. +Theorem Intersection_decreases_r : + forall a b:Ensemble U, Included U (Intersection U a b) b. +intros a b; red in |- *. +intros x H'; elim H'; auto with sets. Qed. -Hints Resolve Union_increases_l Union_increases_r Intersection_decreases_l - Intersection_decreases_r. +Hint Resolve Union_increases_l Union_increases_r Intersection_decreases_l + Intersection_decreases_r. -Theorem Union_is_Lub: - (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (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. -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; Auto with sets. +Theorem Union_is_Lub : + forall A a b:Ensemble U, + Included U a A -> + 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. +intros y H'1; elim H'1; auto with sets. +intros y H'1; elim H'1; simpl in |- *; auto with sets. Qed. -Theorem Intersection_is_Glb: - (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (Included U b A) -> - (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. -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; Auto with sets. +Theorem Intersection_is_Glb : + forall A a b:Ensemble U, + Included U a A -> + Included U b A -> + 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 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. Qed. End The_power_set_partial_order. -Hints Resolve Empty_set_minimal : sets v62. -Hints Resolve Power_set_Inhabited : sets v62. -Hints Resolve Inclusion_is_an_order : sets v62. -Hints Resolve Inclusion_is_transitive : sets v62. -Hints Resolve Union_minimal : sets v62. -Hints Resolve Union_increases_l : sets v62. -Hints Resolve Union_increases_r : sets v62. -Hints Resolve Intersection_decreases_l : sets v62. -Hints Resolve Intersection_decreases_r : sets v62. -Hints Resolve Empty_set_is_Bottom : sets v62. -Hints Resolve Strict_inclusion_is_transitive : sets v62. +Hint Resolve Empty_set_minimal: sets v62. +Hint Resolve Power_set_Inhabited: sets v62. +Hint Resolve Inclusion_is_an_order: sets v62. +Hint Resolve Inclusion_is_transitive: sets v62. +Hint Resolve Union_minimal: sets v62. +Hint Resolve Union_increases_l: sets v62. +Hint Resolve Union_increases_r: sets v62. +Hint Resolve Intersection_decreases_l: sets v62. +Hint Resolve Intersection_decreases_r: sets v62. +Hint Resolve Empty_set_is_Bottom: sets v62. +Hint Resolve Strict_inclusion_is_transitive: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v index 6b3443b7d..988bbd25a 100755 --- a/theories/Sets/Powerset_Classical_facts.v +++ b/theories/Sets/Powerset_Classical_facts.v @@ -39,300 +39,304 @@ Require Export Classical_sets. Section Sets_as_an_algebra. -Variable U: Type. +Variable U : Type. -Lemma sincl_add_x: - (A, B: (Ensemble U)) - (x: U) ~ (In U A x) -> (Strict_Included U (Add U A x) (Add U B x)) -> - (Strict_Included U A B). +Lemma sincl_add_x : + forall (A B:Ensemble U) (x:U), + ~ In U A x -> + Strict_Included U (Add U A x) (Add U B x) -> Strict_Included U A B. Proof. -Intros A B x H' H'0; Red. -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; Intro H'2. -Elim H'0; Clear H'0. -Rewrite <- H'2; Auto with sets. +intros A B x H' H'0; red in |- *. +lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets. +clear H'0; intro H'0; split. +apply incl_add_x with (x := x); tauto. +elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2. +intros x0 H'0. +red in |- *; intro H'2. +elim H'0; clear H'0. +rewrite <- H'2; auto with sets. Qed. -Lemma incl_soustr_in: - (X: (Ensemble U)) (x: U) (In U X x) -> (Included U (Subtract U X x) X). +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. -Intros x0 H'0; Elim H'0; Auto with sets. +intros X x H'; red in |- *. +intros x0 H'0; elim H'0; auto with sets. Qed. -Hints Resolve incl_soustr_in : sets v62. +Hint Resolve incl_soustr_in: sets v62. -Lemma incl_soustr: - (X, Y: (Ensemble U)) (x: U) (Included U X Y) -> - (Included U (Subtract U X x) (Subtract U Y x)). +Lemma incl_soustr : + forall (X Y:Ensemble U) (x:U), + Included U X Y -> Included U (Subtract U X x) (Subtract U Y x). Proof. -Intros X Y x H'; Red. -Intros x0 H'0; Elim H'0. -Intros H'1 H'2. -Apply Subtract_intro; Auto with sets. +intros X Y x H'; red in |- *. +intros x0 H'0; elim H'0. +intros H'1 H'2. +apply Subtract_intro; auto with sets. Qed. -Hints Resolve incl_soustr : sets v62. +Hint Resolve incl_soustr: sets v62. -Lemma incl_soustr_add_l: - (X: (Ensemble U)) (x: U) (Included U (Subtract U (Add U X x) x) X). +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. -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. +intros X x; red in |- *. +intros x0 H'; elim H'; auto with sets. +intro H'0; elim H'0; auto with sets. +intros t H'1 H'2; elim H'2; auto with sets. Qed. -Hints Resolve incl_soustr_add_l : sets v62. +Hint Resolve incl_soustr_add_l: sets v62. -Lemma incl_soustr_add_r: - (X: (Ensemble U)) (x: U) ~ (In U X x) -> - (Included U X (Subtract U (Add U X x) x)). +Lemma incl_soustr_add_r : + forall (X:Ensemble U) (x:U), + ~ In U X x -> Included U X (Subtract U (Add U X x) x). Proof. -Intros X x H'; Red. -Intros x0 H'0; Try Assumption. -Apply Subtract_intro; Auto with sets. -Red; Intro H'1; Apply H'; Rewrite H'1; Auto with sets. +intros X x H'; red in |- *. +intros x0 H'0; try assumption. +apply Subtract_intro; auto with sets. +red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets. Qed. -Hints Resolve incl_soustr_add_r : sets v62. +Hint Resolve incl_soustr_add_r: sets v62. -Lemma add_soustr_2: - (X: (Ensemble U)) (x: U) (In U X x) -> - (Included U X (Add U (Subtract U X x) x)). +Lemma add_soustr_2 : + forall (X:Ensemble U) (x:U), + In U X x -> Included U X (Add U (Subtract U X x) x). Proof. -Intros X x H'; Red. -Intros x0 H'0; Try Assumption. -Elim (classic x == x0); Intro K; Auto with sets. -Elim K; Auto with sets. +intros X x H'; red in |- *. +intros x0 H'0; try assumption. +elim (classic (x = x0)); intro K; auto with sets. +elim K; auto with sets. Qed. -Lemma add_soustr_1: - (X: (Ensemble U)) (x: U) (In U X x) -> - (Included U (Add U (Subtract U X x) x) X). +Lemma add_soustr_1 : + forall (X:Ensemble U) (x:U), + In U X x -> Included U (Add U (Subtract U X x) x) X. Proof. -Intros X x H'; Red. -Intros x0 H'0; Elim H'0; Auto with sets. -Intros y H'1; Elim H'1; Auto with sets. -Intros t H'1; Try Assumption. -Rewrite <- (Singleton_inv U x t); Auto with sets. +intros X x H'; red in |- *. +intros x0 H'0; elim H'0; auto with sets. +intros y H'1; elim H'1; auto with sets. +intros t H'1; try assumption. +rewrite <- (Singleton_inv U x t); auto with sets. Qed. -Hints Resolve add_soustr_1 add_soustr_2 : sets v62. +Hint Resolve add_soustr_1 add_soustr_2: sets v62. -Lemma add_soustr_xy: - (X: (Ensemble U)) (x, y: U) ~ x == y -> - (Subtract U (Add U X x) y) == (Add U (Subtract U X y) x). +Lemma add_soustr_xy : + forall (X:Ensemble U) (x y:U), + x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x. Proof. -Intros X x y H'; Apply Extensionality_Ensembles. -Split; Red. -Intros x0 H'0; Elim H'0; Auto with sets. -Intro H'1; Elim H'1. -Intros u H'2 H'3; Try Assumption. -Apply Add_intro1. -Apply Subtract_intro; Auto with sets. -Intros t H'2 H'3; Try Assumption. -Elim (Singleton_inv U x t); Auto with sets. -Intros u H'2; Try Assumption. -Elim (Add_inv U (Subtract U X y) x u); Auto with sets. -Intro H'0; Elim H'0; Auto with sets. -Intro H'0; Rewrite <- H'0; Auto with sets. +intros X x y H'; apply Extensionality_Ensembles. +split; red in |- *. +intros x0 H'0; elim H'0; auto with sets. +intro H'1; elim H'1. +intros u H'2 H'3; try assumption. +apply Add_intro1. +apply Subtract_intro; auto with sets. +intros t H'2 H'3; try assumption. +elim (Singleton_inv U x t); auto with sets. +intros u H'2; try assumption. +elim (Add_inv U (Subtract U X y) x u); auto with sets. +intro H'0; elim H'0; auto with sets. +intro H'0; rewrite <- H'0; auto with sets. Qed. -Hints Resolve add_soustr_xy : sets v62. +Hint Resolve add_soustr_xy: sets v62. -Lemma incl_st_add_soustr: - (X, Y: (Ensemble U)) (x: U) ~ (In U X x) -> - (Strict_Included U (Add U X x) Y) -> - (Strict_Included U X (Subtract U Y x)). +Lemma incl_st_add_soustr : + forall (X Y:Ensemble U) (x:U), + ~ In U X x -> + Strict_Included U (Add U X x) Y -> Strict_Included U X (Subtract U Y x). Proof. -Intros X Y x H' H'0; Apply sincl_add_x with x := x; Auto with sets. -Split. -Elim H'0. -Intros H'1 H'2. -Generalize (Inclusion_is_transitive U). -Intro H'4; Red in H'4. -Apply H'4 with y := Y; Auto with sets. -Red in H'0. -Elim H'0; Intros H'1 H'2; Try Exact H'1; Clear H'0. (* PB *) -Red; Intro H'0; Apply H'2. -Rewrite H'0; Auto 8 with sets. +intros X Y x H' H'0; apply sincl_add_x with (x := x); auto with sets. +split. +elim H'0. +intros H'1 H'2. +generalize (Inclusion_is_transitive U). +intro H'4; red in H'4. +apply H'4 with (y := Y); auto with sets. +red in H'0. +elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *) +red in |- *; intro H'0; apply H'2. +rewrite H'0; auto 8 with sets. Qed. -Lemma Sub_Add_new: - (X: (Ensemble U)) (x: U) ~ (In U X x) -> X == (Subtract U (Add U X x) x). +Lemma Sub_Add_new : + forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x. Proof. -Auto with sets. +auto with sets. Qed. -Lemma Simplify_add: - (X, X0 : (Ensemble U)) (x: U) - ~ (In U X x) -> ~ (In U X0 x) -> (Add U X x) == (Add U X0 x) -> X == X0. +Lemma Simplify_add : + forall (X X0:Ensemble U) (x:U), + ~ In U X x -> ~ In U X0 x -> Add U X x = Add U X0 x -> X = X0. Proof. -Intros X X0 x H' H'0 H'1; Try Assumption. -Rewrite (Sub_Add_new X x); Auto with sets. -Rewrite (Sub_Add_new X0 x); Auto with sets. -Rewrite H'1; Auto with sets. +intros X X0 x H' H'0 H'1; try assumption. +rewrite (Sub_Add_new X x); auto with sets. +rewrite (Sub_Add_new X0 x); auto with sets. +rewrite H'1; auto with sets. Qed. -Lemma Included_Add: - (X, A: (Ensemble U)) (x: U) (Included U X (Add U A x)) -> - (Included U X A) \/ - (EXT A' | X == (Add U A' x) /\ (Included U A' A)). +Lemma Included_Add : + forall (X A:Ensemble U) (x:U), + Included U X (Add U A x) -> + Included U X A \/ ( exists A' : _ | X = Add U A' x /\ Included U A' A). Proof. -Intros X A x H'0; Try Assumption. -Elim (classic (In U X x)). -Intro H'1; Right; Try Assumption. -Exists (Subtract U X x). -Split; Auto with sets. -Red in H'0. -Red. -Intros x0 H'2; Try Assumption. -LApply (Subtract_inv U X x x0); Auto with sets. -Intro H'3; Elim H'3; Intros K K'; Clear H'3. -LApply (H'0 x0); Auto with sets. -Intro H'3; Try Assumption. -LApply (Add_inv U A x x0); Auto with sets. -Intro H'4; Elim H'4; - [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4]. -Elim K'; Auto with sets. -Intro H'1; Left; Try Assumption. -Red in H'0. -Red. -Intros x0 H'2; Try Assumption. -LApply (H'0 x0); Auto with sets. -Intro H'3; Try Assumption. -LApply (Add_inv U A x x0); Auto with sets. -Intro H'4; Elim H'4; - [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4]. -Absurd (In U X x0); Auto with sets. -Rewrite <- H'5; Auto with sets. +intros X A x H'0; try assumption. +elim (classic (In U X x)). +intro H'1; right; try assumption. +exists (Subtract U X x). +split; auto with sets. +red in H'0. +red in |- *. +intros x0 H'2; try assumption. +lapply (Subtract_inv U X x x0); auto with sets. +intro H'3; elim H'3; intros K K'; clear H'3. +lapply (H'0 x0); auto with sets. +intro H'3; try assumption. +lapply (Add_inv U A x x0); auto with sets. +intro H'4; elim H'4; + [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. +elim K'; auto with sets. +intro H'1; left; try assumption. +red in H'0. +red in |- *. +intros x0 H'2; try assumption. +lapply (H'0 x0); auto with sets. +intro H'3; try assumption. +lapply (Add_inv U A x x0); auto with sets. +intro H'4; elim H'4; + [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. +absurd (In U X x0); auto with sets. +rewrite <- H'5; auto with sets. Qed. -Lemma setcover_inv: - (A: (Ensemble U)) - (x, y: (Ensemble U)) (covers (Ensemble U) (Power_set_PO U A) y x) -> - (Strict_Included U x y) /\ - ((z: (Ensemble U)) (Included U x z) -> (Included U z y) -> x == z \/ z == y). +Lemma setcover_inv : + forall A x y:Ensemble U, + covers (Ensemble U) (Power_set_PO U A) y x -> + Strict_Included U x y /\ + (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y). Proof. -Intros A x y H'; Elim H'. -Unfold Strict_Rel_of; 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. -Intro H'4; Right; Try Assumption. -Elim (classic z == y); Auto with sets. -Intro H'5; Try Assumption. -Elim H'1. -Exists z; Auto with sets. +intros A x y H'; elim H'. +unfold Strict_Rel_of in |- *; simpl in |- *. +intros H'0 H'1; split; [ auto with sets | idtac ]. +intros z H'2 H'3; try assumption. +elim (classic (x = z)); auto with sets. +intro H'4; right; try assumption. +elim (classic (z = y)); auto with sets. +intro H'5; try assumption. +elim H'1. +exists z; auto with sets. Qed. -Theorem Add_covers: - (A: (Ensemble U)) (a: (Ensemble U)) (Included U a A) -> - (x: U) (In U A x) -> ~ (In U a x) -> - (covers (Ensemble U) (Power_set_PO U A) (Add U a x) a). +Theorem Add_covers : + forall A a:Ensemble U, + Included U a A -> + forall x:U, + In U A x -> + ~ In U a x -> covers (Ensemble U) (Power_set_PO U A) (Add U a x) a. Proof. -Intros A a H' x H'0 H'1; Try Assumption. -Apply setcover_intro; Auto with sets. -Red. -Split; [Idtac | Red; Intro H'2; Try Exact H'2]; Auto with sets. -Apply H'1. -Rewrite H'2; Auto with sets. -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. -Intros x0 H'2; Elim H'2. -Intros H'5 H'6; Try Assumption. -Generalize H'4; Intro K. -Red in H'4. -Elim H'4; Intros H'8 H'9; Red in H'8; Clear H'4. -LApply (H'8 x0); Auto with sets. -Intro H'7; Try Assumption. -Elim (Add_inv U a x x0); Auto with sets. -Intro H'15. -Cut (Included U (Add U a x) z). -Intro H'10; Try Assumption. -Red in K. -Elim K; Intros H'11 H'12; Apply H'12; Clear K; Auto with sets. -Rewrite H'15. -Red. -Intros x1 H'10; Elim H'10; Auto with sets. -Intros x2 H'11; Elim H'11; Auto with sets. +intros A a H' x H'0 H'1; try assumption. +apply setcover_intro; auto with sets. +red in |- *. +split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets. +apply H'1. +rewrite H'2; auto with sets. +red in |- *; intro H'2; elim H'2; clear H'2. +intros z H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. +lapply (Strict_Included_inv U a z); auto with sets; clear H'3. +intro H'2; elim H'2; intros H'3 H'5; elim H'5; clear H'2 H'5. +intros x0 H'2; elim H'2. +intros H'5 H'6; try assumption. +generalize H'4; intro K. +red in H'4. +elim H'4; intros H'8 H'9; red in H'8; clear H'4. +lapply (H'8 x0); auto with sets. +intro H'7; try assumption. +elim (Add_inv U a x x0); auto with sets. +intro H'15. +cut (Included U (Add U a x) z). +intro H'10; try assumption. +red in K. +elim K; intros H'11 H'12; apply H'12; clear K; auto with sets. +rewrite H'15. +red in |- *. +intros x1 H'10; elim H'10; auto with sets. +intros x2 H'11; elim H'11; auto with sets. Qed. -Theorem covers_Add: - (A: (Ensemble U)) - (a, a': (Ensemble U)) - (Included U a A) -> - (Included U a' A) -> (covers (Ensemble U) (Power_set_PO U A) a' a) -> - (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x))). +Theorem covers_Add : + forall A a a':Ensemble U, + Included U a A -> + Included U a' A -> + covers (Ensemble U) (Power_set_PO U A) a' a -> + exists x : _ | a' = Add U a x /\ In U A x /\ ~ In U a x. Proof. -Intros A a a' H' H'0 H'1; Try Assumption. -Elim (setcover_inv A a a'); Auto with sets. -Intros H'6 H'7. -Clear H'1. -Elim (Strict_Included_inv U a a'); Auto with sets. -Intros H'5 H'8; Elim H'8. -Intros x H'1; Elim H'1. -Intros H'2 H'3; Try Assumption. -Exists x. -Split; [Try Assumption | Idtac]. -Clear H'8 H'1. -Elim (H'7 (Add U a x)); Auto with sets. -Intro H'1. -Absurd a ==(Add U a x); Auto with sets. -Red; Intro H'8; Try Exact H'8. -Apply H'3. -Rewrite H'8; Auto with sets. -Auto with sets. -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]. -Red in H'0; Auto with sets. +intros A a a' H' H'0 H'1; try assumption. +elim (setcover_inv A a a'); auto with sets. +intros H'6 H'7. +clear H'1. +elim (Strict_Included_inv U a a'); auto with sets. +intros H'5 H'8; elim H'8. +intros x H'1; elim H'1. +intros H'2 H'3; try assumption. +exists x. +split; [ try assumption | idtac ]. +clear H'8 H'1. +elim (H'7 (Add U a x)); auto with sets. +intro H'1. +absurd (a = Add U a x); auto with sets. +red in |- *; intro H'8; try exact H'8. +apply H'3. +rewrite H'8; auto with sets. +auto with sets. +red in |- *. +intros x0 H'1; elim H'1; auto with sets. +intros x1 H'8; elim H'8; auto with sets. +split; [ idtac | try assumption ]. +red in H'0; auto with sets. Qed. -Theorem covers_is_Add: - (A: (Ensemble U)) - (a, a': (Ensemble U)) (Included U a A) -> (Included U a' A) -> - (iff - (covers (Ensemble U) (Power_set_PO U A) a' a) - (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x)))). +Theorem covers_is_Add : + forall A a a':Ensemble U, + Included U a A -> + Included U a' A -> + (covers (Ensemble U) (Power_set_PO U A) a' a <-> + ( exists x : _ | a' = Add U a x /\ In U A x /\ ~ In U a x)). Proof. -Intros A a a' H' H'0; Split; Intro K. -Apply covers_Add with A := A; Auto with sets. -Elim K. -Intros x H'1; Elim H'1; Intros H'2 H'3; Rewrite H'2; Clear H'1. -Apply Add_covers; Intuition. +intros A a a' H' H'0; split; intro K. +apply covers_Add with (A := A); auto with sets. +elim K. +intros x H'1; elim H'1; intros H'2 H'3; rewrite H'2; clear H'1. +apply Add_covers; intuition. Qed. -Theorem Singleton_atomic: - (x:U) (A:(Ensemble U)) (In U A x) -> - (covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U)). -Intros x A H'. -Rewrite <- (Empty_set_zero' U x). -Apply Add_covers; Auto with sets. +Theorem Singleton_atomic : + forall (x:U) (A:Ensemble U), + In U A x -> + covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U). +intros x A H'. +rewrite <- (Empty_set_zero' U x). +apply Add_covers; auto with sets. Qed. -Lemma less_than_singleton: - (X:(Ensemble U)) (x:U) (Strict_Included U X (Singleton U x)) -> - X ==(Empty_set U). -Intros X x H'; Try Assumption. -Red in H'. -LApply (Singleton_atomic x (Full_set U)); - [Intro H'2; Try Exact H'2 | Apply Full_intro]. -Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'. -Elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x)); - [Intros H'6 H'7; Try Exact H'7 | Idtac]; Auto with sets. -Elim (H'7 X); [Intro H'5; Try Exact H'5 | Intro H'5 | Idtac | Idtac]; Auto with sets. -Elim H'1; Auto with sets. +Lemma less_than_singleton : + forall (X:Ensemble U) (x:U), + Strict_Included U X (Singleton U x) -> X = Empty_set U. +intros X x H'; try assumption. +red in H'. +lapply (Singleton_atomic x (Full_set U)); + [ intro H'2; try exact H'2 | apply Full_intro ]. +elim H'; intros H'0 H'1; try exact H'1; clear H'. +elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x)); + [ intros H'6 H'7; try exact H'7 | idtac ]; auto with sets. +elim (H'7 X); [ intro H'5; try exact H'5 | intro H'5 | idtac | idtac ]; + auto with sets. +elim H'1; auto with sets. Qed. End Sets_as_an_algebra. -Hints Resolve incl_soustr_in : sets v62. -Hints Resolve incl_soustr : sets v62. -Hints Resolve incl_soustr_add_l : sets v62. -Hints Resolve incl_soustr_add_r : sets v62. -Hints Resolve add_soustr_1 add_soustr_2 : sets v62. -Hints Resolve add_soustr_xy : sets v62. +Hint Resolve incl_soustr_in: sets v62. +Hint Resolve incl_soustr: sets v62. +Hint Resolve incl_soustr_add_l: sets v62. +Hint Resolve incl_soustr_add_r: sets v62. +Hint Resolve add_soustr_1 add_soustr_2: sets v62. +Hint Resolve add_soustr_xy: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v index 3e1837078..c587744a3 100755 --- a/theories/Sets/Powerset_facts.v +++ b/theories/Sets/Powerset_facts.v @@ -35,242 +35,234 @@ Require Export Cpo. Require Export Powerset. Section Sets_as_an_algebra. -Variable U: Type. -Hints Unfold not. +Variable U : Type. +Hint Unfold not. -Theorem Empty_set_zero : - (X: (Ensemble U)) (Union U (Empty_set U) X) == X. +Theorem Empty_set_zero : forall X:Ensemble U, Union U (Empty_set U) X = X. Proof. -Auto 6 with sets. +auto 6 with sets. Qed. -Hints Resolve Empty_set_zero. +Hint Resolve Empty_set_zero. -Theorem Empty_set_zero' : - (x: U) (Add U (Empty_set U) x) == (Singleton U x). +Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x. Proof. -Unfold 1 Add; Auto with sets. +unfold Add at 1 in |- *; auto with sets. Qed. -Hints Resolve Empty_set_zero'. +Hint Resolve Empty_set_zero'. Lemma less_than_empty : - (X: (Ensemble U)) (Included U X (Empty_set U)) -> X == (Empty_set U). + forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U. Proof. -Auto with sets. +auto with sets. Qed. -Hints Resolve less_than_empty. +Hint Resolve less_than_empty. -Theorem Union_commutative : - (A,B: (Ensemble U)) (Union U A B) == (Union U B A). +Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A. Proof. -Auto with sets. +auto with sets. Qed. Theorem Union_associative : - (A, B, C: (Ensemble U)) - (Union U (Union U A B) C) == (Union U A (Union U B C)). + forall A B C:Ensemble U, Union U (Union U A B) C = Union U A (Union U B C). Proof. -Auto 9 with sets. +auto 9 with sets. Qed. -Hints Resolve Union_associative. +Hint Resolve Union_associative. -Theorem Union_idempotent : (A: (Ensemble U)) (Union U A A) == A. +Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A. Proof. -Auto 7 with sets. +auto 7 with sets. Qed. Lemma Union_absorbs : - (A, B: (Ensemble U)) (Included U B A) -> (Union U A B) == A. + forall A B:Ensemble U, Included U B A -> Union U A B = A. Proof. -Auto 7 with sets. +auto 7 with sets. Qed. -Theorem Couple_as_union: - (x, y: U) (Union U (Singleton U x) (Singleton U y)) == (Couple U x y). +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. -Intros x0 H'; Elim H'; (Intros x1 H'0; Elim H'0; Auto with sets). -Intros x0 H'; Elim H'; Auto with sets. +intros x y; apply Extensionality_Ensembles; split; red in |- *. +intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets). +intros x0 H'; elim H'; auto with sets. Qed. Theorem Triple_as_union : - (x, y, z: U) - (Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z)) == - (Triple U x y z). + forall x y z:U, + Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) = + Triple U x y z. Proof. -Intros x y z; Apply Extensionality_Ensembles; Split; Red. -Intros x0 H'; Elim H'. -Intros x1 H'0; Elim H'0; (Intros x2 H'1; Elim H'1; Auto with sets). -Intros x1 H'0; Elim H'0; Auto with sets. -Intros x0 H'; Elim H'; Auto with sets. +intros x y z; apply Extensionality_Ensembles; split; red in |- *. +intros x0 H'; elim H'. +intros x1 H'0; elim H'0; (intros x2 H'1; elim H'1; auto with sets). +intros x1 H'0; elim H'0; auto with sets. +intros x0 H'; elim H'; auto with sets. Qed. -Theorem Triple_as_Couple : (x, y: U) (Couple U x y) == (Triple U x x y). +Theorem Triple_as_Couple : forall x y:U, Couple U x y = Triple U x x y. Proof. -Intros x y. -Rewrite <- (Couple_as_union x y). -Rewrite <- (Union_idempotent (Singleton U x)). -Apply Triple_as_union. +intros x y. +rewrite <- (Couple_as_union x y). +rewrite <- (Union_idempotent (Singleton U x)). +apply Triple_as_union. Qed. Theorem Triple_as_Couple_Singleton : - (x, y, z: U) (Triple U x y z) == (Union U (Couple U x y) (Singleton U z)). + forall x y z:U, Triple U x y z = Union U (Couple U x y) (Singleton U z). Proof. -Intros x y z. -Rewrite <- (Triple_as_union x y z). -Rewrite <- (Couple_as_union x y); Auto with sets. +intros x y z. +rewrite <- (Triple_as_union x y z). +rewrite <- (Couple_as_union x y); auto with sets. Qed. Theorem Intersection_commutative : - (A,B: (Ensemble U)) (Intersection U A B) == (Intersection U B A). + forall A B:Ensemble U, Intersection U A B = Intersection U B A. Proof. -Intros A B. -Apply Extensionality_Ensembles. -Split; Red; Intros x H'; Elim H'; Auto with sets. +intros A B. +apply Extensionality_Ensembles. +split; red in |- *; intros x H'; elim H'; auto with sets. Qed. Theorem Distributivity : - (A, B, C: (Ensemble U)) - (Intersection U A (Union U B C)) == - (Union U (Intersection U A B) (Intersection U A C)). + forall A B C:Ensemble U, + Intersection U A (Union U B C) = + Union U (Intersection U A B) (Intersection U A C). Proof. -Intros A B C. -Apply Extensionality_Ensembles. -Split; Red; Intros x H'. -Elim H'. -Intros x0 H'0 H'1; Generalize H'0. -Elim H'1; Auto with sets. -Elim H'; Intros x0 H'0; Elim H'0; Auto with sets. +intros A B C. +apply Extensionality_Ensembles. +split; red in |- *; intros x H'. +elim H'. +intros x0 H'0 H'1; generalize H'0. +elim H'1; auto with sets. +elim H'; intros x0 H'0; elim H'0; auto with sets. Qed. Theorem Distributivity' : - (A, B, C: (Ensemble U)) - (Union U A (Intersection U B C)) == - (Intersection U (Union U A B) (Union U A C)). + forall A B C:Ensemble U, + Union U A (Intersection U B C) = + Intersection U (Union U A B) (Union U A C). Proof. -Intros A B C. -Apply Extensionality_Ensembles. -Split; Red; Intros x H'. -Elim H'; Auto with sets. -Intros x0 H'0; Elim H'0; Auto with sets. -Elim H'. -Intros x0 H'0; Elim H'0; Auto with sets. -Intros x1 H'1 H'2; Try Exact H'2. -Generalize H'1. -Elim H'2; Auto with sets. +intros A B C. +apply Extensionality_Ensembles. +split; red in |- *; intros x H'. +elim H'; auto with sets. +intros x0 H'0; elim H'0; auto with sets. +elim H'. +intros x0 H'0; elim H'0; auto with sets. +intros x1 H'1 H'2; try exact H'2. +generalize H'1. +elim H'2; auto with sets. Qed. Theorem Union_add : - (A, B: (Ensemble U)) (x: U) - (Add U (Union U A B) x) == (Union U A (Add U B x)). + forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x). Proof. -Unfold Add; Auto with sets. +unfold Add in |- *; auto with sets. Qed. -Hints Resolve Union_add. +Hint Resolve Union_add. Theorem Non_disjoint_union : - (X: (Ensemble U)) (x: U) (In U X x) -> (Add U X x) == X. -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. + forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X. +intros X x H'; unfold Add in |- *. +apply Extensionality_Ensembles; red in |- *. +split; red in |- *; auto with sets. +intros x0 H'0; elim H'0; auto with sets. +intros t H'1; elim H'1; auto with sets. Qed. Theorem Non_disjoint_union' : - (X: (Ensemble U)) (x: U) ~ (In U X x) -> (Subtract U X x) == X. + forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X. Proof. -Intros X x H'; Unfold Subtract. -Apply Extensionality_Ensembles. -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; 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. +intros X x H'; unfold Subtract in |- *. +apply Extensionality_Ensembles. +split; red in |- *; auto with sets. +intros x0 H'0; elim H'0; auto with sets. +intros x0 H'0; apply Setminus_intro; auto with sets. +red in |- *; intro H'1; elim H'1. +lapply (Singleton_inv U x x0); auto with sets. +intro H'4; apply H'; rewrite H'4; auto with sets. Qed. -Lemma singlx : (x, y: U) (In U (Add U (Empty_set U) x) y) -> x == y. +Lemma singlx : forall x y:U, In U (Add U (Empty_set U) x) y -> x = y. Proof. -Intro x; Rewrite (Empty_set_zero' x); Auto with sets. +intro x; rewrite (Empty_set_zero' x); auto with sets. Qed. -Hints Resolve singlx. +Hint Resolve singlx. Lemma incl_add : - (A, B: (Ensemble U)) (x: U) (Included U A B) -> - (Included U (Add U A x) (Add U B x)). + 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; Auto with sets. -Intros x0 H'0. -LApply (Add_inv U A x x0); Auto with sets. -Intro H'1; Elim H'1; - [Intro H'2; Clear H'1 | Intro H'2; Rewrite <- H'2; Clear H'1]; Auto with sets. +intros A B x H'; red in |- *; auto with sets. +intros x0 H'0. +lapply (Add_inv U A x x0); auto with sets. +intro H'1; elim H'1; + [ intro H'2; clear H'1 | intro H'2; rewrite <- H'2; clear H'1 ]; + auto with sets. Qed. -Hints Resolve incl_add. +Hint Resolve incl_add. Lemma incl_add_x : - (A, B: (Ensemble U)) - (x: U) ~ (In U A x) -> (Included U (Add U A x) (Add U B x)) -> - (Included U A B). + 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. -Intros A B x H' H'0 x0 H'1. -LApply (H'0 x0); Auto with sets. -Intro H'2; LApply (Add_inv U B x x0); Auto with sets. -Intro H'3; Elim H'3; - [Intro H'4; Try Exact H'4; Clear H'3 | Intro H'4; Clear H'3]. -Absurd (In U A x0); Auto with sets. -Rewrite <- H'4; Auto with sets. +unfold Included in |- *. +intros A B x H' H'0 x0 H'1. +lapply (H'0 x0); auto with sets. +intro H'2; lapply (Add_inv U B x x0); auto with sets. +intro H'3; elim H'3; + [ intro H'4; try exact H'4; clear H'3 | intro H'4; clear H'3 ]. +absurd (In U A x0); auto with sets. +rewrite <- H'4; auto with sets. Qed. Lemma Add_commutative : - (A: (Ensemble U)) (x, y: U) (Add U (Add U A x) y) == (Add U (Add U A y) x). + 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. -Rewrite (Union_associative A (Singleton U x) (Singleton U y)). -Rewrite (Union_commutative (Singleton U x) (Singleton U y)). -Rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); Auto with sets. +intros A x y. +unfold Add in |- *. +rewrite (Union_associative A (Singleton U x) (Singleton U y)). +rewrite (Union_commutative (Singleton U x) (Singleton U y)). +rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); + auto with sets. Qed. Lemma Add_commutative' : - (A: (Ensemble U)) (x, y, z: U) - (Add U (Add U (Add U A x) y) z) == (Add U (Add U (Add U A z) x) y). + forall (A:Ensemble U) (x y z:U), + Add U (Add U (Add U A x) y) z = Add U (Add U (Add U A z) x) y. Proof. -Intros A x y z. -Rewrite (Add_commutative (Add U A x) y z). -Rewrite (Add_commutative A x z); Auto with sets. +intros A x y z. +rewrite (Add_commutative (Add U A x) y z). +rewrite (Add_commutative A x z); auto with sets. Qed. Lemma Add_distributes : - (A, B: (Ensemble U)) (x, y: U) (Included U B A) -> - (Add U (Add U A x) y) == (Union U (Add U A x) (Add U B y)). + forall (A B:Ensemble U) (x y:U), + Included U B A -> Add U (Add U A x) y = Union U (Add U A x) (Add U B y). Proof. -Intros A B x y H'; Try Assumption. -Rewrite <- (Union_add (Add U A x) B y). -Unfold 4 Add. -Rewrite (Union_commutative A (Singleton U x)). -Rewrite Union_associative. -Rewrite (Union_absorbs A B H'). -Rewrite (Union_commutative (Singleton U x) A). -Auto with sets. +intros A B x y H'; try assumption. +rewrite <- (Union_add (Add U A x) B y). +unfold Add at 4 in |- *. +rewrite (Union_commutative A (Singleton U x)). +rewrite Union_associative. +rewrite (Union_absorbs A B H'). +rewrite (Union_commutative (Singleton U x) A). +auto with sets. Qed. Lemma setcover_intro : - (U: Type) - (A: (Ensemble U)) - (x, y: (Ensemble U)) - (Strict_Included U x y) -> - ~ (EXT z | (Strict_Included U x z) - /\ (Strict_Included U z y)) -> - (covers (Ensemble U) (Power_set_PO U A) y x). + forall (U:Type) (A x y:Ensemble U), + Strict_Included U x y -> + ~ ( exists z : _ | Strict_Included U x z /\ Strict_Included U z y) -> + covers (Ensemble U) (Power_set_PO U A) y x. Proof. -Intros; Apply Definition_of_covers; Auto with sets. +intros; apply Definition_of_covers; auto with sets. Qed. -Hints Resolve setcover_intro. +Hint Resolve setcover_intro. End Sets_as_an_algebra. -Hints Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add - singlx incl_add : sets v62. - +Hint Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add + singlx incl_add: sets v62. diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v index 74c031726..16a00740d 100755 --- a/theories/Sets/Relations_1.v +++ b/theories/Sets/Relations_1.v @@ -27,41 +27,41 @@ (*i $Id$ i*) Section Relations_1. - Variable U: Type. + Variable U : Type. - Definition Relation := U -> U -> Prop. - Variable R: Relation. + Definition Relation := U -> U -> Prop. + Variable R : Relation. - Definition Reflexive : Prop := (x: U) (R x x). + Definition Reflexive : Prop := forall x:U, R x x. - Definition Transitive : Prop := (x,y,z: U) (R x y) -> (R y z) -> (R x z). + Definition Transitive : Prop := forall x y z:U, R x y -> R y z -> R x z. - Definition Symmetric : Prop := (x,y: U) (R x y) -> (R y x). + Definition Symmetric : Prop := forall x y:U, R x y -> R y x. - Definition Antisymmetric : Prop := - (x: U) (y: U) (R x y) -> (R y x) -> x == y. + Definition Antisymmetric : Prop := forall x y:U, R x y -> R y x -> x = y. - Definition contains : Relation -> Relation -> Prop := - [R,R': Relation] (x: U) (y: U) (R' x y) -> (R x y). + Definition contains (R R':Relation) : Prop := + forall x y:U, R' x y -> R x y. - Definition same_relation : Relation -> Relation -> Prop := - [R,R': Relation] (contains R R') /\ (contains R' R). + Definition same_relation (R R':Relation) : Prop := + contains R R' /\ contains R' R. Inductive Preorder : Prop := - Definition_of_preorder: Reflexive -> Transitive -> Preorder. + Definition_of_preorder : Reflexive -> Transitive -> Preorder. Inductive Order : Prop := - Definition_of_order: Reflexive -> Transitive -> Antisymmetric -> Order. + Definition_of_order : + Reflexive -> Transitive -> Antisymmetric -> Order. Inductive Equivalence : Prop := - Definition_of_equivalence: - Reflexive -> Transitive -> Symmetric -> Equivalence. + Definition_of_equivalence : + Reflexive -> Transitive -> Symmetric -> Equivalence. Inductive PER : Prop := - Definition_of_PER: Symmetric -> Transitive -> PER. + Definition_of_PER : Symmetric -> Transitive -> PER. End Relations_1. -Hints Unfold Reflexive Transitive Antisymmetric Symmetric contains - same_relation : sets v62. -Hints Resolve Definition_of_preorder Definition_of_order - Definition_of_equivalence Definition_of_PER : sets v62. +Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains + same_relation: sets v62. +Hint Resolve Definition_of_preorder Definition_of_order + Definition_of_equivalence Definition_of_PER: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v index b490fa7a0..61557aff7 100755 --- a/theories/Sets/Relations_1_facts.v +++ b/theories/Sets/Relations_1_facts.v @@ -28,82 +28,85 @@ Require Export Relations_1. -Definition Complement : (U: Type) (Relation U) -> (Relation U) := - [U: Type] [R: (Relation U)] [x,y: U] ~ (R x y). +Definition Complement (U:Type) (R:Relation U) : Relation U := + fun x y:U => ~ R x y. -Theorem Rsym_imp_notRsym: (U: Type) (R: (Relation U)) (Symmetric U R) -> - (Symmetric U (Complement U R)). +Theorem Rsym_imp_notRsym : + forall (U:Type) (R:Relation U), + Symmetric U R -> Symmetric U (Complement U R). Proof. -Unfold Symmetric Complement. -Intros U R H' x y H'0; Red; Intro H'1; Apply H'0; Auto with sets. +unfold Symmetric, Complement in |- *. +intros U R H' x y H'0; red in |- *; intro H'1; apply H'0; auto with sets. Qed. Theorem Equiv_from_preorder : - (U: Type) (R: (Relation U)) (Preorder U R) -> - (Equivalence U [x,y: U] (R x y) /\ (R y x)). + forall (U:Type) (R:Relation U), + Preorder U R -> Equivalence U (fun x y:U => R x y /\ R y x). 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; 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. +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. +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. Qed. -Hints Resolve Equiv_from_preorder. +Hint Resolve Equiv_from_preorder. Theorem Equiv_from_order : - (U: Type) (R: (Relation U)) (Order U R) -> - (Equivalence U [x,y: U] (R x y) /\ (R y x)). + forall (U:Type) (R:Relation U), + Order U R -> Equivalence U (fun x y:U => R x y /\ R y x). Proof. -Intros U R H'; Elim H'; Auto 10 with sets. +intros U R H'; elim H'; auto 10 with sets. Qed. -Hints Resolve Equiv_from_order. +Hint Resolve Equiv_from_order. Theorem contains_is_preorder : - (U: Type) (Preorder (Relation U) (contains U)). + forall U:Type, Preorder (Relation U) (contains U). Proof. -Auto 10 with sets. +auto 10 with sets. Qed. -Hints Resolve contains_is_preorder. +Hint Resolve contains_is_preorder. Theorem same_relation_is_equivalence : - (U: Type) (Equivalence (Relation U) (same_relation U)). + forall U:Type, Equivalence (Relation U) (same_relation U). Proof. -Unfold 1 same_relation; Auto 10 with sets. +unfold same_relation at 1 in |- *; auto 10 with sets. Qed. -Hints Resolve same_relation_is_equivalence. +Hint Resolve same_relation_is_equivalence. -Theorem cong_reflexive_same_relation: - (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Reflexive U R) -> - (Reflexive U R'). +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; Intuition. +unfold same_relation in |- *; intuition. Qed. -Theorem cong_symmetric_same_relation: - (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Symmetric U R) -> - (Symmetric U R'). +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;Intros;Elim H;Intros;Clear H;Apply (H3 y x (H0 x y (H2 x y H1))). + compute in |- *; intros; elim H; intros; clear H; + apply (H3 y x (H0 x y (H2 x y H1))). (*Intuition.*) Qed. -Theorem cong_antisymmetric_same_relation: - (U:Type) (R, R':(Relation U)) (same_relation U R R') -> - (Antisymmetric U R) -> (Antisymmetric U R'). +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;Intros;Elim H;Intros;Clear H;Apply (H0 x y (H3 x y H1) (H3 y x H2)). + compute in |- *; intros; elim H; intros; clear H; + apply (H0 x y (H3 x y H1) (H3 y x H2)). (*Intuition.*) Qed. -Theorem cong_transitive_same_relation: - (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Transitive U R) -> - (Transitive U R'). +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. -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. -Qed. +intros U R R' H' H'0; red in |- *. +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. +Qed.
\ No newline at end of file diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v index 65363d816..d7ee68b66 100755 --- a/theories/Sets/Relations_2.v +++ b/theories/Sets/Relations_2.v @@ -29,28 +29,28 @@ Require Export Relations_1. Section Relations_2. -Variable U: Type. -Variable R: (Relation U). +Variable U : Type. +Variable R : Relation U. -Inductive Rstar : (Relation U) := - Rstar_0: (x: U) (Rstar x x) - | Rstar_n: (x, y, z: U) (R x y) -> (Rstar y z) -> (Rstar x z). +Inductive Rstar : Relation U := + | Rstar_0 : forall x:U, Rstar x x + | Rstar_n : forall x y z:U, R x y -> Rstar y z -> Rstar x z. -Inductive Rstar1 : (Relation U) := - Rstar1_0: (x: U) (Rstar1 x x) - | Rstar1_1: (x: U) (y: U) (R x y) -> (Rstar1 x y) - | Rstar1_n: (x, y, z: U) (Rstar1 x y) -> (Rstar1 y z) -> (Rstar1 x z). +Inductive Rstar1 : Relation U := + | Rstar1_0 : forall x:U, Rstar1 x x + | Rstar1_1 : forall x y:U, R x y -> Rstar1 x y + | Rstar1_n : forall x y z:U, Rstar1 x y -> Rstar1 y z -> Rstar1 x z. -Inductive Rplus : (Relation U) := - Rplus_0: (x, y: U) (R x y) -> (Rplus x y) - | Rplus_n: (x, y, z: U) (R x y) -> (Rplus y z) -> (Rplus x z). +Inductive Rplus : Relation U := + | Rplus_0 : forall x y:U, R x y -> Rplus x y + | Rplus_n : forall x y z:U, R x y -> Rplus y z -> Rplus x z. Definition Strongly_confluent : Prop := - (x, a, b: U) (R x a) -> (R x b) -> (exT U [z: U] (R a z) /\ (R b z)). + forall x a b:U, R x a -> R x b -> ex (fun z:U => R a z /\ R b z). End Relations_2. -Hints Resolve Rstar_0 : sets v62. -Hints Resolve Rstar1_0 : sets v62. -Hints Resolve Rstar1_1 : sets v62. -Hints Resolve Rplus_0 : sets v62. +Hint Resolve Rstar_0: sets v62. +Hint Resolve Rstar1_0: sets v62. +Hint Resolve Rstar1_1: sets v62. +Hint Resolve Rplus_0: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v index 588b7f431..4fda8d8e9 100755 --- a/theories/Sets/Relations_2_facts.v +++ b/theories/Sets/Relations_2_facts.v @@ -30,122 +30,124 @@ Require Export Relations_1. Require Export Relations_1_facts. Require Export Relations_2. -Theorem Rstar_reflexive : - (U: Type) (R: (Relation U)) (Reflexive U (Rstar U R)). +Theorem Rstar_reflexive : + forall (U:Type) (R:Relation U), Reflexive U (Rstar U R). Proof. -Auto with sets. +auto with sets. Qed. Theorem Rplus_contains_R : - (U: Type) (R: (Relation U)) (contains U (Rplus U R) R). + forall (U:Type) (R:Relation U), contains U (Rplus U R) R. Proof. -Auto with sets. +auto with sets. Qed. Theorem Rstar_contains_R : - (U: Type) (R: (Relation U)) (contains U (Rstar U R) R). + forall (U:Type) (R:Relation U), contains U (Rstar U R) R. Proof. -Intros U R; Red; Intros x y H'; Apply Rstar_n with y; Auto with sets. +intros U R; red in |- *; intros x y H'; apply Rstar_n with y; auto with sets. Qed. Theorem Rstar_contains_Rplus : - (U: Type) (R: (Relation U)) (contains U (Rstar U R) (Rplus U R)). + forall (U:Type) (R:Relation U), contains U (Rstar U R) (Rplus U R). Proof. -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. +intros U R; red in |- *. +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. Qed. Theorem Rstar_transitive : - (U: Type) (R: (Relation U)) (Transitive U (Rstar U R)). + forall (U:Type) (R:Relation U), Transitive U (Rstar U R). Proof. -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. +intros U R; red in |- *. +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. Theorem Rstar_cases : - (U: Type) (R: (Relation U)) (x, y: U) (Rstar U R x y) -> - x == y \/ (EXT u | (R x u) /\ (Rstar U R u y)). + forall (U:Type) (R:Relation U) (x y:U), + Rstar U R x y -> x = y \/ ( exists u : _ | R x u /\ Rstar U R u y). Proof. -Intros U R x y H'; Elim H'; Auto with sets. -Intros x0 y0 z H'0 H'1 H'2; Right; Exists y0; Auto with sets. +intros U R x y H'; elim H'; auto with sets. +intros x0 y0 z H'0 H'1 H'2; right; exists y0; auto with sets. Qed. Theorem Rstar_equiv_Rstar1 : - (U: Type) (R: (Relation U)) (same_relation U (Rstar U R) (Rstar1 U R)). + 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. -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. -Intros x0 y0 z H'0 H'1 H'2; Apply Rstar1_n with y0; Auto with sets. +generalize Rstar_contains_R; intro T; red in T. +intros U R; unfold same_relation, contains in |- *. +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. +intros x0 y0 z H'0 H'1 H'2; apply Rstar1_n with y0; auto with sets. Qed. Theorem Rsym_imp_Rstarsym : - (U: Type) (R: (Relation U)) (Symmetric U R) -> (Symmetric U (Rstar U R)). + forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Rstar U R). Proof. -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. -Apply T1 with y0; Auto with sets. -Apply Rstar_n with x0; Auto with sets. +intros U R H'; red in |- *. +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. +apply T1 with y0; auto with sets. +apply Rstar_n with x0; auto with sets. Qed. Theorem Sstar_contains_Rstar : - (U: Type) (R, S: (Relation U)) (contains U (Rstar U S) R) -> - (contains U (Rstar U S) (Rstar U R)). + forall (U:Type) (R S:Relation U), + contains U (Rstar U S) R -> contains U (Rstar U S) (Rstar U R). Proof. -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. +unfold contains in |- *. +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. Qed. Theorem star_monotone : - (U: Type) (R, S: (Relation U)) (contains U S R) -> - (contains U (Rstar U S) (Rstar U R)). + forall (U:Type) (R S:Relation U), + contains U S R -> contains U (Rstar U S) (Rstar U R). Proof. -Intros U R S H'. -Apply Sstar_contains_Rstar; Auto with sets. -Generalize (Rstar_contains_R U S); Auto with sets. +intros U R S H'. +apply Sstar_contains_Rstar; auto with sets. +generalize (Rstar_contains_R U S); auto with sets. Qed. Theorem RstarRplus_RRstar : - (U: Type) (R: (Relation U)) (x, y, z: U) - (Rstar U R x y) -> (Rplus U R y z) -> - (EXT u | (R x u) /\ (Rstar U R u z)). + forall (U:Type) (R:Relation U) (x y z:U), + Rstar U R x y -> Rplus U R y z -> exists u : _ | R x u /\ Rstar U R u z. Proof. -Generalize Rstar_contains_Rplus; Intro T; Red in T. -Generalize Rstar_transitive; Intro T1; Red in T1. -Intros U R x y z H'; Elim H'. -Intros x0 H'0; Elim H'0. -Intros x1 y0 H'1; Exists y0; Auto with sets. -Intros x1 y0 z0 H'1 H'2 H'3; Exists y0; Auto with sets. -Intros x0 y0 z0 H'0 H'1 H'2 H'3; Exists y0. -Split; [Try Assumption | Idtac]. -Apply T1 with z0; Auto with sets. +generalize Rstar_contains_Rplus; intro T; red in T. +generalize Rstar_transitive; intro T1; red in T1. +intros U R x y z H'; elim H'. +intros x0 H'0; elim H'0. +intros x1 y0 H'1; exists y0; auto with sets. +intros x1 y0 z0 H'1 H'2 H'3; exists y0; auto with sets. +intros x0 y0 z0 H'0 H'1 H'2 H'3; exists y0. +split; [ try assumption | idtac ]. +apply T1 with z0; auto with sets. Qed. -Theorem Lemma1 : - (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> - (x, b: U) (Rstar U R x b) -> - (a: U) (R x a) -> (EXT z | (Rstar U R a z) /\ (R b z)). +Theorem Lemma1 : + forall (U:Type) (R:Relation U), + Strongly_confluent U R -> + forall x b:U, + Rstar U R x b -> + forall a:U, R x a -> exists z : _ | Rstar U R a z /\ R b z. Proof. -Intros U R H' x b H'0; Elim H'0. -Intros x0 a H'1; Exists a; Auto with sets. -Intros x0 y z H'1 H'2 H'3 a H'4. -Red in H'. -Specialize 3 H' with x := x0 a := a b := y; Intro H'7; LApply H'7; - [Intro H'8; LApply H'8; - [Intro H'9; Try Exact H'9; Clear H'8 H'7 | Clear H'8 H'7] | Clear H'7]; Auto with sets. -Elim H'9. -Intros t H'5; Elim H'5; Intros H'6 H'7; Try Exact H'6; Clear H'5. -Elim (H'3 t); Auto with sets. -Intros z1 H'5; Elim H'5; Intros H'8 H'10; Try Exact H'8; Clear H'5. -Exists z1; Split; [Idtac | Assumption]. -Apply Rstar_n with t; Auto with sets. -Qed. +intros U R H' x b H'0; elim H'0. +intros x0 a H'1; exists a; auto with sets. +intros x0 y z H'1 H'2 H'3 a H'4. +red in H'. +specialize 3H' with (x := x0) (a := a) (b := y); intro H'7; lapply H'7; + [ intro H'8; lapply H'8; + [ intro H'9; try exact H'9; clear H'8 H'7 | clear H'8 H'7 ] + | clear H'7 ]; auto with sets. +elim H'9. +intros t H'5; elim H'5; intros H'6 H'7; try exact H'6; clear H'5. +elim (H'3 t); auto with sets. +intros z1 H'5; elim H'5; intros H'8 H'10; try exact H'8; clear H'5. +exists z1; split; [ idtac | assumption ]. +apply Rstar_n with t; auto with sets. +Qed.
\ No newline at end of file diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v index 90c055775..1fe689002 100755 --- a/theories/Sets/Relations_3.v +++ b/theories/Sets/Relations_3.v @@ -30,34 +30,33 @@ Require Export Relations_1. Require Export Relations_2. Section Relations_3. - Variable U: Type. - Variable R: (Relation U). + Variable U : Type. + Variable R : Relation U. - Definition coherent : U -> U -> Prop := - [x,y: U] (EXT z | (Rstar U R x z) /\ (Rstar U R y z)). + Definition coherent (x y:U) : Prop := + exists z : _ | Rstar U R x z /\ Rstar U R y z. - Definition locally_confluent : U -> Prop := - [x: U] (y,z: U) (R x y) -> (R x z) -> (coherent y z). + Definition locally_confluent (x:U) : Prop := + forall y z:U, R x y -> R x z -> coherent y z. - Definition Locally_confluent : Prop := (x: U) (locally_confluent x). + Definition Locally_confluent : Prop := forall x:U, locally_confluent x. - Definition confluent : U -> Prop := - [x: U] (y,z: U) (Rstar U R x y) -> (Rstar U R x z) -> (coherent y z). + Definition confluent (x:U) : Prop := + forall y z:U, Rstar U R x y -> Rstar U R x z -> coherent y z. - Definition Confluent : Prop := (x: U) (confluent x). + Definition Confluent : Prop := forall x:U, confluent x. - Inductive noetherian : U -> Prop := - definition_of_noetherian: - (x: U) ((y: U) (R x y) -> (noetherian y)) -> (noetherian x). + Inductive noetherian : U -> Prop := + definition_of_noetherian : + forall x:U, (forall y:U, R x y -> noetherian y) -> noetherian x. - Definition Noetherian : Prop := (x: U) (noetherian x). + Definition Noetherian : Prop := forall x:U, noetherian x. End Relations_3. -Hints Unfold coherent : sets v62. -Hints Unfold locally_confluent : sets v62. -Hints Unfold confluent : sets v62. -Hints Unfold Confluent : sets v62. -Hints Resolve definition_of_noetherian : sets v62. -Hints Unfold Noetherian : sets v62. - +Hint Unfold coherent: sets v62. +Hint Unfold locally_confluent: sets v62. +Hint Unfold confluent: sets v62. +Hint Unfold Confluent: sets v62. +Hint Resolve definition_of_noetherian: sets v62. +Hint Unfold Noetherian: sets v62. diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v index a57487d1e..5b1ce9e31 100755 --- a/theories/Sets/Relations_3_facts.v +++ b/theories/Sets/Relations_3_facts.v @@ -33,125 +33,139 @@ Require Export Relations_2_facts. Require Export Relations_3. Theorem Rstar_imp_coherent : - (U: Type) (R: (Relation U)) (x: U) (y: U) (Rstar U R x y) -> - (coherent U R x y). + 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. -Exists y; Auto with sets. +intros U R x y H'; red in |- *. +exists y; auto with sets. Qed. -Hints Resolve Rstar_imp_coherent. +Hint Resolve Rstar_imp_coherent. Theorem coherent_symmetric : - (U: Type) (R: (Relation U)) (Symmetric U (coherent U R)). + forall (U:Type) (R:Relation U), Symmetric U (coherent U R). Proof. -Unfold 1 coherent. -Intros U R; Red. -Intros x y H'; Elim H'. -Intros z H'0; Exists z; Tauto. +unfold coherent at 1 in |- *. +intros U R; red in |- *. +intros x y H'; elim H'. +intros z H'0; exists z; tauto. Qed. Theorem Strong_confluence : - (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R). + forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R. Proof. -Intros U R H'; Red. -Intro x; Red; Intros a b H'0. -Unfold 1 coherent. -Generalize b; Clear b. -Elim H'0; Clear H'0. -Intros x0 b H'1; Exists b; Auto with sets. -Intros x0 y z H'1 H'2 H'3 b H'4. -Generalize (Lemma1 U R); Intro h; LApply h; - [Intro H'0; Generalize (H'0 x0 b); Intro h0; LApply h0; - [Intro H'5; Generalize (H'5 y); Intro h1; LApply h1; - [Intro h2; Elim h2; Intros z0 h3; Elim h3; Intros H'6 H'7; - Clear h h0 h1 h2 h3 | Clear h h0 h1] | Clear h h0] | Clear h]; Auto with sets. -Generalize (H'3 z0); Intro h; LApply h; - [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h h0 h1 | - Clear h]; Auto with sets. -Exists z1; Split; Auto with sets. -Apply Rstar_n with z0; Auto with sets. +intros U R H'; red in |- *. +intro x; red in |- *; intros a b H'0. +unfold coherent at 1 in |- *. +generalize b; clear b. +elim H'0; clear H'0. +intros x0 b H'1; exists b; auto with sets. +intros x0 y z H'1 H'2 H'3 b H'4. +generalize (Lemma1 U R); intro h; lapply h; + [ intro H'0; generalize (H'0 x0 b); intro h0; lapply h0; + [ intro H'5; generalize (H'5 y); intro h1; lapply h1; + [ intro h2; elim h2; intros z0 h3; elim h3; intros H'6 H'7; + clear h h0 h1 h2 h3 + | clear h h0 h1 ] + | clear h h0 ] + | clear h ]; auto with sets. +generalize (H'3 z0); intro h; lapply h; + [ intro h0; elim h0; intros z1 h1; elim h1; intros H'8 H'9; clear h h0 h1 + | clear h ]; auto with sets. +exists z1; split; auto with sets. +apply Rstar_n with z0; auto with sets. Qed. Theorem Strong_confluence_direct : - (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R). + forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R. Proof. -Intros U R H'; Red. -Intro x; Red; Intros a b H'0. -Unfold 1 coherent. -Generalize b; Clear b. -Elim H'0; Clear H'0. -Intros x0 b H'1; Exists b; Auto with sets. -Intros x0 y z H'1 H'2 H'3 b H'4. -Cut (exT U [t: U] (Rstar U R y t) /\ (R b t)). -Intro h; Elim h; Intros t h0; Elim h0; Intros H'0 H'5; Clear h h0. -Generalize (H'3 t); Intro h; LApply h; - [Intro h0; Elim h0; Intros z0 h1; Elim h1; Intros H'6 H'7; Clear h h0 h1 | - Clear h]; Auto with sets. -Exists z0; Split; [Assumption | Idtac]. -Apply Rstar_n with t; Auto with sets. -Generalize H'1; Generalize y; Clear H'1. -Elim H'4. -Intros x1 y0 H'0; Exists y0; Auto with sets. -Intros x1 y0 z0 H'0 H'1 H'5 y1 H'6. -Red in H'. -Generalize (H' x1 y0 y1); Intro h; LApply h; - [Intro H'7; LApply H'7; - [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h H'7 h0 h1 | - Clear h] | Clear h]; Auto with sets. -Generalize (H'5 z1); Intro h; LApply h; - [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'7 H'10; Clear h h0 h1 | - Clear h]; Auto with sets. -Exists t; Split; Auto with sets. -Apply Rstar_n with z1; Auto with sets. +intros U R H'; red in |- *. +intro x; red in |- *; intros a b H'0. +unfold coherent at 1 in |- *. +generalize b; clear b. +elim H'0; clear H'0. +intros x0 b H'1; exists b; auto with sets. +intros x0 y z H'1 H'2 H'3 b H'4. +cut (ex (fun t:U => Rstar U R y t /\ R b t)). +intro h; elim h; intros t h0; elim h0; intros H'0 H'5; clear h h0. +generalize (H'3 t); intro h; lapply h; + [ intro h0; elim h0; intros z0 h1; elim h1; intros H'6 H'7; clear h h0 h1 + | clear h ]; auto with sets. +exists z0; split; [ assumption | idtac ]. +apply Rstar_n with t; auto with sets. +generalize H'1; generalize y; clear H'1. +elim H'4. +intros x1 y0 H'0; exists y0; auto with sets. +intros x1 y0 z0 H'0 H'1 H'5 y1 H'6. +red in H'. +generalize (H' x1 y0 y1); intro h; lapply h; + [ intro H'7; lapply H'7; + [ intro h0; elim h0; intros z1 h1; elim h1; intros H'8 H'9; + clear h H'7 h0 h1 + | clear h ] + | clear h ]; auto with sets. +generalize (H'5 z1); intro h; lapply h; + [ intro h0; elim h0; intros t h1; elim h1; intros H'7 H'10; clear h h0 h1 + | clear h ]; auto with sets. +exists t; split; auto with sets. +apply Rstar_n with z1; auto with sets. Qed. Theorem Noetherian_contains_Noetherian : - (U: Type) (R, R': (Relation U)) (Noetherian U R) -> (contains U R R') -> - (Noetherian U R'). + forall (U:Type) (R R':Relation U), + Noetherian U R -> contains U R R' -> Noetherian U R'. Proof. -Unfold 2 Noetherian. -Intros U R R' H' H'0 x. -Elim (H' x); Auto with sets. +unfold Noetherian at 2 in |- *. +intros U R R' H' H'0 x. +elim (H' x); auto with sets. Qed. Theorem Newman : - (U: Type) (R: (Relation U)) (Noetherian U R) -> (Locally_confluent U R) -> - (Confluent U R). + forall (U:Type) (R:Relation U), + Noetherian U R -> Locally_confluent U R -> Confluent U R. Proof. -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; - [Clear h h0; Intro h1 | - Intro h1; Elim h1; Intros u h2; Elim h2; Intros H'5 H'6; Clear h h0 h1 h2] | - Clear h]; Auto with sets. -Elim h1; Auto with sets. -Generalize (Rstar_cases U R x0 z); Intro h; LApply h; - [Intro h0; Elim h0; - [Clear h h0; Intro h1 | - Intro h1; Elim h1; Intros v h2; Elim h2; Intros H'7 H'8; Clear h h0 h1 h2] | - Clear h]; Auto with sets. -Elim h1; Generalize coherent_symmetric; Intro t; Red in t; Auto with sets. -Unfold Locally_confluent locally_confluent coherent in H'0. -Generalize (H'0 x0 u v); Intro h; LApply h; - [Intro H'9; LApply H'9; - [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'10 H'11; - Clear h H'9 h0 h1 | Clear h] | Clear h]; Auto with sets. -Clear H'0. -Unfold 1 coherent in H'2. -Generalize (H'2 u); Intro h; LApply h; - [Intro H'0; Generalize (H'0 y t); Intro h0; LApply h0; - [Intro H'9; LApply H'9; - [Intro h1; Elim h1; Intros y1 h2; Elim h2; Intros H'12 H'13; - Clear h h0 H'9 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; Auto with sets. -Generalize Rstar_transitive; Intro T; Red in T. -Generalize (H'2 v); Intro h; LApply h; - [Intro H'9; Generalize (H'9 y1 z); Intro h0; LApply h0; - [Intro H'14; LApply H'14; - [Intro h1; Elim h1; Intros z1 h2; Elim h2; Intros H'15 H'16; - Clear h h0 H'14 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; 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. +intros U R H' H'0; red in |- *; intro x. +elim (H' x); unfold confluent in |- *. +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; + [ clear h h0; intro h1 + | intro h1; elim h1; intros u h2; elim h2; intros H'5 H'6; + clear h h0 h1 h2 ] + | clear h ]; auto with sets. +elim h1; auto with sets. +generalize (Rstar_cases U R x0 z); intro h; lapply h; + [ intro h0; elim h0; + [ clear h h0; intro h1 + | intro h1; elim h1; intros v h2; elim h2; intros H'7 H'8; + clear h h0 h1 h2 ] + | clear h ]; auto with sets. +elim h1; generalize coherent_symmetric; intro t; red in t; auto with sets. +unfold Locally_confluent, locally_confluent, coherent in H'0. +generalize (H'0 x0 u v); intro h; lapply h; + [ intro H'9; lapply H'9; + [ intro h0; elim h0; intros t h1; elim h1; intros H'10 H'11; + clear h H'9 h0 h1 + | clear h ] + | clear h ]; auto with sets. +clear H'0. +unfold coherent at 1 in H'2. +generalize (H'2 u); intro h; lapply h; + [ intro H'0; generalize (H'0 y t); intro h0; lapply h0; + [ intro H'9; lapply H'9; + [ intro h1; elim h1; intros y1 h2; elim h2; intros H'12 H'13; + clear h h0 H'9 h1 h2 + | clear h h0 ] + | clear h h0 ] + | clear h ]; auto with sets. +generalize Rstar_transitive; intro T; red in T. +generalize (H'2 v); intro h; lapply h; + [ intro H'9; generalize (H'9 y1 z); intro h0; lapply h0; + [ intro H'14; lapply H'14; + [ intro h1; elim h1; intros z1 h2; elim h2; intros H'15 H'16; + clear h h0 H'14 h1 h2 + | clear h h0 ] + | clear h h0 ] + | clear h ]; auto with sets. +red in |- *; (exists z1; split); auto with sets. +apply T with y1; auto with sets. +apply T with t; auto with sets. +Qed.
\ No newline at end of file diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v index 5b28d6c2b..e1ba00209 100644 --- a/theories/Sets/Uniset.v +++ b/theories/Sets/Uniset.v @@ -13,7 +13,7 @@ (* G. Huet 1-9-95 *) (* Updated Papageno 12/98 *) -Require Bool. +Require Import Bool. Set Implicit Arguments. @@ -21,121 +21,118 @@ Section defs. Variable A : Set. Variable eqA : A -> A -> Prop. -Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}. +Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. -Inductive uniset : Set := - Charac : (A->bool) -> uniset. +Inductive uniset : Set := + Charac : (A -> bool) -> uniset. -Definition charac : uniset -> A -> bool := - [s:uniset][a:A]Case s of [f:A->bool](f a) end. +Definition charac (s:uniset) (a:A) : bool := let (f) := s in f a. -Definition Emptyset := (Charac [a:A]false). +Definition Emptyset := Charac (fun a:A => false). -Definition Fullset := (Charac [a:A]true). +Definition Fullset := Charac (fun a:A => true). -Definition Singleton := [a:A](Charac [a':A] - Case (eqA_dec a a') of - [h:(eqA a a')] true - [h: ~(eqA a a')] false end). +Definition Singleton (a:A) := + Charac + (fun a':A => + match eqA_dec a a' with + | left h => true + | right h => false + end). -Definition In : uniset -> A -> Prop := - [s:uniset][a:A](charac s a)=true. -Hints Unfold In. +Definition In (s:uniset) (a:A) : Prop := charac s a = true. +Hint Unfold In. (** uniset inclusion *) -Definition incl := [s1,s2:uniset] - (a:A)(leb (charac s1 a) (charac s2 a)). -Hints Unfold incl. +Definition incl (s1 s2:uniset) := forall a:A, leb (charac s1 a) (charac s2 a). +Hint Unfold incl. (** uniset equality *) -Definition seq := [s1,s2:uniset] - (a:A)(charac s1 a) = (charac s2 a). -Hints Unfold seq. +Definition seq (s1 s2:uniset) := forall a:A, charac s1 a = charac s2 a. +Hint Unfold seq. -Lemma leb_refl : (b:bool)(leb b b). +Lemma leb_refl : forall b:bool, leb b b. Proof. -NewDestruct b; Simpl; Auto. +destruct b; simpl in |- *; auto. Qed. -Hints Resolve leb_refl. +Hint Resolve leb_refl. -Lemma incl_left : (s1,s2:uniset)(seq s1 s2)->(incl s1 s2). +Lemma incl_left : forall s1 s2:uniset, seq s1 s2 -> incl s1 s2. Proof. -Unfold incl; Intros s1 s2 E a; Elim (E a); Auto. +unfold incl in |- *; intros s1 s2 E a; elim (E a); auto. Qed. -Lemma incl_right : (s1,s2:uniset)(seq s1 s2)->(incl s2 s1). +Lemma incl_right : forall s1 s2:uniset, seq s1 s2 -> incl s2 s1. Proof. -Unfold incl; Intros s1 s2 E a; Elim (E a); Auto. +unfold incl in |- *; intros s1 s2 E a; elim (E a); auto. Qed. -Lemma seq_refl : (x:uniset)(seq x x). +Lemma seq_refl : forall x:uniset, seq x x. Proof. -NewDestruct x; Unfold seq; Auto. +destruct x; unfold seq in |- *; auto. Qed. -Hints Resolve seq_refl. +Hint Resolve seq_refl. -Lemma seq_trans : (x,y,z:uniset)(seq x y)->(seq y z)->(seq x z). +Lemma seq_trans : forall x y z:uniset, seq x y -> seq y z -> seq x z. Proof. -Unfold seq. -NewDestruct x; NewDestruct y; NewDestruct z; Simpl; Intros. -Rewrite H; Auto. +unfold seq in |- *. +destruct x; destruct y; destruct z; simpl in |- *; intros. +rewrite H; auto. Qed. -Lemma seq_sym : (x,y:uniset)(seq x y)->(seq y x). +Lemma seq_sym : forall x y:uniset, seq x y -> seq y x. Proof. -Unfold seq. -NewDestruct x; NewDestruct y; Simpl; Auto. +unfold seq in |- *. +destruct x; destruct y; simpl in |- *; auto. Qed. (** uniset union *) -Definition union := [m1,m2:uniset] - (Charac [a:A](orb (charac m1 a)(charac m2 a))). +Definition union (m1 m2:uniset) := + Charac (fun a:A => orb (charac m1 a) (charac m2 a)). -Lemma union_empty_left : - (x:uniset)(seq x (union Emptyset x)). +Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x). Proof. -Unfold seq; Unfold union; Simpl; Auto. +unfold seq in |- *; unfold union in |- *; simpl in |- *; auto. Qed. -Hints Resolve union_empty_left. +Hint Resolve union_empty_left. -Lemma union_empty_right : - (x:uniset)(seq x (union x Emptyset)). +Lemma union_empty_right : forall x:uniset, seq x (union x Emptyset). Proof. -Unfold seq; Unfold union; Simpl. -Intros x a; Rewrite (orb_b_false (charac x a)); Auto. +unfold seq in |- *; unfold union in |- *; simpl in |- *. +intros x a; rewrite (orb_b_false (charac x a)); auto. Qed. -Hints Resolve union_empty_right. +Hint Resolve union_empty_right. -Lemma union_comm : (x,y:uniset)(seq (union x y) (union y x)). +Lemma union_comm : forall x y:uniset, seq (union x y) (union y x). Proof. -Unfold seq; Unfold charac; Unfold union. -NewDestruct x; NewDestruct y; Auto with bool. +unfold seq in |- *; unfold charac in |- *; unfold union in |- *. +destruct x; destruct y; auto with bool. Qed. -Hints Resolve union_comm. +Hint Resolve union_comm. -Lemma union_ass : - (x,y,z:uniset)(seq (union (union x y) z) (union x (union y z))). +Lemma union_ass : + forall x y z:uniset, seq (union (union x y) z) (union x (union y z)). Proof. -Unfold seq; Unfold union; Unfold charac. -NewDestruct x; NewDestruct y; NewDestruct z; Auto with bool. +unfold seq in |- *; unfold union in |- *; unfold charac in |- *. +destruct x; destruct y; destruct z; auto with bool. Qed. -Hints Resolve union_ass. +Hint Resolve union_ass. -Lemma seq_left : (x,y,z:uniset)(seq x y)->(seq (union x z) (union y z)). +Lemma seq_left : forall x y z:uniset, seq x y -> seq (union x z) (union y z). Proof. -Unfold seq; Unfold union; Unfold charac. -NewDestruct x; NewDestruct y; NewDestruct z. -Intros; Elim H; Auto. +unfold seq in |- *; unfold union in |- *; unfold charac in |- *. +destruct x; destruct y; destruct z. +intros; elim H; auto. Qed. -Hints Resolve seq_left. +Hint Resolve seq_left. -Lemma seq_right : (x,y,z:uniset)(seq x y)->(seq (union z x) (union z y)). +Lemma seq_right : forall x y z:uniset, seq x y -> seq (union z x) (union z y). Proof. -Unfold seq; Unfold union; Unfold charac. -NewDestruct x; NewDestruct y; NewDestruct z. -Intros; Elim H; Auto. +unfold seq in |- *; unfold union in |- *; unfold charac in |- *. +destruct x; destruct y; destruct z. +intros; elim H; auto. Qed. -Hints Resolve seq_right. +Hint Resolve seq_right. (** All the proofs that follow duplicate [Multiset_of_A] *) @@ -143,60 +140,66 @@ Hints Resolve seq_right. (** Here we should make uniset an abstract datatype, by hiding [Charac], [union], [charac]; all further properties are proved abstractly *) -Require Permut. +Require Import Permut. Lemma union_rotate : - (x,y,z:uniset)(seq (union x (union y z)) (union z (union x y))). + forall x y z:uniset, seq (union x (union y z)) (union z (union x y)). Proof. -Intros; Apply (op_rotate uniset union seq); Auto. -Exact seq_trans. +intros; apply (op_rotate uniset union seq); auto. +exact seq_trans. Qed. -Lemma seq_congr : (x,y,z,t:uniset)(seq x y)->(seq z t)-> - (seq (union x z) (union y t)). +Lemma seq_congr : + forall x y z t:uniset, seq x y -> seq z t -> seq (union x z) (union y t). Proof. -Intros; Apply (cong_congr uniset union seq); Auto. -Exact seq_trans. +intros; apply (cong_congr uniset union seq); auto. +exact seq_trans. Qed. Lemma union_perm_left : - (x,y,z:uniset)(seq (union x (union y z)) (union y (union x z))). + forall x y z:uniset, seq (union x (union y z)) (union y (union x z)). Proof. -Intros; Apply (perm_left uniset union seq); Auto. -Exact seq_trans. +intros; apply (perm_left uniset union seq); auto. +exact seq_trans. Qed. -Lemma uniset_twist1 : (x,y,z,t:uniset) - (seq (union x (union (union y z) t)) (union (union y (union x t)) z)). +Lemma uniset_twist1 : + forall x y z t:uniset, + seq (union x (union (union y z) t)) (union (union y (union x t)) z). Proof. -Intros; Apply (twist uniset union seq); Auto. -Exact seq_trans. +intros; apply (twist uniset union seq); auto. +exact seq_trans. Qed. -Lemma uniset_twist2 : (x,y,z,t:uniset) - (seq (union x (union (union y z) t)) (union (union y (union x z)) t)). +Lemma uniset_twist2 : + forall x y z t:uniset, + seq (union x (union (union y z) t)) (union (union y (union x z)) t). Proof. -Intros; Apply seq_trans with (union (union x (union y z)) t). -Apply seq_sym; Apply union_ass. -Apply seq_left; Apply union_perm_left. +intros; apply seq_trans with (union (union x (union y z)) t). +apply seq_sym; apply union_ass. +apply seq_left; apply union_perm_left. Qed. (** specific for treesort *) -Lemma treesort_twist1 : (x,y,z,t,u:uniset) (seq u (union y z)) -> - (seq (union x (union u t)) (union (union y (union x t)) z)). +Lemma treesort_twist1 : + forall x y z t u:uniset, + seq u (union y z) -> + seq (union x (union u t)) (union (union y (union x t)) z). Proof. -Intros; Apply seq_trans with (union x (union (union y z) t)). -Apply seq_right; Apply seq_left; Trivial. -Apply uniset_twist1. +intros; apply seq_trans with (union x (union (union y z) t)). +apply seq_right; apply seq_left; trivial. +apply uniset_twist1. Qed. -Lemma treesort_twist2 : (x,y,z,t,u:uniset) (seq u (union y z)) -> - (seq (union x (union u t)) (union (union y (union x z)) t)). +Lemma treesort_twist2 : + forall x y z t u:uniset, + seq u (union y z) -> + seq (union x (union u t)) (union (union y (union x z)) t). Proof. -Intros; Apply seq_trans with (union x (union (union y z) t)). -Apply seq_right; Apply seq_left; Trivial. -Apply uniset_twist2. +intros; apply seq_trans with (union x (union (union y z) t)). +apply seq_right; apply seq_left; trivial. +apply uniset_twist2. Qed. @@ -209,4 +212,4 @@ i*) End defs. -Unset Implicit Arguments. +Unset Implicit Arguments.
\ No newline at end of file diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v index 31e3ac447..95a40ab12 100644 --- a/theories/Sorting/Heap.v +++ b/theories/Sorting/Heap.v @@ -12,103 +12,102 @@ (* G. Huet 1-9-95 uses Multiset *) -Require PolyList. -Require Multiset. -Require Permutation. -Require Relations. -Require Sorting. +Require Import List. +Require Import Multiset. +Require Import Permutation. +Require Import Relations. +Require Import Sorting. Section defs. Variable A : Set. -Variable leA : (relation A). -Variable eqA : (relation A). +Variable leA : relation A. +Variable eqA : relation A. -Local gtA := [x,y:A]~(leA x y). +Let gtA (x y:A) := ~ leA x y. -Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}. -Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}. -Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y). -Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z). -Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y). +Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. +Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. +Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. +Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. +Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. -Hints Resolve leA_refl. -Hints Immediate eqA_dec leA_dec leA_antisym. +Hint Resolve leA_refl. +Hint Immediate eqA_dec leA_dec leA_antisym. -Local emptyBag := (EmptyBag A). -Local singletonBag := (SingletonBag eqA_dec). +Let emptyBag := EmptyBag A. +Let singletonBag := SingletonBag _ eqA_dec. Inductive Tree : Set := - Tree_Leaf : Tree - | Tree_Node : A -> Tree -> Tree -> Tree. + | Tree_Leaf : Tree + | Tree_Node : A -> Tree -> Tree -> Tree. (** [a] is lower than a Tree [T] if [T] is a Leaf or [T] is a Node holding [b>a] *) -Definition leA_Tree := [a:A; t:Tree] - Cases t of - Tree_Leaf => True - | (Tree_Node b T1 T2) => (leA a b) - end. +Definition leA_Tree (a:A) (t:Tree) := + match t with + | Tree_Leaf => True + | Tree_Node b T1 T2 => leA a b + end. -Lemma leA_Tree_Leaf : (a:A)(leA_Tree a Tree_Leaf). +Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf. Proof. -Simpl; Auto with datatypes. +simpl in |- *; auto with datatypes. Qed. -Lemma leA_Tree_Node : (a,b:A)(G,D:Tree)(leA a b) -> - (leA_Tree a (Tree_Node b G D)). +Lemma leA_Tree_Node : + forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D). Proof. -Simpl; Auto with datatypes. +simpl in |- *; auto with datatypes. Qed. -Hints Resolve leA_Tree_Leaf leA_Tree_Node. +Hint Resolve leA_Tree_Leaf leA_Tree_Node. (** The heap property *) Inductive is_heap : Tree -> Prop := - nil_is_heap : (is_heap Tree_Leaf) - | node_is_heap : (a:A)(T1,T2:Tree) - (leA_Tree a T1) -> - (leA_Tree a T2) -> - (is_heap T1) -> (is_heap T2) -> - (is_heap (Tree_Node a T1 T2)). - -Hint constr_is_heap := Constructors is_heap. - -Lemma invert_heap : (a:A)(T1,T2:Tree)(is_heap (Tree_Node a T1 T2))-> - (leA_Tree a T1) /\ (leA_Tree a T2) /\ - (is_heap T1) /\ (is_heap T2). + | nil_is_heap : is_heap Tree_Leaf + | node_is_heap : + forall (a:A) (T1 T2:Tree), + leA_Tree a T1 -> + leA_Tree a T2 -> + is_heap T1 -> is_heap T2 -> is_heap (Tree_Node a T1 T2). + +Hint Constructors is_heap. + +Lemma invert_heap : + forall (a:A) (T1 T2:Tree), + is_heap (Tree_Node a T1 T2) -> + leA_Tree a T1 /\ leA_Tree a T2 /\ is_heap T1 /\ is_heap T2. Proof. -Intros; Inversion H; Auto with datatypes. +intros; inversion H; auto with datatypes. Qed. (* This lemma ought to be generated automatically by the Inversion tools *) -Lemma is_heap_rec : (P:Tree->Set) - (P Tree_Leaf)-> - ((a:A) - (T1:Tree) - (T2:Tree) - (leA_Tree a T1)-> - (leA_Tree a T2)-> - (is_heap T1)-> - (P T1)->(is_heap T2)->(P T2)->(P (Tree_Node a T1 T2))) - -> (T:Tree)(is_heap T) -> (P T). +Lemma is_heap_rec : + forall P:Tree -> Set, + P Tree_Leaf -> + (forall (a:A) (T1 T2:Tree), + leA_Tree a T1 -> + leA_Tree a T2 -> + is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) -> + forall T:Tree, is_heap T -> P T. Proof. -Induction T; Auto with datatypes. -Intros a G PG D PD PN. -Elim (invert_heap a G D); Auto with datatypes. -Intros H1 H2; Elim H2; Intros H3 H4; Elim H4; Intros. -Apply H0; Auto with datatypes. +simple induction T; auto with datatypes. +intros a G PG D PD PN. +elim (invert_heap a G D); auto with datatypes. +intros H1 H2; elim H2; intros H3 H4; elim H4; intros. +apply H0; auto with datatypes. Qed. -Lemma low_trans : - (T:Tree)(a,b:A)(leA a b) -> (leA_Tree b T) -> (leA_Tree a T). +Lemma low_trans : + forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T. Proof. -Induction T; Auto with datatypes. -Intros; Simpl; Apply leA_trans with b; Auto with datatypes. +simple induction T; auto with datatypes. +intros; simpl in |- *; apply leA_trans with b; auto with datatypes. Qed. (** contents of a tree as a multiset *) @@ -117,107 +116,112 @@ Qed. in not used. Actually, we could just take as postulate: [Parameter SingletonBag : A->multiset]. *) -Fixpoint contents [t:Tree] : (multiset A) := - Cases t of - Tree_Leaf => emptyBag - | (Tree_Node a t1 t2) => (munion (contents t1) - (munion (contents t2) (singletonBag a))) -end. +Fixpoint contents (t:Tree) : multiset A := + match t with + | Tree_Leaf => emptyBag + | Tree_Node a t1 t2 => + munion (contents t1) (munion (contents t2) (singletonBag a)) + end. (** equivalence of two trees is equality of corresponding multisets *) -Definition equiv_Tree := [t1,t2:Tree](meq (contents t1) (contents t2)). +Definition equiv_Tree (t1 t2:Tree) := meq (contents t1) (contents t2). (** specification of heap insertion *) -Inductive insert_spec [a:A; T:Tree] : Set := - insert_exist : (T1:Tree)(is_heap T1) -> - (meq (contents T1) (munion (contents T) (singletonBag a))) -> - ((b:A)(leA b a)->(leA_Tree b T)->(leA_Tree b T1)) -> - (insert_spec a T). +Inductive insert_spec (a:A) (T:Tree) : Set := + insert_exist : + forall T1:Tree, + is_heap T1 -> + meq (contents T1) (munion (contents T) (singletonBag a)) -> + (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) -> + insert_spec a T. -Lemma insert : (T:Tree)(is_heap T) -> (a:A)(insert_spec a T). +Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T. Proof. -Induction 1; Intros. -Apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); Auto with datatypes. -Simpl; Unfold meq munion; Auto with datatypes. -Elim (leA_dec a a0); Intros. -Elim (H3 a0); Intros. -Apply insert_exist with (Tree_Node a T2 T0); Auto with datatypes. -Simpl; Apply treesort_twist1; Trivial with datatypes. -Elim (H3 a); Intros T3 HeapT3 ConT3 LeA. -Apply insert_exist with (Tree_Node a0 T2 T3); Auto with datatypes. -Apply node_is_heap; Auto with datatypes. -Apply low_trans with a; Auto with datatypes. -Apply LeA; Auto with datatypes. -Apply low_trans with a; Auto with datatypes. -Simpl; Apply treesort_twist2; Trivial with datatypes. +simple induction 1; intros. +apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); + auto with datatypes. +simpl in |- *; unfold meq, munion in |- *; auto with datatypes. +elim (leA_dec a a0); intros. +elim (H3 a0); intros. +apply insert_exist with (Tree_Node a T2 T0); auto with datatypes. +simpl in |- *; apply treesort_twist1; trivial with datatypes. +elim (H3 a); intros T3 HeapT3 ConT3 LeA. +apply insert_exist with (Tree_Node a0 T2 T3); auto with datatypes. +apply node_is_heap; auto with datatypes. +apply low_trans with a; auto with datatypes. +apply LeA; auto with datatypes. +apply low_trans with a; auto with datatypes. +simpl in |- *; apply treesort_twist2; trivial with datatypes. Qed. (** building a heap from a list *) -Inductive build_heap [l:(list A)] : Set := - heap_exist : (T:Tree)(is_heap T) -> - (meq (list_contents eqA_dec l)(contents T)) -> - (build_heap l). +Inductive build_heap (l:list A) : Set := + heap_exist : + forall T:Tree, + is_heap T -> + meq (list_contents _ eqA_dec l) (contents T) -> build_heap l. -Lemma list_to_heap : (l:(list A))(build_heap l). +Lemma list_to_heap : forall l:list A, build_heap l. Proof. -Induction l. -Apply (heap_exist (nil A) Tree_Leaf); Auto with datatypes. -Simpl; Unfold meq; Auto with datatypes. -Induction 1. -Intros T i m; Elim (insert T i a). -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. -Apply munion_comm. -Apply meq_sym; Trivial with datatypes. +simple induction l. +apply (heap_exist nil Tree_Leaf); auto with datatypes. +simpl in |- *; unfold meq in |- *; auto with datatypes. +simple induction 1. +intros T i m; elim (insert T i a). +intros; apply heap_exist with T1; simpl in |- *; auto with datatypes. +apply meq_trans with (munion (contents T) (singletonBag a)). +apply meq_trans with (munion (singletonBag a) (contents T)). +apply meq_right; trivial with datatypes. +apply munion_comm. +apply meq_sym; trivial with datatypes. Qed. (** building the sorted list *) -Inductive flat_spec [T:Tree] : Set := - flat_exist : (l:(list A))(sort leA l) -> - ((a:A)(leA_Tree a T)->(lelistA leA a l)) -> - (meq (contents T) (list_contents eqA_dec l)) -> - (flat_spec T). +Inductive flat_spec (T:Tree) : Set := + flat_exist : + forall l:list A, + sort leA l -> + (forall a:A, leA_Tree a T -> lelistA leA a l) -> + meq (contents T) (list_contents _ eqA_dec l) -> flat_spec T. -Lemma heap_to_list : (T:Tree)(is_heap T) -> (flat_spec T). +Lemma heap_to_list : forall T:Tree, is_heap T -> flat_spec T. Proof. - Intros T h; Elim h; Intros. - Apply flat_exist with (nil A); Auto with datatypes. - Elim H2; Intros l1 s1 i1 m1; Elim H4; Intros l2 s2 i2 m2. - Elim (merge leA_dec eqA_dec s1 s2); Intros. - Apply flat_exist with (cons a l); Simpl; Auto with datatypes. - Apply meq_trans with - (munion (list_contents eqA_dec l1) (munion (list_contents eqA_dec l2) - (singletonBag a))). - Apply meq_congr; Auto with datatypes. - Apply meq_trans with - (munion (singletonBag a) (munion (list_contents eqA_dec l1) - (list_contents eqA_dec l2))). - Apply munion_rotate. - Apply meq_right; Apply meq_sym; Trivial with datatypes. + intros T h; elim h; intros. + apply flat_exist with (nil (A:=A)); auto with datatypes. + elim H2; intros l1 s1 i1 m1; elim H4; intros l2 s2 i2 m2. + elim (merge _ leA_dec eqA_dec s1 s2); intros. + apply flat_exist with (a :: l); simpl in |- *; auto with datatypes. + apply meq_trans with + (munion (list_contents _ eqA_dec l1) + (munion (list_contents _ eqA_dec l2) (singletonBag a))). + apply meq_congr; auto with datatypes. + apply meq_trans with + (munion (singletonBag a) + (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2))). + apply munion_rotate. + apply meq_right; apply meq_sym; trivial with datatypes. Qed. (** specification of treesort *) -Theorem treesort : (l:(list A)) - {m:(list A) | (sort leA m) & (permutation eqA_dec l m)}. +Theorem treesort : + forall l:list A, {m : list A | sort leA m & permutation _ eqA_dec l m}. Proof. - Intro l; Unfold permutation. - Elim (list_to_heap l). - Intros. - Elim (heap_to_list T); Auto with datatypes. - Intros. - Exists l0; Auto with datatypes. - Apply meq_trans with (contents T); Trivial with datatypes. + intro l; unfold permutation in |- *. + elim (list_to_heap l). + intros. + elim (heap_to_list T); auto with datatypes. + intros. + exists l0; auto with datatypes. + apply meq_trans with (contents T); trivial with datatypes. Qed. -End defs. +End defs.
\ No newline at end of file diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index 3702387a7..bfb42b7b9 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -8,104 +8,113 @@ (*i $Id$ i*) -Require Relations. -Require PolyList. -Require Multiset. +Require Import Relations. +Require Import List. +Require Import Multiset. Set Implicit Arguments. Section defs. Variable A : Set. -Variable leA : (relation A). -Variable eqA : (relation A). +Variable leA : relation A. +Variable eqA : relation A. -Local gtA := [x,y:A]~(leA x y). +Let gtA (x y:A) := ~ leA x y. -Hypothesis leA_dec : (x,y:A){(leA x y)}+{~(leA x y)}. -Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}. -Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y). -Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z). -Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y). +Hypothesis leA_dec : forall x y:A, {leA x y} + {~ leA x y}. +Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. +Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. +Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. +Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. -Hints Resolve leA_refl : default. -Hints Immediate eqA_dec leA_dec leA_antisym : default. +Hint Resolve leA_refl: default. +Hint Immediate eqA_dec leA_dec leA_antisym: default. -Local emptyBag := (EmptyBag A). -Local singletonBag := (SingletonBag eqA_dec). +Let emptyBag := EmptyBag A. +Let singletonBag := SingletonBag _ eqA_dec. (** contents of a list *) -Fixpoint list_contents [l:(list A)] : (multiset A) := - Cases l of - nil => emptyBag - | (cons a l) => (munion (singletonBag a) (list_contents l)) - end. +Fixpoint list_contents (l:list A) : multiset A := + match l with + | nil => emptyBag + | a :: l => munion (singletonBag a) (list_contents l) + end. -Lemma list_contents_app : (l,m:(list A)) - (meq (list_contents (app l m)) (munion (list_contents l) (list_contents m))). +Lemma list_contents_app : + forall l m:list A, + meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)). Proof. -Induction l; Simpl; Auto with datatypes. -Intros. -Apply meq_trans with - (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); Auto with datatypes. +simple induction l; simpl in |- *; auto with datatypes. +intros. +apply meq_trans with + (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); + auto with datatypes. Qed. -Hints Resolve list_contents_app. +Hint Resolve list_contents_app. -Definition permutation := [l,m:(list A)](meq (list_contents l) (list_contents m)). +Definition permutation (l m:list A) := + meq (list_contents l) (list_contents m). -Lemma permut_refl : (l:(list A))(permutation l l). +Lemma permut_refl : forall l:list A, permutation l l. Proof. -Unfold permutation; Auto with datatypes. +unfold permutation in |- *; auto with datatypes. Qed. -Hints Resolve permut_refl. +Hint Resolve permut_refl. -Lemma permut_tran : (l,m,n:(list A)) - (permutation l m) -> (permutation m n) -> (permutation l n). +Lemma permut_tran : + forall l m n:list A, permutation l m -> permutation m n -> permutation l n. Proof. -Unfold permutation; Intros. -Apply meq_trans with (list_contents m); Auto with datatypes. +unfold permutation in |- *; intros. +apply meq_trans with (list_contents m); auto with datatypes. Qed. -Lemma permut_right : (l,m:(list A)) - (permutation l m) -> (a:A)(permutation (cons a l) (cons a m)). +Lemma permut_right : + forall l m:list A, + permutation l m -> forall a:A, permutation (a :: l) (a :: m). Proof. -Unfold permutation; Simpl; Auto with datatypes. +unfold permutation in |- *; simpl in |- *; auto with datatypes. Qed. -Hints Resolve permut_right. +Hint Resolve permut_right. -Lemma permut_app : (l,l',m,m':(list A)) - (permutation l l') -> (permutation m m') -> - (permutation (app l m) (app l' m')). +Lemma permut_app : + forall l l' m m':list A, + permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m'). Proof. -Unfold permutation; Intros. -Apply meq_trans with (munion (list_contents l) (list_contents m)); Auto with datatypes. -Apply meq_trans with (munion (list_contents l') (list_contents m')); Auto with datatypes. -Apply meq_trans with (munion (list_contents l') (list_contents m)); Auto with datatypes. +unfold permutation in |- *; intros. +apply meq_trans with (munion (list_contents l) (list_contents m)); + auto with datatypes. +apply meq_trans with (munion (list_contents l') (list_contents m')); + auto with datatypes. +apply meq_trans with (munion (list_contents l') (list_contents m)); + auto with datatypes. Qed. -Hints Resolve permut_app. +Hint Resolve permut_app. -Lemma permut_cons : (l,m:(list A))(permutation l m) -> - (a:A)(permutation (cons a l) (cons a m)). +Lemma permut_cons : + forall l m:list A, + permutation l m -> forall a:A, permutation (a :: l) (a :: m). Proof. -Intros l m H a. -Change (permutation (app (cons a (nil A)) l) (app (cons a (nil A)) m)). -Apply permut_app; Auto with datatypes. +intros l m H a. +change (permutation ((a :: nil) ++ l) ((a :: nil) ++ m)) in |- *. +apply permut_app; auto with datatypes. Qed. -Hints Resolve permut_cons. +Hint Resolve permut_cons. -Lemma permut_middle : (l,m:(list A)) - (a:A)(permutation (cons a (app l m)) (app l (cons a m))). +Lemma permut_middle : + forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m). Proof. -Unfold permutation. -Induction l; Simpl; Auto with datatypes. -Intros. -Apply meq_trans with (munion (singletonBag a) - (munion (singletonBag a0) (list_contents (app l0 m)))); Auto with datatypes. -Apply munion_perm_left; Auto with datatypes. +unfold permutation in |- *. +simple induction l; simpl in |- *; auto with datatypes. +intros. +apply meq_trans with + (munion (singletonBag a) + (munion (singletonBag a0) (list_contents (l0 ++ m)))); + auto with datatypes. +apply munion_perm_left; auto with datatypes. Qed. -Hints Resolve permut_middle. +Hint Resolve permut_middle. End defs. Unset Implicit Arguments. - diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v index cad4e2019..b1986d4e7 100644 --- a/theories/Sorting/Sorting.v +++ b/theories/Sorting/Sorting.v @@ -8,110 +8,116 @@ (*i $Id$ i*) -Require PolyList. -Require Multiset. -Require Permutation. -Require Relations. +Require Import List. +Require Import Multiset. +Require Import Permutation. +Require Import Relations. Set Implicit Arguments. Section defs. Variable A : Set. -Variable leA : (relation A). -Variable eqA : (relation A). +Variable leA : relation A. +Variable eqA : relation A. -Local gtA := [x,y:A]~(leA x y). +Let gtA (x y:A) := ~ leA x y. -Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}. -Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}. -Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y). -Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z). -Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y). +Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. +Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. +Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. +Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. +Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. -Hints Resolve leA_refl. -Hints Immediate eqA_dec leA_dec leA_antisym. +Hint Resolve leA_refl. +Hint Immediate eqA_dec leA_dec leA_antisym. -Local emptyBag := (EmptyBag A). -Local singletonBag := (SingletonBag eqA_dec). +Let emptyBag := EmptyBag A. +Let singletonBag := SingletonBag _ eqA_dec. (** [lelistA] *) -Inductive lelistA [a:A] : (list A) -> Prop := - nil_leA : (lelistA a (nil A)) - | cons_leA : (b:A)(l:(list A))(leA a b)->(lelistA a (cons b l)). -Hint constr_lelistA := Constructors lelistA. +Inductive lelistA (a:A) : list A -> Prop := + | nil_leA : lelistA a nil + | cons_leA : forall (b:A) (l:list A), leA a b -> lelistA a (b :: l). +Hint Constructors lelistA. -Lemma lelistA_inv : (a,b:A)(l:(list A)) - (lelistA a (cons b l)) -> (leA a b). +Lemma lelistA_inv : forall (a b:A) (l:list A), lelistA a (b :: l) -> leA a b. Proof. - Intros; Inversion H; Trivial with datatypes. + intros; inversion H; trivial with datatypes. Qed. (** definition for a list to be sorted *) -Inductive sort : (list A) -> Prop := - nil_sort : (sort (nil A)) - | cons_sort : (a:A)(l:(list A))(sort l) -> (lelistA a l) -> (sort (cons a l)). -Hint constr_sort := Constructors sort. +Inductive sort : list A -> Prop := + | nil_sort : sort nil + | cons_sort : + forall (a:A) (l:list A), sort l -> lelistA a l -> sort (a :: l). +Hint Constructors sort. -Lemma sort_inv : (a:A)(l:(list A))(sort (cons a l))->(sort l) /\ (lelistA a l). +Lemma sort_inv : + forall (a:A) (l:list A), sort (a :: l) -> sort l /\ lelistA a l. Proof. -Intros; Inversion H; Auto with datatypes. +intros; inversion H; auto with datatypes. Qed. -Lemma sort_rec : (P:(list A)->Set) - (P (nil A)) -> - ((a:A)(l:(list A))(sort l)->(P l)->(lelistA a l)->(P (cons a l))) -> - (y:(list A))(sort y) -> (P y). +Lemma sort_rec : + forall P:list A -> Set, + P nil -> + (forall (a:A) (l:list A), sort l -> P l -> lelistA a l -> P (a :: l)) -> + forall y:list A, sort y -> P y. Proof. -Induction y; Auto with datatypes. -Intros; Elim (!sort_inv a l); Auto with datatypes. +simple induction y; auto with datatypes. +intros; elim (sort_inv (a:=a) (l:=l)); auto with datatypes. Qed. (** merging two sorted lists *) -Inductive merge_lem [l1:(list A);l2:(list A)] : Set := - merge_exist : (l:(list A))(sort l) -> - (meq (list_contents eqA_dec l) - (munion (list_contents eqA_dec l1) (list_contents eqA_dec l2))) -> - ((a:A)(lelistA a l1)->(lelistA a l2)->(lelistA a l)) -> - (merge_lem l1 l2). - -Lemma merge : (l1:(list A))(sort l1)->(l2:(list A))(sort l2)->(merge_lem l1 l2). +Inductive merge_lem (l1 l2:list A) : Set := + merge_exist : + forall l:list A, + sort l -> + meq (list_contents _ eqA_dec l) + (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) -> + (forall a:A, lelistA a l1 -> lelistA a l2 -> lelistA a l) -> + merge_lem l1 l2. + +Lemma merge : + forall l1:list A, sort l1 -> forall l2:list A, sort l2 -> merge_lem l1 l2. Proof. - Induction 1; Intros. - Apply merge_exist with l2; Auto with datatypes. - Elim H3; Intros. - Apply merge_exist with (cons a l); Simpl; Auto with datatypes. - Elim (leA_dec a a0); Intros. + simple induction 1; intros. + apply merge_exist with l2; auto with datatypes. + elim H3; intros. + apply merge_exist with (a :: l); simpl in |- *; auto with datatypes. + elim (leA_dec a a0); intros. (* 1 (leA a a0) *) - Cut (merge_lem l (cons a0 l0)); Auto with datatypes. - Intros (l3, l3sorted, l3contents, Hrec). - Apply merge_exist with (cons a l3); Simpl; Auto with datatypes. - Apply meq_trans with (munion (singletonBag a) - (munion (list_contents eqA_dec l) - (list_contents eqA_dec (cons a0 l0)))). - Apply meq_right; Trivial with datatypes. - Apply meq_sym; Apply munion_ass. - Intros; Apply cons_leA. - Apply lelistA_inv with l; Trivial with datatypes. + cut (merge_lem l (a0 :: l0)); auto with datatypes. + intros [l3 l3sorted l3contents Hrec]. + apply merge_exist with (a :: l3); simpl in |- *; auto with datatypes. + apply meq_trans with + (munion (singletonBag a) + (munion (list_contents _ eqA_dec l) + (list_contents _ eqA_dec (a0 :: l0)))). + apply meq_right; trivial with datatypes. + apply meq_sym; apply munion_ass. + intros; apply cons_leA. + apply lelistA_inv with l; trivial with datatypes. (* 2 (leA a0 a) *) - Elim H5; Simpl; Intros. - Apply merge_exist with (cons a0 l3); Simpl; Auto with datatypes. - Apply meq_trans with (munion (singletonBag a0) - (munion (munion (singletonBag a) - (list_contents eqA_dec l)) - (list_contents eqA_dec l0))). - Apply meq_right; Trivial with datatypes. - Apply munion_perm_left. - Intros; Apply cons_leA; Apply lelistA_inv with l0; Trivial with datatypes. + elim H5; simpl in |- *; intros. + apply merge_exist with (a0 :: l3); simpl in |- *; auto with datatypes. + apply meq_trans with + (munion (singletonBag a0) + (munion (munion (singletonBag a) (list_contents _ eqA_dec l)) + (list_contents _ eqA_dec l0))). + apply meq_right; trivial with datatypes. + apply munion_perm_left. + intros; apply cons_leA; apply lelistA_inv with l0; trivial with datatypes. Qed. End defs. Unset Implicit Arguments. -Hint constr_sort : datatypes v62 := Constructors sort. -Hint constr_lelistA : datatypes v62 := Constructors lelistA. +Hint Constructors sort: datatypes v62. +Hint Constructors lelistA: datatypes v62.
\ No newline at end of file diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v index 44c2f8661..e702dbfde 100644 --- a/theories/Wellfounded/Disjoint_Union.v +++ b/theories/Wellfounded/Disjoint_Union.v @@ -12,45 +12,44 @@ From : Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355 *) -Require Relation_Operators. +Require Import Relation_Operators. Section Wf_Disjoint_Union. -Variable A,B:Set. -Variable leA: A->A->Prop. -Variable leB: B->B->Prop. +Variables A B : Set. +Variable leA : A -> A -> Prop. +Variable leB : B -> B -> Prop. Notation Le_AsB := (le_AsB A B leA leB). -Lemma acc_A_sum: (x:A)(Acc A leA x)->(Acc A+B Le_AsB (inl A B x)). +Lemma acc_A_sum : forall x:A, Acc leA x -> Acc Le_AsB (inl B x). Proof. - NewInduction 1. - Apply Acc_intro;Intros y H2. - Inversion_clear H2. - Auto with sets. + induction 1. + apply Acc_intro; intros y H2. + inversion_clear H2. + auto with sets. Qed. -Lemma acc_B_sum: (well_founded A leA) ->(x:B)(Acc B leB x) - ->(Acc A+B Le_AsB (inr A B x)). +Lemma acc_B_sum : + well_founded leA -> forall x:B, Acc leB x -> Acc Le_AsB (inr A x). Proof. - NewInduction 2. - Apply Acc_intro;Intros y H3. - Inversion_clear H3;Auto with sets. - Apply acc_A_sum;Auto with sets. + induction 2. + apply Acc_intro; intros y H3. + inversion_clear H3; auto with sets. + apply acc_A_sum; auto with sets. Qed. -Lemma wf_disjoint_sum: - (well_founded A leA) - -> (well_founded B leB) -> (well_founded A+B Le_AsB). +Lemma wf_disjoint_sum : + well_founded leA -> well_founded leB -> well_founded Le_AsB. Proof. - Intros. - Unfold well_founded . - NewDestruct a as [a|b]. - Apply (acc_A_sum a). - Apply (H a). - - Apply (acc_B_sum H b). - Apply (H0 b). + intros. + unfold well_founded in |- *. + destruct a as [a| b]. + apply (acc_A_sum a). + apply (H a). + + apply (acc_B_sum H b). + apply (H0 b). Qed. -End Wf_Disjoint_Union. +End Wf_Disjoint_Union.
\ No newline at end of file diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v index 2038b34bf..2508011dc 100644 --- a/theories/Wellfounded/Inclusion.v +++ b/theories/Wellfounded/Inclusion.v @@ -10,24 +10,23 @@ (** Author: Bruno Barras *) -Require Relation_Definitions. +Require Import Relation_Definitions. Section WfInclusion. - Variable A:Set. - Variable R1,R2:A->A->Prop. + Variable A : Set. + Variables R1 R2 : A -> A -> Prop. - Lemma Acc_incl: (inclusion A R1 R2)->(z:A)(Acc A R2 z)->(Acc A R1 z). + Lemma Acc_incl : inclusion A R1 R2 -> forall z:A, Acc R2 z -> Acc R1 z. Proof. - NewInduction 2. - Apply Acc_intro;Auto with sets. + induction 2. + apply Acc_intro; auto with sets. Qed. - Hints Resolve Acc_incl. + Hint Resolve Acc_incl. - Theorem wf_incl: - (inclusion A R1 R2)->(well_founded A R2)->(well_founded A R1). + Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1. Proof. - Unfold well_founded ;Auto with sets. + unfold well_founded in |- *; auto with sets. Qed. -End WfInclusion. +End WfInclusion.
\ No newline at end of file diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v index ac828ac1a..66a7f5b5b 100644 --- a/theories/Wellfounded/Inverse_Image.v +++ b/theories/Wellfounded/Inverse_Image.v @@ -12,47 +12,44 @@ Section Inverse_Image. - Variables A,B:Set. - Variable R : B->B->Prop. - Variable f:A->B. + Variables A B : Set. + Variable R : B -> B -> Prop. + Variable f : A -> B. - Local Rof : A->A->Prop := [x,y:A](R (f x) (f y)). + Let Rof (x y:A) : Prop := R (f x) (f y). - Remark Acc_lemma : (y:B)(Acc B R y)->(x:A)(y=(f x))->(Acc A Rof x). - NewInduction 1 as [y _ IHAcc]; Intros x H. - Apply Acc_intro; Intros y0 H1. - Apply (IHAcc (f y0)); Try Trivial. - Rewrite H; Trivial. + Remark Acc_lemma : forall y:B, Acc R y -> forall x:A, y = f x -> Acc Rof x. + induction 1 as [y _ IHAcc]; intros x H. + apply Acc_intro; intros y0 H1. + apply (IHAcc (f y0)); try trivial. + rewrite H; trivial. Qed. - Lemma Acc_inverse_image : (x:A)(Acc B R (f x)) -> (Acc A Rof x). - Intros; Apply (Acc_lemma (f x)); Trivial. + Lemma Acc_inverse_image : forall x:A, Acc R (f x) -> Acc Rof x. + intros; apply (Acc_lemma (f x)); trivial. Qed. - Theorem wf_inverse_image: (well_founded B R)->(well_founded A Rof). - Red; Intros; Apply Acc_inverse_image; Auto. + Theorem wf_inverse_image : well_founded R -> well_founded Rof. + red in |- *; intros; apply Acc_inverse_image; auto. Qed. Variable F : A -> B -> Prop. - Local RoF : A -> A -> Prop := [x,y] - (EX b : B | (F x b) & (c:B)(F y c)->(R b c)). + Let RoF (x y:A) : Prop := + exists2 b : B | F x b & (forall c:B, F y c -> R b c). -Lemma Acc_inverse_rel : - (b:B)(Acc B R b)->(x:A)(F x b)->(Acc A RoF x). -NewInduction 1 as [x _ IHAcc]; Intros x0 H2. -Constructor; Intros y H3. -NewDestruct H3. -Apply (IHAcc x1); Auto. -Save. +Lemma Acc_inverse_rel : forall b:B, Acc R b -> forall x:A, F x b -> Acc RoF x. +induction 1 as [x _ IHAcc]; intros x0 H2. +constructor; intros y H3. +destruct H3. +apply (IHAcc x1); auto. +Qed. -Theorem wf_inverse_rel : - (well_founded B R)->(well_founded A RoF). - Red; Constructor; Intros. - Case H0; Intros. - Apply (Acc_inverse_rel x); Auto. -Save. +Theorem wf_inverse_rel : well_founded R -> well_founded RoF. + red in |- *; constructor; intros. + case H0; intros. + apply (Acc_inverse_rel x); auto. +Qed. End Inverse_Image. - diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v index 8efa124c3..e8203c399 100644 --- a/theories/Wellfounded/Lexicographic_Exponentiation.v +++ b/theories/Wellfounded/Lexicographic_Exponentiation.v @@ -13,15 +13,14 @@ From : Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355 *) -Require Eqdep. -Require PolyList. -Require PolyListSyntax. -Require Relation_Operators. -Require Transitive_Closure. +Require Import Eqdep. +Require Import List. +Require Import Relation_Operators. +Require Import Transitive_Closure. Section Wf_Lexicographic_Exponentiation. -Variable A:Set. -Variable leA: A->A->Prop. +Variable A : Set. +Variable leA : A -> A -> Prop. Notation Power := (Pow A leA). Notation Lex_Exp := (lex_exp A leA). @@ -29,358 +28,347 @@ Notation ltl := (Ltl A leA). Notation Descl := (Desc A leA). Notation List := (list A). -Notation Nil := (nil A). +Notation Nil := (nil (A:=A)). (* useless but symmetric *) -Notation Cons := (cons 1!A). -Notation "<< x , y >>" := (exist List Descl x y) (at level 0) - V8only (at level 0, x,y at level 100). - -V7only[ -Syntax constr - level 1: - List [ (list A) ] -> ["List"] - | Nil [ (nil A) ] -> ["Nil"] - | Cons [ (cons A) ] -> ["Cons"] - ; - level 10: - Cons2 [ (cons A $e $l) ] -> ["Cons " $e:L " " $l:L ]. - -Syntax constr - level 1: - pair_sig [ (exist (list A) Desc $e $d) ] -> ["<<" $e:L "," $d:L ">>"]. -]. -Hints Resolve d_one d_nil t_step. - -Lemma left_prefix : (x,y,z:List)(ltl x^y z)-> (ltl x z). +Notation Cons := (cons (A:=A)). +Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100). + +Hint Resolve d_one d_nil t_step. + +Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z. Proof. - Induction x. - Induction z. - Simpl;Intros H. - Inversion_clear H. - Simpl;Intros;Apply (Lt_nil A leA). - Intros a l HInd. - Simpl. - Intros. - Inversion_clear H. - Apply (Lt_hd A leA);Auto with sets. - Apply (Lt_tl A leA). - Apply (HInd y y0);Auto with sets. + simple induction x. + simple induction z. + simpl in |- *; intros H. + inversion_clear H. + simpl in |- *; intros; apply (Lt_nil A leA). + intros a l HInd. + simpl in |- *. + intros. + inversion_clear H. + apply (Lt_hd A leA); auto with sets. + apply (Lt_tl A leA). + apply (HInd y y0); auto with sets. Qed. -Lemma right_prefix : - (x,y,z:List)(ltl x y^z)-> (ltl x y) \/ (EX y':List | x=(y^y') /\ (ltl y' z)). +Lemma right_prefix : + forall x y z:List, + ltl x (y ++ z) -> ltl x y \/ ( exists y' : List | x = y ++ y' /\ ltl y' z). Proof. - Intros x y;Generalize x. - Elim y;Simpl. - Right. - Exists x0 ;Auto with sets. - Intros. - Inversion H0. - Left;Apply (Lt_nil A leA). - Left;Apply (Lt_hd A leA);Auto with sets. - Generalize (H x1 z H3) . - Induction 1. - Left;Apply (Lt_tl A leA);Auto with sets. - Induction 1. - Induction 1;Intros. - Rewrite -> H8. - Right;Exists x2 ;Auto with sets. + intros x y; generalize x. + elim y; simpl in |- *. + right. + exists x0; auto with sets. + intros. + inversion H0. + left; apply (Lt_nil A leA). + left; apply (Lt_hd A leA); auto with sets. + generalize (H x1 z H3). + simple induction 1. + left; apply (Lt_tl A leA); auto with sets. + simple induction 1. + simple induction 1; intros. + rewrite H8. + right; exists x2; auto with sets. Qed. -Lemma desc_prefix: (x:List)(a:A)(Descl x^(Cons a Nil))->(Descl x). +Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x. Proof. - Intros. - Inversion H. - Generalize (app_cons_not_nil H1); Induction 1. - Cut (x^(Cons a Nil))=(Cons x0 Nil); Auto with sets. - Intro. - Generalize (app_eq_unit H0) . - Induction 1; Induction 1; Intros. - Rewrite -> H4; Auto with sets. - Discriminate H5. - Generalize (app_inj_tail H0) . - Induction 1; Intros. - Rewrite <- H4; Auto with sets. + intros. + inversion H. + generalize (app_cons_not_nil _ _ _ H1); simple induction 1. + cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets. + intro. + generalize (app_eq_unit _ _ H0). + simple induction 1; simple induction 1; intros. + rewrite H4; auto with sets. + discriminate H5. + generalize (app_inj_tail _ _ _ _ H0). + simple induction 1; intros. + rewrite <- H4; auto with sets. Qed. -Lemma desc_tail: (x:List)(a,b:A) - (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b). +Lemma desc_tail : + forall (x:List) (a b:A), + Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b. Proof. - Intro. - Apply rev_ind with A:=A - P:=[x:List](a,b:A) - (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b). - Intros. - - Inversion H. - Cut (Cons b (Cons a Nil))= ((Nil^(Cons b Nil))^ (Cons a Nil)); Auto with sets; Intro. - Generalize H0. - Intro. - Generalize (app_inj_tail 2!(l^(Cons y Nil)) 3!(Nil^(Cons b Nil)) H4); - Induction 1. - Intros. - - Generalize (app_inj_tail H6); Induction 1; Intros. - Generalize H1. - Rewrite <- H10; Rewrite <- H7; Intro. - Apply (t_step A leA); Auto with sets. - - - - Intros. - Inversion H0. - Generalize (app_cons_not_nil H3); Intro. - Elim H1. - - Generalize H0. - Generalize (app_comm_cons (l^(Cons x0 Nil)) (Cons a Nil) b); Induction 1. - Intro. - Generalize (desc_prefix (Cons b (l^(Cons x0 Nil))) a H5); Intro. - Generalize (H x0 b H6). - Intro. - Apply t_trans with A:=A y:=x0; Auto with sets. - - Apply t_step. - Generalize H1. - Rewrite -> H4; Intro. - - Generalize (app_inj_tail H8); Induction 1. - Intros. - Generalize H2; Generalize (app_comm_cons l (Cons x0 Nil) b). - Intro. - Generalize H10. - Rewrite ->H12; Intro. - Generalize (app_inj_tail H13); Induction 1. - Intros. - Rewrite <- H11; Rewrite <- H16; Auto with sets. + intro. + apply rev_ind with + (A := A) + (P := fun x:List => + forall a b:A, + Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b). + intros. + + inversion H. + cut (Cons b (Cons a Nil) = (Nil ++ Cons b Nil) ++ Cons a Nil); + auto with sets; intro. + generalize H0. + intro. + generalize (app_inj_tail (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4); + simple induction 1. + intros. + + generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. + generalize H1. + rewrite <- H10; rewrite <- H7; intro. + apply (t_step A leA); auto with sets. + + + + intros. + inversion H0. + generalize (app_cons_not_nil _ _ _ H3); intro. + elim H1. + + generalize H0. + generalize (app_comm_cons (l ++ Cons x0 Nil) (Cons a Nil) b); + simple induction 1. + intro. + generalize (desc_prefix (Cons b (l ++ Cons x0 Nil)) a H5); intro. + generalize (H x0 b H6). + intro. + apply t_trans with (A := A) (y := x0); auto with sets. + + apply t_step. + generalize H1. + rewrite H4; intro. + + generalize (app_inj_tail _ _ _ _ H8); simple induction 1. + intros. + generalize H2; generalize (app_comm_cons l (Cons x0 Nil) b). + intro. + generalize H10. + rewrite H12; intro. + generalize (app_inj_tail _ _ _ _ H13); simple induction 1. + intros. + rewrite <- H11; rewrite <- H16; auto with sets. Qed. -Lemma dist_aux : (z:List)(Descl z)->(x,y:List)z=(x^y)->(Descl x)/\ (Descl y). +Lemma dist_aux : + forall z:List, Descl z -> forall x y:List, z = x ++ y -> Descl x /\ Descl y. Proof. - Intros z D. - Elim D. - Intros. - Cut (x^y)=Nil;Auto with sets; Intro. - Generalize (app_eq_nil H0) ; Induction 1. - Intros. - Rewrite -> H2;Rewrite -> H3; Split;Apply d_nil. - - Intros. - Cut (x0^y)=(Cons x Nil); Auto with sets. - Intros E. - Generalize (app_eq_unit E); Induction 1. - Induction 1;Intros. - Rewrite -> H2;Rewrite -> H3; Split. - Apply d_nil. - - Apply d_one. - - Induction 1; Intros. - Rewrite -> H2;Rewrite -> H3; Split. - Apply d_one. - - Apply d_nil. - - Do 5 Intro. - Intros Hind. - Do 2 Intro. - Generalize x0 . - Apply rev_ind with A:=A - P:=[y0:List] - (x0:List) - ((l^(Cons y Nil))^(Cons x Nil))=(x0^y0)->(Descl x0)/\(Descl y0). - - Intro. - Generalize (app_nil_end x1) ; Induction 1; Induction 1. - Split. Apply d_conc; Auto with sets. - - Apply d_nil. - - Do 3 Intro. - Generalize x1 . - Apply rev_ind with - A:=A - P:=[l0:List] - (x1:A) - (x0:List) - ((l^(Cons y Nil))^(Cons x Nil))=(x0^(l0^(Cons x1 Nil))) - ->(Descl x0)/\(Descl (l0^(Cons x1 Nil))). - - - Simpl. - Split. - Generalize (app_inj_tail H2) ;Induction 1. - Induction 1;Auto with sets. - - Apply d_one. - Do 5 Intro. - Generalize (app_ass x4 (l1^(Cons x2 Nil)) (Cons x3 Nil)) . - Induction 1. - Generalize (app_ass x4 l1 (Cons x2 Nil)) ;Induction 1. - Intro E. - Generalize (app_inj_tail E) . - Induction 1;Intros. - Generalize (app_inj_tail H6) ;Induction 1;Intros. - Rewrite <- H7; Rewrite <- H10; Generalize H6. - Generalize (app_ass x4 l1 (Cons x2 Nil)); Intro E1. - Rewrite -> E1. - Intro. - Generalize (Hind x4 (l1^(Cons x2 Nil)) H11) . - Induction 1;Split. - Auto with sets. - - Generalize H14. - Rewrite <- H10; Intro. - Apply d_conc;Auto with sets. + intros z D. + elim D. + intros. + cut (x ++ y = Nil); auto with sets; intro. + generalize (app_eq_nil _ _ H0); simple induction 1. + intros. + rewrite H2; rewrite H3; split; apply d_nil. + + intros. + cut (x0 ++ y = Cons x Nil); auto with sets. + intros E. + generalize (app_eq_unit _ _ E); simple induction 1. + simple induction 1; intros. + rewrite H2; rewrite H3; split. + apply d_nil. + + apply d_one. + + simple induction 1; intros. + rewrite H2; rewrite H3; split. + apply d_one. + + apply d_nil. + + do 5 intro. + intros Hind. + do 2 intro. + generalize x0. + apply rev_ind with + (A := A) + (P := fun y0:List => + forall x0:List, + (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 -> + Descl x0 /\ Descl y0). + + intro. + generalize (app_nil_end x1); simple induction 1; simple induction 1. + split. apply d_conc; auto with sets. + + apply d_nil. + + do 3 intro. + generalize x1. + apply rev_ind with + (A := A) + (P := fun l0:List => + forall (x1:A) (x0:List), + (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil -> + Descl x0 /\ Descl (l0 ++ Cons x1 Nil)). + + + simpl in |- *. + split. + generalize (app_inj_tail _ _ _ _ H2); simple induction 1. + simple induction 1; auto with sets. + + apply d_one. + do 5 intro. + generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)). + simple induction 1. + generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1. + intro E. + generalize (app_inj_tail _ _ _ _ E). + simple induction 1; intros. + generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. + rewrite <- H7; rewrite <- H10; generalize H6. + generalize (app_ass x4 l1 (Cons x2 Nil)); intro E1. + rewrite E1. + intro. + generalize (Hind x4 (l1 ++ Cons x2 Nil) H11). + simple induction 1; split. + auto with sets. + + generalize H14. + rewrite <- H10; intro. + apply d_conc; auto with sets. Qed. -Lemma dist_Desc_concat : (x,y:List)(Descl x^y)->(Descl x)/\(Descl y). +Lemma dist_Desc_concat : + forall x y:List, Descl (x ++ y) -> Descl x /\ Descl y. Proof. - Intros. - Apply (dist_aux (x^y) H x y); Auto with sets. + intros. + apply (dist_aux (x ++ y) H x y); auto with sets. Qed. -Lemma desc_end:(a,b:A)(x:List) - (Descl x^(Cons a Nil)) /\ (ltl x^(Cons a Nil) (Cons b Nil)) - -> (clos_trans A leA a b). +Lemma desc_end : + forall (a b:A) (x:List), + Descl (x ++ Cons a Nil) /\ ltl (x ++ Cons a Nil) (Cons b Nil) -> + clos_trans A leA a b. Proof. - Intros a b x. - Case x. - Simpl. - Induction 1. - Intros. - Inversion H1;Auto with sets. - Inversion H3. - - Induction 1. - Generalize (app_comm_cons l (Cons a Nil) a0). - Intros E; Rewrite <- E; Intros. - Generalize (desc_tail l a a0 H0); Intro. - Inversion H1. - Apply t_trans with y:=a0 ;Auto with sets. - - Inversion H4. + intros a b x. + case x. + simpl in |- *. + simple induction 1. + intros. + inversion H1; auto with sets. + inversion H3. + + simple induction 1. + generalize (app_comm_cons l (Cons a Nil) a0). + intros E; rewrite <- E; intros. + generalize (desc_tail l a a0 H0); intro. + inversion H1. + apply t_trans with (y := a0); auto with sets. + + inversion H4. Qed. -Lemma ltl_unit: (x:List)(a,b:A) - (Descl (x^(Cons a Nil))) -> (ltl x^(Cons a Nil) (Cons b Nil)) - -> (ltl x (Cons b Nil)). +Lemma ltl_unit : + forall (x:List) (a b:A), + Descl (x ++ Cons a Nil) -> + ltl (x ++ Cons a Nil) (Cons b Nil) -> ltl x (Cons b Nil). Proof. - Intro. - Case x. - Intros;Apply (Lt_nil A leA). + intro. + case x. + intros; apply (Lt_nil A leA). - Simpl;Intros. - Inversion_clear H0. - Apply (Lt_hd A leA a b);Auto with sets. + simpl in |- *; intros. + inversion_clear H0. + apply (Lt_hd A leA a b); auto with sets. - Inversion_clear H1. + inversion_clear H1. Qed. -Lemma acc_app: - (x1,x2:List)(y1:(Descl x1^x2)) - (Acc Power Lex_Exp (exist List Descl (x1^x2) y1)) - ->(x:List) - (y:(Descl x)) - (ltl x (x1^x2))->(Acc Power Lex_Exp (exist List Descl x y)). +Lemma acc_app : + forall (x1 x2:List) (y1:Descl (x1 ++ x2)), + Acc Lex_Exp << x1 ++ x2, y1 >> -> + forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>. Proof. - Intros. - Apply (Acc_inv Power Lex_Exp (exist List Descl (x1^x2) y1)). - Auto with sets. + intros. + apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)). + auto with sets. - Unfold lex_exp ;Simpl;Auto with sets. + unfold lex_exp in |- *; simpl in |- *; auto with sets. Qed. -Theorem wf_lex_exp : - (well_founded A leA)->(well_founded Power Lex_Exp). +Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp. Proof. - Unfold 2 well_founded . - Induction a;Intros x y. - Apply Acc_intro. - Induction y0. - Unfold 1 lex_exp ;Simpl. - Apply rev_ind with A:=A P:=[x:List] - (x0:List) - (y:(Descl x0)) - (ltl x0 x) - ->(Acc Power Lex_Exp (exist List Descl x0 y)) . - Intros. - Inversion_clear H0. - - Intro. - Generalize (well_founded_ind A (clos_trans A leA) (wf_clos_trans A leA H)). - Intros GR. - Apply GR with P:=[x0:A] - (l:List) - ((x1:List) - (y:(Descl x1)) - (ltl x1 l) - ->(Acc Power Lex_Exp (exist List Descl x1 y))) - ->(x1:List) - (y:(Descl x1)) - (ltl x1 (l^(Cons x0 Nil))) - ->(Acc Power Lex_Exp (exist List Descl x1 y)) . - Intro;Intros HInd; Intros. - Generalize (right_prefix x2 l (Cons x1 Nil) H1) . - Induction 1. - Intro; Apply (H0 x2 y1 H3). - - Induction 1. - Intro;Induction 1. - Clear H4 H2. - Intro;Generalize y1 ;Clear y1. - Rewrite -> H2. - Apply rev_ind with A:=A P:=[x3:List] - (y1:(Descl (l^x3))) - (ltl x3 (Cons x1 Nil)) - ->(Acc Power Lex_Exp - (exist List Descl (l^x3) y1)) . - Intros. - Generalize (app_nil_end l) ;Intros Heq. - Generalize y1 . - Clear y1. - Rewrite <- Heq. - Intro. - Apply Acc_intro. - Induction y2. - Unfold 1 lex_exp . - Simpl;Intros x4 y3. Intros. - Apply (H0 x4 y3);Auto with sets. - - Intros. - Generalize (dist_Desc_concat l (l0^(Cons x4 Nil)) y1) . - Induction 1. - Intros. - Generalize (desc_end x4 x1 l0 (conj ? ? H8 H5)) ; Intros. - Generalize y1 . - Rewrite <- (app_ass l l0 (Cons x4 Nil)); Intro. - Generalize (HInd x4 H9 (l^l0)) ; Intros HInd2. - Generalize (ltl_unit l0 x4 x1 H8 H5); Intro. - Generalize (dist_Desc_concat (l^l0) (Cons x4 Nil) y2) . - Induction 1;Intros. - Generalize (H4 H12 H10); Intro. - Generalize (Acc_inv Power Lex_Exp (exist List Descl (l^l0) H12) H14) . - Generalize (acc_app l l0 H12 H14). - Intros f g. - Generalize (HInd2 f);Intro. - Apply Acc_intro. - Induction y3. - Unfold 1 lex_exp ;Simpl; Intros. - Apply H15;Auto with sets. + unfold well_founded at 2 in |- *. + simple induction a; intros x y. + apply Acc_intro. + simple induction y0. + unfold lex_exp at 1 in |- *; simpl in |- *. + apply rev_ind with + (A := A) + (P := fun x:List => + forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>). + intros. + inversion_clear H0. + + intro. + generalize (well_founded_ind (wf_clos_trans A leA H)). + intros GR. + apply GR with + (P := fun x0:A => + forall l:List, + (forall (x1:List) (y:Descl x1), + ltl x1 l -> Acc Lex_Exp << x1, y >>) -> + forall (x1:List) (y:Descl x1), + ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>). + intro; intros HInd; intros. + generalize (right_prefix x2 l (Cons x1 Nil) H1). + simple induction 1. + intro; apply (H0 x2 y1 H3). + + simple induction 1. + intro; simple induction 1. + clear H4 H2. + intro; generalize y1; clear y1. + rewrite H2. + apply rev_ind with + (A := A) + (P := fun x3:List => + forall y1:Descl (l ++ x3), + ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>). + intros. + generalize (app_nil_end l); intros Heq. + generalize y1. + clear y1. + rewrite <- Heq. + intro. + apply Acc_intro. + simple induction y2. + unfold lex_exp at 1 in |- *. + simpl in |- *; intros x4 y3. intros. + apply (H0 x4 y3); auto with sets. + + intros. + generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1). + simple induction 1. + intros. + generalize (desc_end x4 x1 l0 (conj H8 H5)); intros. + generalize y1. + rewrite <- (app_ass l l0 (Cons x4 Nil)); intro. + generalize (HInd x4 H9 (l ++ l0)); intros HInd2. + generalize (ltl_unit l0 x4 x1 H8 H5); intro. + generalize (dist_Desc_concat (l ++ l0) (Cons x4 Nil) y2). + simple induction 1; intros. + generalize (H4 H12 H10); intro. + generalize (Acc_inv H14). + generalize (acc_app l l0 H12 H14). + intros f g. + generalize (HInd2 f); intro. + apply Acc_intro. + simple induction y3. + unfold lex_exp at 1 in |- *; simpl in |- *; intros. + apply H15; auto with sets. Qed. -End Wf_Lexicographic_Exponentiation. +End Wf_Lexicographic_Exponentiation.
\ No newline at end of file diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v index b8f74c9ff..d457e4190 100644 --- a/theories/Wellfounded/Lexicographic_Product.v +++ b/theories/Wellfounded/Lexicographic_Product.v @@ -10,64 +10,65 @@ (** Authors: Bruno Barras, Cristina Cornes *) -Require Eqdep. -Require Relation_Operators. -Require Transitive_Closure. +Require Import Eqdep. +Require Import Relation_Operators. +Require Import Transitive_Closure. (** From : Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355 *) Section WfLexicographic_Product. -Variable A:Set. -Variable B:A->Set. -Variable leA: A->A->Prop. -Variable leB: (x:A)(B x)->(B x)->Prop. +Variable A : Set. +Variable B : A -> Set. +Variable leA : A -> A -> Prop. +Variable leB : forall x:A, B x -> B x -> Prop. Notation LexProd := (lexprod A B leA leB). -Hints Resolve t_step Acc_clos_trans wf_clos_trans. +Hint Resolve t_step Acc_clos_trans wf_clos_trans. -Lemma acc_A_B_lexprod : (x:A)(Acc A leA x) - ->((x0:A)(clos_trans A leA x0 x)->(well_founded (B x0) (leB x0))) - ->(y:(B x))(Acc (B x) (leB x) y) - ->(Acc (sigS A B) LexProd (existS A B x y)). +Lemma acc_A_B_lexprod : + forall x:A, + Acc leA x -> + (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) -> + forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y). Proof. - NewInduction 1 as [x _ IHAcc]; Intros H2 y. - NewInduction 1 as [x0 H IHAcc0];Intros. - Apply Acc_intro. - NewDestruct y as [x2 y1]; Intro H6. - Simple Inversion H6; Intro. - Cut (leA x2 x);Intros. - Apply IHAcc;Auto with sets. - Intros. - Apply H2. - Apply t_trans with x2 ;Auto with sets. - - Red in H2. - Apply H2. - Auto with sets. - - Injection H1. - NewDestruct 2. - Injection H3. - NewDestruct 2;Auto with sets. - - Rewrite <- H1. - Injection H3; Intros _ Hx1. - Subst x1. - Apply IHAcc0. - Elim inj_pair2 with A B x y' x0; Assumption. + induction 1 as [x _ IHAcc]; intros H2 y. + induction 1 as [x0 H IHAcc0]; intros. + apply Acc_intro. + destruct y as [x2 y1]; intro H6. + simple inversion H6; intro. + cut (leA x2 x); intros. + apply IHAcc; auto with sets. + intros. + apply H2. + apply t_trans with x2; auto with sets. + + red in H2. + apply H2. + auto with sets. + + injection H1. + destruct 2. + injection H3. + destruct 2; auto with sets. + + rewrite <- H1. + injection H3; intros _ Hx1. + subst x1. + apply IHAcc0. + elim inj_pair2 with A B x y' x0; assumption. Qed. -Theorem wf_lexprod: - (well_founded A leA) ->((x:A) (well_founded (B x) (leB x))) - -> (well_founded (sigS A B) LexProd). +Theorem wf_lexprod : + well_founded leA -> + (forall x:A, well_founded (leB x)) -> well_founded LexProd. Proof. - Intros wfA wfB;Unfold well_founded . - NewDestruct a. - Apply acc_A_B_lexprod;Auto with sets;Intros. - Red in wfB. - Auto with sets. + intros wfA wfB; unfold well_founded in |- *. + destruct a. + apply acc_A_B_lexprod; auto with sets; intros. + red in wfB. + auto with sets. Qed. @@ -75,10 +76,10 @@ End WfLexicographic_Product. Section Wf_Symmetric_Product. - Variable A:Set. - Variable B:Set. - Variable leA: A->A->Prop. - Variable leB: B->B->Prop. + Variable A : Set. + Variable B : Set. + Variable leA : A -> A -> Prop. + Variable leB : B -> B -> Prop. Notation Symprod := (symprod A B leA leB). @@ -101,24 +102,24 @@ Proof. Qed. i*) - Lemma Acc_symprod: (x:A)(Acc A leA x)->(y:B)(Acc B leB y) - ->(Acc (A*B) Symprod (x,y)). + Lemma Acc_symprod : + forall x:A, Acc leA x -> forall y:B, Acc leB y -> Acc Symprod (x, y). Proof. - NewInduction 1 as [x _ IHAcc]; Intros y H2. - NewInduction H2 as [x1 H3 IHAcc1]. - Apply Acc_intro;Intros y H5. - Inversion_clear H5;Auto with sets. - Apply IHAcc; Auto. - Apply Acc_intro;Trivial. + induction 1 as [x _ IHAcc]; intros y H2. + induction H2 as [x1 H3 IHAcc1]. + apply Acc_intro; intros y H5. + inversion_clear H5; auto with sets. + apply IHAcc; auto. + apply Acc_intro; trivial. Qed. -Lemma wf_symprod: (well_founded A leA)->(well_founded B leB) - ->(well_founded (A*B) Symprod). +Lemma wf_symprod : + well_founded leA -> well_founded leB -> well_founded Symprod. Proof. - Red. - NewDestruct a. - Apply Acc_symprod;Auto with sets. + red in |- *. + destruct a. + apply Acc_symprod; auto with sets. Qed. End Wf_Symmetric_Product. @@ -126,66 +127,66 @@ End Wf_Symmetric_Product. Section Swap. - Variable A:Set. - Variable R:A->A->Prop. + Variable A : Set. + Variable R : A -> A -> Prop. - Notation SwapProd :=(swapprod A R). + Notation SwapProd := (swapprod A R). - Lemma swap_Acc: (x,y:A)(Acc A*A SwapProd (x,y))->(Acc A*A SwapProd (y,x)). + Lemma swap_Acc : forall x y:A, Acc SwapProd (x, y) -> Acc SwapProd (y, x). Proof. - Intros. - Inversion_clear H. - Apply Acc_intro. - NewDestruct y0;Intros. - Inversion_clear H;Inversion_clear H1;Apply H0. - Apply sp_swap. - Apply right_sym;Auto with sets. - - Apply sp_swap. - Apply left_sym;Auto with sets. - - Apply sp_noswap. - Apply right_sym;Auto with sets. - - Apply sp_noswap. - Apply left_sym;Auto with sets. + intros. + inversion_clear H. + apply Acc_intro. + destruct y0; intros. + inversion_clear H; inversion_clear H1; apply H0. + apply sp_swap. + apply right_sym; auto with sets. + + apply sp_swap. + apply left_sym; auto with sets. + + apply sp_noswap. + apply right_sym; auto with sets. + + apply sp_noswap. + apply left_sym; auto with sets. Qed. - Lemma Acc_swapprod: (x,y:A)(Acc A R x)->(Acc A R y) - ->(Acc A*A SwapProd (x,y)). + Lemma Acc_swapprod : + forall x y:A, Acc R x -> Acc R y -> Acc SwapProd (x, y). Proof. - NewInduction 1 as [x0 _ IHAcc0];Intros H2. - Cut (y0:A)(R y0 x0)->(Acc ? SwapProd (y0,y)). - Clear IHAcc0. - NewInduction H2 as [x1 _ IHAcc1]; Intros H4. - Cut (y:A)(R y x1)->(Acc ? SwapProd (x0,y)). - Clear IHAcc1. - Intro. - Apply Acc_intro. - NewDestruct y; Intro H5. - Inversion_clear H5. - Inversion_clear H0;Auto with sets. - - Apply swap_Acc. - Inversion_clear H0;Auto with sets. - - Intros. - Apply IHAcc1;Auto with sets;Intros. - Apply Acc_inv with (y0,x1) ;Auto with sets. - Apply sp_noswap. - Apply right_sym;Auto with sets. - - Auto with sets. + induction 1 as [x0 _ IHAcc0]; intros H2. + cut (forall y0:A, R y0 x0 -> Acc SwapProd (y0, y)). + clear IHAcc0. + induction H2 as [x1 _ IHAcc1]; intros H4. + cut (forall y:A, R y x1 -> Acc SwapProd (x0, y)). + clear IHAcc1. + intro. + apply Acc_intro. + destruct y; intro H5. + inversion_clear H5. + inversion_clear H0; auto with sets. + + apply swap_Acc. + inversion_clear H0; auto with sets. + + intros. + apply IHAcc1; auto with sets; intros. + apply Acc_inv with (y0, x1); auto with sets. + apply sp_noswap. + apply right_sym; auto with sets. + + auto with sets. Qed. - Lemma wf_swapprod: (well_founded A R)->(well_founded A*A SwapProd). + Lemma wf_swapprod : well_founded R -> well_founded SwapProd. Proof. - Red. - NewDestruct a;Intros. - Apply Acc_swapprod;Auto with sets. + red in |- *. + destruct a; intros. + apply Acc_swapprod; auto with sets. Qed. -End Swap. +End Swap.
\ No newline at end of file diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v index c650d4675..b2af4dd85 100644 --- a/theories/Wellfounded/Transitive_Closure.v +++ b/theories/Wellfounded/Transitive_Closure.v @@ -10,38 +10,38 @@ (** Author: Bruno Barras *) -Require Relation_Definitions. -Require Relation_Operators. +Require Import Relation_Definitions. +Require Import Relation_Operators. Section Wf_Transitive_Closure. - Variable A: Set. - Variable R: (relation A). + Variable A : Set. + Variable R : relation A. Notation trans_clos := (clos_trans A R). - Lemma incl_clos_trans: (inclusion A R trans_clos). - Red;Auto with sets. + Lemma incl_clos_trans : inclusion A R trans_clos. + red in |- *; auto with sets. Qed. - Lemma Acc_clos_trans: (x:A)(Acc A R x)->(Acc A trans_clos x). - NewInduction 1 as [x0 _ H1]. - Apply Acc_intro. - Intros y H2. - NewInduction H2;Auto with sets. - Apply Acc_inv with y ;Auto with sets. + Lemma Acc_clos_trans : forall x:A, Acc R x -> Acc trans_clos x. + induction 1 as [x0 _ H1]. + apply Acc_intro. + intros y H2. + induction H2; auto with sets. + apply Acc_inv with y; auto with sets. Qed. - Hints Resolve Acc_clos_trans. + Hint Resolve Acc_clos_trans. - Lemma Acc_inv_trans: (x,y:A)(trans_clos y x)->(Acc A R x)->(Acc A R y). + Lemma Acc_inv_trans : forall x y:A, trans_clos y x -> Acc R x -> Acc R y. Proof. - NewInduction 1 as [|x y];Auto with sets. - Intro; Apply Acc_inv with y; Assumption. + induction 1 as [| x y]; auto with sets. + intro; apply Acc_inv with y; assumption. Qed. - Theorem wf_clos_trans: (well_founded A R) ->(well_founded A trans_clos). + Theorem wf_clos_trans : well_founded R -> well_founded trans_clos. Proof. - Unfold well_founded;Auto with sets. + unfold well_founded in |- *; auto with sets. Qed. -End Wf_Transitive_Closure. +End Wf_Transitive_Closure.
\ No newline at end of file diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v index ee45a9476..d7f241dd0 100644 --- a/theories/Wellfounded/Union.v +++ b/theories/Wellfounded/Union.v @@ -10,65 +10,68 @@ (** Author: Bruno Barras *) -Require Relation_Operators. -Require Relation_Definitions. -Require Transitive_Closure. +Require Import Relation_Operators. +Require Import Relation_Definitions. +Require Import Transitive_Closure. Section WfUnion. - Variable A: Set. - Variable R1,R2: (relation A). + Variable A : Set. + Variables R1 R2 : relation A. Notation Union := (union A R1 R2). - Hints Resolve Acc_clos_trans wf_clos_trans. + Hint Resolve Acc_clos_trans wf_clos_trans. -Remark strip_commut: - (commut A R1 R2)->(x,y:A)(clos_trans A R1 y x)->(z:A)(R2 z y) - ->(EX y':A | (R2 y' x) & (clos_trans A R1 z y')). +Remark strip_commut : + commut A R1 R2 -> + forall x y:A, + clos_trans A R1 y x -> + forall z:A, R2 z y -> exists2 y' : A | R2 y' x & clos_trans A R1 z y'. Proof. - NewInduction 2 as [x y|x y z H0 IH1 H1 IH2]; Intros. - Elim H with y x z ;Auto with sets;Intros x0 H2 H3. - Exists x0;Auto with sets. + induction 2 as [x y| x y z H0 IH1 H1 IH2]; intros. + elim H with y x z; auto with sets; intros x0 H2 H3. + exists x0; auto with sets. - Elim IH1 with z0 ;Auto with sets;Intros. - Elim IH2 with x0 ;Auto with sets;Intros. - Exists x1;Auto with sets. - Apply t_trans with x0; Auto with sets. + elim IH1 with z0; auto with sets; intros. + elim IH2 with x0; auto with sets; intros. + exists x1; auto with sets. + apply t_trans with x0; auto with sets. Qed. - Lemma Acc_union: (commut A R1 R2)->((x:A)(Acc A R2 x)->(Acc A R1 x)) - ->(a:A)(Acc A R2 a)->(Acc A Union a). + Lemma Acc_union : + commut A R1 R2 -> + (forall x:A, Acc R2 x -> Acc R1 x) -> forall a:A, Acc R2 a -> Acc Union a. Proof. - NewInduction 3 as [x H1 H2]. - Apply Acc_intro;Intros. - Elim H3;Intros;Auto with sets. - Cut (clos_trans A R1 y x);Auto with sets. - ElimType (Acc A (clos_trans A R1) y);Intros. - Apply Acc_intro;Intros. - Elim H8;Intros. - Apply H6;Auto with sets. - Apply t_trans with x0 ;Auto with sets. + induction 3 as [x H1 H2]. + apply Acc_intro; intros. + elim H3; intros; auto with sets. + cut (clos_trans A R1 y x); auto with sets. + elimtype (Acc (clos_trans A R1) y); intros. + apply Acc_intro; intros. + elim H8; intros. + apply H6; auto with sets. + apply t_trans with x0; auto with sets. - Elim strip_commut with x x0 y0 ;Auto with sets;Intros. - Apply Acc_inv_trans with x1 ;Auto with sets. - Unfold union . - Elim H11;Auto with sets;Intros. - Apply t_trans with y1 ;Auto with sets. + elim strip_commut with x x0 y0; auto with sets; intros. + apply Acc_inv_trans with x1; auto with sets. + unfold union in |- *. + elim H11; auto with sets; intros. + apply t_trans with y1; auto with sets. - Apply (Acc_clos_trans A). - Apply Acc_inv with x ;Auto with sets. - Apply H0. - Apply Acc_intro;Auto with sets. + apply (Acc_clos_trans A). + apply Acc_inv with x; auto with sets. + apply H0. + apply Acc_intro; auto with sets. Qed. - Theorem wf_union: (commut A R1 R2)->(well_founded A R1)->(well_founded A R2) - ->(well_founded A Union). + Theorem wf_union : + commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union. Proof. - Unfold well_founded . - Intros. - Apply Acc_union;Auto with sets. + unfold well_founded in |- *. + intros. + apply Acc_union; auto with sets. Qed. -End WfUnion. +End WfUnion.
\ No newline at end of file diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v index 49595dd2b..c4c7daa98 100644 --- a/theories/Wellfounded/Well_Ordering.v +++ b/theories/Wellfounded/Well_Ordering.v @@ -12,36 +12,36 @@ From: Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355 *) -Require Eqdep. +Require Import Eqdep. Section WellOrdering. -Variable A:Set. -Variable B:A->Set. +Variable A : Set. +Variable B : A -> Set. Inductive WO : Set := - sup : (a:A)(f:(B a)->WO)WO. + sup : forall (a:A) (f:B a -> WO), WO. -Inductive le_WO : WO->WO->Prop := - le_sup : (a:A)(f:(B a)->WO)(v:(B a)) (le_WO (f v) (sup a f)). +Inductive le_WO : WO -> WO -> Prop := + le_sup : forall (a:A) (f:B a -> WO) (v:B a), le_WO (f v) (sup a f). -Theorem wf_WO : (well_founded WO le_WO ). +Theorem wf_WO : well_founded le_WO. Proof. - Unfold well_founded ;Intro. - Apply Acc_intro. - Elim a. - Intros. - Inversion H0. - Apply Acc_intro. - Generalize H4 ;Generalize H1 ;Generalize f0 ;Generalize v. - Rewrite -> H3. - Intros. - Apply (H v0 y0). - Cut (eq ? f f1). - Intros E;Rewrite -> E;Auto. - Symmetry. - Apply (inj_pair2 A [a0:A](B a0)->WO a0 f1 f H5). + unfold well_founded in |- *; intro. + apply Acc_intro. + elim a. + intros. + inversion H0. + apply Acc_intro. + generalize H4; generalize H1; generalize f0; generalize v. + rewrite H3. + intros. + apply (H v0 y0). + cut (f = f1). + intros E; rewrite E; auto. + symmetry in |- *. + apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5). Qed. End WellOrdering. @@ -53,20 +53,20 @@ Section Characterisation_wf_relations. (* in course of development *) -Variable A:Set. -Variable leA:A->A->Prop. +Variable A : Set. +Variable leA : A -> A -> Prop. -Definition B:= [a:A] {x:A | (leA x a)}. +Definition B (a:A) := {x : A | leA x a}. -Definition wof: (well_founded A leA)-> A-> (WO A B). +Definition wof : well_founded leA -> A -> WO A B. Proof. - Intros. - Apply (well_founded_induction A leA H [a:A](WO A B));Auto. - Intros. - Apply (sup A B x). - Unfold 1 B . - NewDestruct 1 as [x0]. - Apply (H1 x0);Auto. + intros. + apply (well_founded_induction H (fun a:A => WO A B)); auto. + intros. + apply (sup A B x). + unfold B at 1 in |- *. + destruct 1 as [x0]. + apply (H1 x0); auto. Qed. -End Characterisation_wf_relations. +End Characterisation_wf_relations.
\ No newline at end of file diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v index 10fca099c..65218643f 100644 --- a/theories/Wellfounded/Wellfounded.v +++ b/theories/Wellfounded/Wellfounded.v @@ -17,4 +17,3 @@ Require Export Transitive_Closure. Require Export Union. Require Export Well_Ordering. - diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index 81cf64770..b6980123a 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -14,176 +14,179 @@ Require Export BinPos. Require Export Pnat. -Require BinNat. -Require Plus. -Require Mult. +Require Import BinNat. +Require Import Plus. +Require Import Mult. (**********************************************************************) (** Binary integer numbers *) -Inductive Z : Set := - ZERO : Z | POS : positive -> Z | NEG : positive -> Z. +Inductive Z : Set := + | Z0 : Z + | Zpos : positive -> Z + | Zneg : positive -> Z. (** Declare Scope Z_scope with Key Z *) -Delimits Scope Z_scope with Z. +Delimit Scope Z_scope with Z. (** Automatically open scope positive_scope for the constructors of Z *) Bind Scope Z_scope with Z. -Arguments Scope POS [ positive_scope ]. -Arguments Scope NEG [ positive_scope ]. +Arguments Scope Zpos [positive_scope]. +Arguments Scope Zneg [positive_scope]. (** Subtraction of positive into Z *) -Definition Zdouble_plus_one [x:Z] := - Cases x of - | ZERO => (POS xH) - | (POS p) => (POS (xI p)) - | (NEG p) => (NEG (double_moins_un p)) +Definition Zdouble_plus_one (x:Z) := + match x with + | Z0 => Zpos 1 + | Zpos p => Zpos (xI p) + | Zneg p => Zneg (Pdouble_minus_one p) end. -Definition Zdouble_minus_one [x:Z] := - Cases x of - | ZERO => (NEG xH) - | (NEG p) => (NEG (xI p)) - | (POS p) => (POS (double_moins_un p)) +Definition Zdouble_minus_one (x:Z) := + match x with + | Z0 => Zneg 1 + | Zneg p => Zneg (xI p) + | Zpos p => Zpos (Pdouble_minus_one p) end. -Definition Zdouble [x:Z] := - Cases x of - | ZERO => ZERO - | (POS p) => (POS (xO p)) - | (NEG p) => (NEG (xO p)) - end. - -Fixpoint ZPminus [x,y:positive] : Z := - Cases x y of - | (xI x') (xI y') => (Zdouble (ZPminus x' y')) - | (xI x') (xO y') => (Zdouble_plus_one (ZPminus x' y')) - | (xI x') xH => (POS (xO x')) - | (xO x') (xI y') => (Zdouble_minus_one (ZPminus x' y')) - | (xO x') (xO y') => (Zdouble (ZPminus x' y')) - | (xO x') xH => (POS (double_moins_un x')) - | xH (xI y') => (NEG (xO y')) - | xH (xO y') => (NEG (double_moins_un y')) - | xH xH => ZERO +Definition Zdouble (x:Z) := + match x with + | Z0 => Z0 + | Zpos p => Zpos (xO p) + | Zneg p => Zneg (xO p) + end. + +Fixpoint ZPminus (x y:positive) {struct y} : Z := + match x, y with + | xI x', xI y' => Zdouble (ZPminus x' y') + | xI x', xO y' => Zdouble_plus_one (ZPminus x' y') + | xI x', xH => Zpos (xO x') + | xO x', xI y' => Zdouble_minus_one (ZPminus x' y') + | xO x', xO y' => Zdouble (ZPminus x' y') + | xO x', xH => Zpos (Pdouble_minus_one x') + | xH, xI y' => Zneg (xO y') + | xH, xO y' => Zneg (Pdouble_minus_one y') + | xH, xH => Z0 end. (** Addition on integers *) -Definition Zplus := [x,y:Z] - Cases x y of - ZERO y => y - | x ZERO => x - | (POS x') (POS y') => (POS (add x' y')) - | (POS x') (NEG y') => - Cases (compare x' y' EGAL) of - | EGAL => ZERO - | INFERIEUR => (NEG (true_sub y' x')) - | SUPERIEUR => (POS (true_sub x' y')) +Definition Zplus (x y:Z) := + match x, y with + | Z0, y => y + | x, Z0 => x + | Zpos x', Zpos y' => Zpos (x' + y') + | Zpos x', Zneg y' => + match (x' ?= y')%positive Eq with + | Eq => Z0 + | Lt => Zneg (y' - x') + | Gt => Zpos (x' - y') end - | (NEG x') (POS y') => - Cases (compare x' y' EGAL) of - | EGAL => ZERO - | INFERIEUR => (POS (true_sub y' x')) - | SUPERIEUR => (NEG (true_sub x' y')) + | Zneg x', Zpos y' => + match (x' ?= y')%positive Eq with + | Eq => Z0 + | Lt => Zpos (y' - x') + | Gt => Zneg (x' - y') end - | (NEG x') (NEG y') => (NEG (add x' y')) + | Zneg x', Zneg y' => Zneg (x' + y') end. -V8Infix "+" Zplus : Z_scope. +Infix "+" := Zplus : Z_scope. (** Opposite *) -Definition Zopp := [x:Z] - Cases x of - ZERO => ZERO - | (POS x) => (NEG x) - | (NEG x) => (POS x) - end. +Definition Zopp (x:Z) := + match x with + | Z0 => Z0 + | Zpos x => Zneg x + | Zneg x => Zpos x + end. -V8Notation "- x" := (Zopp x) : Z_scope. +Notation "- x" := (Zopp x) : Z_scope. (** Successor on integers *) -Definition Zs := [x:Z](Zplus x (POS xH)). +Definition Zsucc (x:Z) := (x + Zpos 1)%Z. (** Predecessor on integers *) -Definition Zpred := [x:Z](Zplus x (NEG xH)). +Definition Zpred (x:Z) := (x + Zneg 1)%Z. (** Subtraction on integers *) -Definition Zminus := [m,n:Z](Zplus m (Zopp n)). +Definition Zminus (m n:Z) := (m + - n)%Z. -V8Infix "-" Zminus : Z_scope. +Infix "-" := Zminus : Z_scope. (** Multiplication on integers *) -Definition Zmult := [x,y:Z] - Cases x y of - | ZERO _ => ZERO - | _ ZERO => ZERO - | (POS x') (POS y') => (POS (times x' y')) - | (POS x') (NEG y') => (NEG (times x' y')) - | (NEG x') (POS y') => (NEG (times x' y')) - | (NEG x') (NEG y') => (POS (times x' y')) +Definition Zmult (x y:Z) := + match x, y with + | Z0, _ => Z0 + | _, Z0 => Z0 + | Zpos x', Zpos y' => Zpos (x' * y') + | Zpos x', Zneg y' => Zneg (x' * y') + | Zneg x', Zpos y' => Zneg (x' * y') + | Zneg x', Zneg y' => Zpos (x' * y') end. -V8Infix "*" Zmult : Z_scope. +Infix "*" := Zmult : Z_scope. (** Comparison of integers *) -Definition Zcompare := [x,y:Z] - Cases x y of - | ZERO ZERO => EGAL - | ZERO (POS y') => INFERIEUR - | ZERO (NEG y') => SUPERIEUR - | (POS x') ZERO => SUPERIEUR - | (POS x') (POS y') => (compare x' y' EGAL) - | (POS x') (NEG y') => SUPERIEUR - | (NEG x') ZERO => INFERIEUR - | (NEG x') (POS y') => INFERIEUR - | (NEG x') (NEG y') => (Op (compare x' y' EGAL)) +Definition Zcompare (x y:Z) := + match x, y with + | Z0, Z0 => Eq + | Z0, Zpos y' => Lt + | Z0, Zneg y' => Gt + | Zpos x', Z0 => Gt + | Zpos x', Zpos y' => (x' ?= y')%positive Eq + | Zpos x', Zneg y' => Gt + | Zneg x', Z0 => Lt + | Zneg x', Zpos y' => Lt + | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq) end. -V8Infix "?=" Zcompare (at level 70, no associativity) : Z_scope. +Infix "?=" := Zcompare (at level 70, no associativity) : Z_scope. -Tactic Definition ElimCompare com1 com2:= - Case (Dcompare (Zcompare com1 com2)); [ Idtac | - Let x = FreshId "H" In Intro x; Case x; Clear x ]. +Ltac elim_compare com1 com2 := + case (Dcompare (com1 ?= com2)%Z); + [ idtac | let x := fresh "H" in + (intro x; case x; clear x) ]. (** Sign function *) -Definition Zsgn [z:Z] : Z := - Cases z of - ZERO => ZERO - | (POS p) => (POS xH) - | (NEG p) => (NEG xH) +Definition Zsgn (z:Z) : Z := + match z with + | Z0 => Z0 + | Zpos p => Zpos 1 + | Zneg p => Zneg 1 end. (** Direct, easier to handle variants of successor and addition *) -Definition Zsucc' [x:Z] := - Cases x of - | ZERO => (POS xH) - | (POS x') => (POS (add_un x')) - | (NEG x') => (ZPminus xH x') +Definition Zsucc' (x:Z) := + match x with + | Z0 => Zpos 1 + | Zpos x' => Zpos (Psucc x') + | Zneg x' => ZPminus 1 x' end. -Definition Zpred' [x:Z] := - Cases x of - | ZERO => (NEG xH) - | (POS x') => (ZPminus x' xH) - | (NEG x') => (NEG (add_un x')) +Definition Zpred' (x:Z) := + match x with + | Z0 => Zneg 1 + | Zpos x' => ZPminus x' 1 + | Zneg x' => Zneg (Psucc x') end. -Definition Zplus' := [x,y:Z] - Cases x y of - ZERO y => y - | x ZERO => x - | (POS x') (POS y') => (POS (add x' y')) - | (POS x') (NEG y') => (ZPminus x' y') - | (NEG x') (POS y') => (ZPminus y' x') - | (NEG x') (NEG y') => (NEG (add x' y')) +Definition Zplus' (x y:Z) := + match x, y with + | Z0, y => y + | x, Z0 => x + | Zpos x', Zpos y' => Zpos (x' + y') + | Zpos x', Zneg y' => ZPminus x' y' + | Zneg x', Zpos y' => ZPminus y' x' + | Zneg x', Zneg y' => Zneg (x' + y') end. Open Local Scope Z_scope. @@ -191,74 +194,83 @@ Open Local Scope Z_scope. (**********************************************************************) (** Inductive specification of Z *) -Theorem Zind : (P:(Z ->Prop)) - (P ZERO) -> ((x:Z)(P x) ->(P (Zsucc' x))) -> ((x:Z)(P x) ->(P (Zpred' x))) -> - (z:Z)(P z). +Theorem Zind : + forall P:Z -> Prop, + P Z0 -> + (forall x:Z, P x -> P (Zsucc' x)) -> + (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n. Proof. -Intros P H0 Hs Hp z; NewDestruct z. - Assumption. - Apply Pind with P:=[p](P (POS p)). - Change (P (Zsucc' ZERO)); Apply Hs; Apply H0. - Intro n; Exact (Hs (POS n)). - Apply Pind with P:=[p](P (NEG p)). - Change (P (Zpred' ZERO)); Apply Hp; Apply H0. - Intro n; Exact (Hp (NEG n)). +intros P H0 Hs Hp z; destruct z. + assumption. + apply Pind with (P := fun p => P (Zpos p)). + change (P (Zsucc' Z0)) in |- *; apply Hs; apply H0. + intro n; exact (Hs (Zpos n)). + apply Pind with (P := fun p => P (Zneg p)). + change (P (Zpred' Z0)) in |- *; apply Hp; apply H0. + intro n; exact (Hp (Zneg n)). Qed. (**********************************************************************) (** Properties of opposite on binary integer numbers *) -Theorem Zopp_NEG : (x:positive) (Zopp (NEG x)) = (POS x). +Theorem Zopp_neg : forall p:positive, - Zneg p = Zpos p. Proof. -Reflexivity. +reflexivity. Qed. (** [opp] is involutive *) -Theorem Zopp_Zopp: (x:Z) (Zopp (Zopp x)) = x. +Theorem Zopp_involutive : forall n:Z, - - n = n. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. (** Injectivity of the opposite *) -Theorem Zopp_intro : (x,y:Z) (Zopp x) = (Zopp y) -> x = y. +Theorem Zopp_inj : forall n m:Z, - n = - m -> n = m. Proof. -Intros x y;Case x;Case y;Simpl;Intros; [ - Trivial | Discriminate H | Discriminate H | Discriminate H -| Simplify_eq H; Intro E; Rewrite E; Trivial -| Discriminate H | Discriminate H | Discriminate H -| Simplify_eq H; Intro E; Rewrite E; Trivial ]. +intros x y; case x; case y; simpl in |- *; intros; + [ trivial + | discriminate H + | discriminate H + | discriminate H + | simplify_eq H; intro E; rewrite E; trivial + | discriminate H + | discriminate H + | discriminate H + | simplify_eq H; intro E; rewrite E; trivial ]. Qed. (**********************************************************************) (* Properties of the direct definition of successor and predecessor *) -Lemma Zpred'_succ' : (x:Z)(Zpred' (Zsucc' x))=x. +Lemma Zpred'_succ' : forall n:Z, Zpred' (Zsucc' n) = n. Proof. -Intro x; NewDestruct x; Simpl. - Reflexivity. -NewDestruct p; Simpl; Try Rewrite double_moins_un_add_un_xI; Reflexivity. -NewDestruct p; Simpl; Try Rewrite is_double_moins_un; Reflexivity. +intro x; destruct x; simpl in |- *. + reflexivity. +destruct p; simpl in |- *; try rewrite Pdouble_minus_one_o_succ_eq_xI; + reflexivity. +destruct p; simpl in |- *; try rewrite Psucc_o_double_minus_one_eq_xO; + reflexivity. Qed. -Lemma Zsucc'_discr : (x:Z)x<>(Zsucc' x). +Lemma Zsucc'_discr : forall n:Z, n <> Zsucc' n. Proof. -Intro x; NewDestruct x; Simpl. - Discriminate. - Injection; Apply add_un_discr. - NewDestruct p; Simpl. - Discriminate. - Intro H; Symmetry in H; Injection H; Apply double_moins_un_xO_discr. - Discriminate. +intro x; destruct x; simpl in |- *. + discriminate. + injection; apply Psucc_discr. + destruct p; simpl in |- *. + discriminate. + intro H; symmetry in H; injection H; apply double_moins_un_xO_discr. + discriminate. Qed. (**********************************************************************) (** Other properties of binary integer numbers *) -Lemma ZL0 : (S (S O))=(plus (S O) (S O)). +Lemma ZL0 : 2%nat = (1 + 1)%nat. Proof. -Reflexivity. +reflexivity. Qed. (**********************************************************************) @@ -266,740 +278,761 @@ Qed. (** zero is left neutral for addition *) -Theorem Zero_left: (x:Z) (Zplus ZERO x) = x. +Theorem Zplus_0_l : forall n:Z, Z0 + n = n. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. (** zero is right neutral for addition *) -Theorem Zero_right: (x:Z) (Zplus x ZERO) = x. +Theorem Zplus_0_r : forall n:Z, n + Z0 = n. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. (** addition is commutative *) -Theorem Zplus_sym: (x,y:Z) (Zplus x y) = (Zplus y x). +Theorem Zplus_comm : forall n m:Z, n + m = m + n. Proof. -Intro x;NewInduction x as [|p|p];Intro y; NewDestruct y as [|q|q];Simpl;Try Reflexivity. - Rewrite add_sym; Reflexivity. - Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity. - Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity. - Rewrite add_sym; Reflexivity. +intro x; induction x as [| p| p]; intro y; destruct y as [| q| q]; + simpl in |- *; try reflexivity. + rewrite Pplus_comm; reflexivity. + rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity. + rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity. + rewrite Pplus_comm; reflexivity. Qed. (** opposite distributes over addition *) -Theorem Zopp_Zplus: - (x,y:Z) (Zopp (Zplus x y)) = (Zplus (Zopp x) (Zopp y)). +Theorem Zopp_plus_distr : forall n m:Z, - (n + m) = - n + - m. Proof. -Intro x; NewDestruct x as [|p|p]; Intro y; NewDestruct y as [|q|q]; Simpl; - Reflexivity Orelse NewDestruct (compare p q EGAL); Reflexivity. +intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q]; + simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq); + reflexivity. Qed. (** opposite is inverse for addition *) -Theorem Zplus_inverse_r: (x:Z) (Zplus x (Zopp x)) = ZERO. +Theorem Zplus_opp_r : forall n:Z, n + - n = Z0. Proof. -Intro x; NewDestruct x as [|p|p]; Simpl; [ - Reflexivity -| Rewrite (convert_compare_EGAL p); Reflexivity -| Rewrite (convert_compare_EGAL p); Reflexivity ]. +intro x; destruct x as [| p| p]; simpl in |- *; + [ reflexivity + | rewrite (Pcompare_refl p); reflexivity + | rewrite (Pcompare_refl p); reflexivity ]. Qed. -Theorem Zplus_inverse_l: (x:Z) (Zplus (Zopp x) x) = ZERO. +Theorem Zplus_opp_l : forall n:Z, - n + n = Z0. Proof. -Intro; Rewrite Zplus_sym; Apply Zplus_inverse_r. +intro; rewrite Zplus_comm; apply Zplus_opp_r. Qed. -Hints Local Resolve Zero_left Zero_right. +Hint Local Resolve Zplus_0_l Zplus_0_r. (** addition is associative *) Lemma weak_assoc : - (x,y:positive)(z:Z) (Zplus (POS x) (Zplus (POS y) z))= - (Zplus (Zplus (POS x) (POS y)) z). -Proof. -Intros x y z';Case z'; [ - Auto with arith -| Intros z;Simpl; Rewrite add_assoc;Auto with arith -| Intros z; Simpl; ElimPcompare y z; - Intros E0;Rewrite E0; - ElimPcompare '(add x y) 'z;Intros E1;Rewrite E1; [ - Absurd (compare (add x y) z EGAL)=EGAL; [ (* Case 1 *) - Rewrite convert_compare_SUPERIEUR; [ - Discriminate - | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0); - Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S; - Apply le_plus_r ] - | Assumption ] - | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 2 *) - Rewrite convert_compare_SUPERIEUR; [ - Discriminate - | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0); - Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S; - Apply le_plus_r] - | Assumption ] - | Rewrite (compare_convert_EGAL y z E0); (* Case 3 *) - Elim (sub_pos_SUPERIEUR (add x z) z);[ - Intros t H; Elim H;Intros H1 H2;Elim H2;Intros H3 H4; - Unfold true_sub; Rewrite H1; Cut x=t; [ - Intros E;Rewrite E;Auto with arith - | Apply simpl_add_r with z:=z; Rewrite <- H3; Rewrite add_sym; Trivial with arith ] - | Pattern 1 z; Rewrite <- (compare_convert_EGAL y z E0); Assumption ] - | Elim (sub_pos_SUPERIEUR z y); [ (* Case 4 *) - Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4; Unfold 1 true_sub; - Rewrite H1; Cut x=k; [ - Intros E;Rewrite E; Rewrite (convert_compare_EGAL k); Trivial with arith - | Apply simpl_add_r with z:=y; Rewrite (add_sym k y); Rewrite H3; - Apply compare_convert_EGAL; Assumption ] - | Apply ZC2;Assumption] - | Elim (sub_pos_SUPERIEUR z y); [ (* Case 5 *) - Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4; - Unfold 1 3 5 true_sub; Rewrite H1; - Cut (compare x k EGAL)=INFERIEUR; [ - Intros E2;Rewrite E2; Elim (sub_pos_SUPERIEUR k x); [ - Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9; - Elim (sub_pos_SUPERIEUR z (add x y)); [ - Intros j H10;Elim H10;Intros H11 H12;Elim H12;Intros H13 H14; - Unfold true_sub ;Rewrite H6;Rewrite H11; Cut i=j; [ - Intros E;Rewrite E;Auto with arith - | Apply (simpl_add_l (add x y)); Rewrite H13; - Rewrite (add_sym x y); Rewrite <- add_assoc; Rewrite H8; - Assumption ] - | Apply ZC2; Assumption] - | Apply ZC2;Assumption] - | Apply convert_compare_INFERIEUR; - Apply simpl_lt_plus_l with p:=(convert y); - Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR; - Rewrite H3; Rewrite add_sym; Assumption ] - | Apply ZC2; Assumption ] - | Elim (sub_pos_SUPERIEUR z y); [ (* Case 6 *) - Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4; - Elim (sub_pos_SUPERIEUR (add x y) z); [ - Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9; - Unfold true_sub; Rewrite H1;Rewrite H6; - Cut (compare x k EGAL)=SUPERIEUR; [ - Intros H10;Elim (sub_pos_SUPERIEUR x k H10); - Intros j H11;Elim H11;Intros H12 H13;Elim H13;Intros H14 H15; - Rewrite H10; Rewrite H12; Cut i=j; [ - Intros H16;Rewrite H16;Auto with arith - | Apply (simpl_add_l (add z k)); Rewrite <- (add_assoc z k j); - Rewrite H14; Rewrite (add_sym z k); Rewrite <- add_assoc; - Rewrite H8; Rewrite (add_sym x y); Rewrite add_assoc; - Rewrite (add_sym k y); Rewrite H3; Trivial with arith] - | Apply convert_compare_SUPERIEUR; Unfold lt gt; - Apply simpl_lt_plus_l with p:=(convert y); - Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR; - Rewrite H3; Rewrite add_sym; Apply ZC1; Assumption ] - | Assumption ] - | Apply ZC2;Assumption ] - | Absurd (compare (add x y) z EGAL)=EGAL; [ (* Case 7 *) - Rewrite convert_compare_SUPERIEUR; [ - Discriminate - | Rewrite convert_add; Unfold gt;Apply lt_le_trans with m:=(convert y);[ - Apply compare_convert_INFERIEUR; Apply ZC1; Assumption - | Apply le_plus_r]] - | Assumption ] - | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 8 *) - Rewrite convert_compare_SUPERIEUR; [ - Discriminate - | Unfold gt; Apply lt_le_trans with m:=(convert y);[ - Exact (compare_convert_SUPERIEUR y z E0) - | Rewrite convert_add; Apply le_plus_r]] - | Assumption ] - | Elim sub_pos_SUPERIEUR with 1:=E0;Intros k H1; (* Case 9 *) - Elim sub_pos_SUPERIEUR with 1:=E1; Intros i H2;Elim H1;Intros H3 H4; - Elim H4;Intros H5 H6; Elim H2;Intros H7 H8;Elim H8;Intros H9 H10; - Unfold true_sub ;Rewrite H3;Rewrite H7; Cut (add x k)=i; [ - Intros E;Rewrite E;Auto with arith - | Apply (simpl_add_l z);Rewrite (add_sym x k); - Rewrite add_assoc; Rewrite H5;Rewrite H9; - Rewrite add_sym; Trivial with arith ]]]. -Qed. - -Hints Local Resolve weak_assoc. - -Theorem Zplus_assoc : - (n,m,p:Z) (Zplus n (Zplus m p))= (Zplus (Zplus n m) p). -Proof. -Intros x y z;Case x;Case y;Case z;Auto with arith; Intros; [ - Rewrite (Zplus_sym (NEG p0)); Rewrite weak_assoc; - Rewrite (Zplus_sym (Zplus (POS p1) (NEG p0))); Rewrite weak_assoc; - Rewrite (Zplus_sym (POS p1)); Trivial with arith -| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; - Do 2 Rewrite Zopp_NEG; Rewrite Zplus_sym; Rewrite <- weak_assoc; - Rewrite (Zplus_sym (Zopp (POS p1))); - Rewrite (Zplus_sym (Zplus (POS p0) (Zopp (POS p1)))); - Rewrite (weak_assoc p); Rewrite weak_assoc; Rewrite (Zplus_sym (POS p0)); - Trivial with arith -| Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0) (POS p)); - Rewrite <- weak_assoc; Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0)); - Trivial with arith -| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; - Do 2 Rewrite Zopp_NEG; Rewrite (Zplus_sym (Zopp (POS p0))); - Rewrite weak_assoc; Rewrite (Zplus_sym (Zplus (POS p1) (Zopp (POS p0)))); - Rewrite weak_assoc;Rewrite (Zplus_sym (POS p)); Trivial with arith -| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG; - Apply weak_assoc -| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG; - Apply weak_assoc] -. -Qed. - -V7only [Notation Zplus_assoc_l := Zplus_assoc.]. - -Lemma Zplus_assoc_r : (n,m,p:Z)(Zplus (Zplus n m) p) =(Zplus n (Zplus m p)). -Proof. -Intros; Symmetry; Apply Zplus_assoc. + forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n. +Proof. +intros x y z'; case z'; + [ auto with arith + | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith + | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0; + ElimPcompare (x + y)%positive z; intros E1; rewrite E1; + [ absurd ((x + y ?= z)%positive Eq = Eq); + [ (* Case 1 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); + elim (ZL4 x); intros k E2; rewrite E2; + simpl in |- *; unfold gt, lt in |- *; + apply le_n_S; apply le_plus_r ] + | assumption ] + | absurd ((x + y ?= z)%positive Eq = Lt); + [ (* Case 2 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); + elim (ZL4 x); intros k E2; rewrite E2; + simpl in |- *; unfold gt, lt in |- *; + apply le_n_S; apply le_plus_r ] + | assumption ] + | rewrite (Pcompare_Eq_eq y z E0); + (* Case 3 *) + elim (Pminus_mask_Gt (x + z) z); + [ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4; + unfold Pminus in |- *; rewrite H1; cut (x = t); + [ intros E; rewrite E; auto with arith + | apply Pplus_reg_r with (r := z); rewrite <- H3; + rewrite Pplus_comm; trivial with arith ] + | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0); + assumption ] + | elim (Pminus_mask_Gt z y); + [ (* Case 4 *) + intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; + unfold Pminus at 1 in |- *; rewrite H1; cut (x = k); + [ intros E; rewrite E; rewrite (Pcompare_refl k); + trivial with arith + | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y); + rewrite H3; apply Pcompare_Eq_eq; assumption ] + | apply ZC2; assumption ] + | elim (Pminus_mask_Gt z y); + [ (* Case 5 *) + intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; + unfold Pminus at 1 3 5 in |- *; rewrite H1; + cut ((x ?= k)%positive Eq = Lt); + [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x); + [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; + elim (Pminus_mask_Gt z (x + y)); + [ intros j H10; elim H10; intros H11 H12; elim H12; + intros H13 H14; unfold Pminus in |- *; + rewrite H6; rewrite H11; cut (i = j); + [ intros E; rewrite E; auto with arith + | apply (Pplus_reg_l (x + y)); rewrite H13; + rewrite (Pplus_comm x y); rewrite <- Pplus_assoc; + rewrite H8; assumption ] + | apply ZC2; assumption ] + | apply ZC2; assumption ] + | apply nat_of_P_lt_Lt_compare_complement_morphism; + apply plus_lt_reg_l with (p := nat_of_P y); + do 2 rewrite <- nat_of_P_plus_morphism; + apply nat_of_P_lt_Lt_compare_morphism; + rewrite H3; rewrite Pplus_comm; assumption ] + | apply ZC2; assumption ] + | elim (Pminus_mask_Gt z y); + [ (* Case 6 *) + intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; + elim (Pminus_mask_Gt (x + y) z); + [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; + unfold Pminus in |- *; rewrite H1; rewrite H6; + cut ((x ?= k)%positive Eq = Gt); + [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11; + elim H11; intros H12 H13; elim H13; + intros H14 H15; rewrite H10; rewrite H12; + cut (i = j); + [ intros H16; rewrite H16; auto with arith + | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j); + rewrite H14; rewrite (Pplus_comm z k); + rewrite <- Pplus_assoc; rewrite H8; + rewrite (Pplus_comm x y); rewrite Pplus_assoc; + rewrite (Pplus_comm k y); rewrite H3; + trivial with arith ] + | apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold lt, gt in |- *; + apply plus_lt_reg_l with (p := nat_of_P y); + do 2 rewrite <- nat_of_P_plus_morphism; + apply nat_of_P_lt_Lt_compare_morphism; + rewrite H3; rewrite Pplus_comm; apply ZC1; + assumption ] + | assumption ] + | apply ZC2; assumption ] + | absurd ((x + y ?= z)%positive Eq = Eq); + [ (* Case 7 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | rewrite nat_of_P_plus_morphism; unfold gt in |- *; + apply lt_le_trans with (m := nat_of_P y); + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption + | apply le_plus_r ] ] + | assumption ] + | absurd ((x + y ?= z)%positive Eq = Lt); + [ (* Case 8 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y); + [ exact (nat_of_P_gt_Gt_compare_morphism y z E0) + | rewrite nat_of_P_plus_morphism; apply le_plus_r ] ] + | assumption ] + | elim Pminus_mask_Gt with (1 := E0); intros k H1; + (* Case 9 *) + elim Pminus_mask_Gt with (1 := E1); intros i H2; + elim H1; intros H3 H4; elim H4; intros H5 H6; + elim H2; intros H7 H8; elim H8; intros H9 H10; + unfold Pminus in |- *; rewrite H3; rewrite H7; + cut ((x + k)%positive = i); + [ intros E; rewrite E; auto with arith + | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc; + rewrite H5; rewrite H9; rewrite Pplus_comm; + trivial with arith ] ] ]. +Qed. + +Hint Local Resolve weak_assoc. + +Theorem Zplus_assoc : forall n m p:Z, n + (m + p) = n + m + p. +Proof. +intros x y z; case x; case y; case z; auto with arith; intros; + [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p1)); trivial with arith + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + rewrite Zplus_comm; rewrite <- weak_assoc; + rewrite (Zplus_comm (- Zpos p1)); + rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p); + rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); + trivial with arith + | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p)); + rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0)); + trivial with arith + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p)); trivial with arith + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + apply weak_assoc + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + apply weak_assoc ]. +Qed. + + +Lemma Zplus_assoc_reverse : forall n m p:Z, n + m + p = n + (m + p). +Proof. +intros; symmetry in |- *; apply Zplus_assoc. Qed. (** Associativity mixed with commutativity *) -Theorem Zplus_permute : (n,m,p:Z) (Zplus n (Zplus m p))=(Zplus m (Zplus n p)). +Theorem Zplus_permute : forall n m p:Z, n + (m + p) = m + (n + p). Proof. -Intros n m p; -Rewrite Zplus_sym;Rewrite <- Zplus_assoc; Rewrite (Zplus_sym p n); Trivial with arith. +intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc; + rewrite (Zplus_comm p n); trivial with arith. Qed. (** addition simplifies *) -Theorem Zsimpl_plus_l : (n,m,p:Z)(Zplus n m)=(Zplus n p)->m=p. -Intros n m p H; Cut (Zplus (Zopp n) (Zplus n m))=(Zplus (Zopp n) (Zplus n p));[ - Do 2 Rewrite -> Zplus_assoc; Rewrite -> (Zplus_sym (Zopp n) n); - Rewrite -> Zplus_inverse_r;Simpl; Trivial with arith -| Rewrite -> H; Trivial with arith ]. +Theorem Zplus_reg_l : forall n m p:Z, n + m = n + p -> m = p. +intros n m p H; cut (- n + (n + m) = - n + (n + p)); + [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n); + rewrite Zplus_opp_r; simpl in |- *; trivial with arith + | rewrite H; trivial with arith ]. Qed. (** addition and successor permutes *) -Lemma Zplus_S_n: (x,y:Z) (Zplus (Zs x) y) = (Zs (Zplus x y)). +Lemma Zplus_succ_l : forall n m:Z, Zsucc n + m = Zsucc (n + m). Proof. -Intros x y; Unfold Zs; Rewrite (Zplus_sym (Zplus x y)); Rewrite Zplus_assoc; -Rewrite (Zplus_sym (POS xH)); Trivial with arith. +intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y)); + rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); + trivial with arith. Qed. -Lemma Zplus_n_Sm : (n,m:Z) (Zs (Zplus n m))=(Zplus n (Zs m)). +Lemma Zplus_succ_r : forall n m:Z, Zsucc (n + m) = n + Zsucc m. Proof. -Intros n m; Unfold Zs; Rewrite Zplus_assoc; Trivial with arith. +intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith. Qed. -Lemma Zplus_Snm_nSm : (n,m:Z)(Zplus (Zs n) m)=(Zplus n (Zs m)). +Lemma Zplus_succ_comm : forall n m:Z, Zsucc n + m = n + Zsucc m. Proof. -Unfold Zs ;Intros n m; Rewrite <- Zplus_assoc; Rewrite (Zplus_sym (POS xH)); -Trivial with arith. +unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc; + rewrite (Zplus_comm (Zpos 1)); trivial with arith. Qed. (** Misc properties, usually redundant or non natural *) -Lemma Zplus_n_O : (n:Z) n=(Zplus n ZERO). +Lemma Zplus_0_r_reverse : forall n:Z, n = n + Z0. Proof. -Symmetry; Apply Zero_right. +symmetry in |- *; apply Zplus_0_r. Qed. -Lemma Zplus_unit_left : (n,m:Z) (Zplus n ZERO)=m -> n=m. +Lemma Zplus_0_simpl_l : forall n m:Z, n + Z0 = m -> n = m. Proof. -Intros n m; Rewrite Zero_right; Intro; Assumption. +intros n m; rewrite Zplus_0_r; intro; assumption. Qed. -Lemma Zplus_unit_right : (n,m:Z) n=(Zplus m ZERO) -> n=m. +Lemma Zplus_0_simpl_l_reverse : forall n m:Z, n = m + Z0 -> n = m. Proof. -Intros n m; Rewrite Zero_right; Intro; Assumption. +intros n m; rewrite Zplus_0_r; intro; assumption. Qed. -Lemma Zplus_simpl : (x,y,z,t:Z) x=y -> z=t -> (Zplus x z)=(Zplus y t). +Lemma Zplus_eq_compat : forall n m p q:Z, n = m -> p = q -> n + p = m + q. Proof. -Intros; Rewrite H; Rewrite H0; Reflexivity. +intros; rewrite H; rewrite H0; reflexivity. Qed. -Lemma Zplus_Zopp_expand : (x,y,z:Z) - (Zplus x (Zopp y))=(Zplus (Zplus x (Zopp z)) (Zplus z (Zopp y))). +Lemma Zplus_opp_expand : forall n m p:Z, n + - m = n + - p + (p + - m). Proof. -Intros x y z. -Rewrite <- (Zplus_assoc x). -Rewrite (Zplus_assoc (Zopp z)). -Rewrite Zplus_inverse_l. -Reflexivity. +intros x y z. +rewrite <- (Zplus_assoc x). +rewrite (Zplus_assoc (- z)). +rewrite Zplus_opp_l. +reflexivity. Qed. (**********************************************************************) (** Properties of successor and predecessor on binary integer numbers *) -Theorem Zn_Sn : (x:Z) ~ x=(Zs x). +Theorem Zsucc_discr : forall n:Z, n <> Zsucc n. Proof. -Intros n;Cut ~ZERO=(POS xH);[ - Unfold not ;Intros H1 H2;Apply H1;Apply (Zsimpl_plus_l n);Rewrite Zero_right; - Exact H2 -| Discriminate ]. +intros n; cut (Z0 <> Zpos 1); + [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n); + rewrite Zplus_0_r; exact H2 + | discriminate ]. Qed. -Theorem add_un_Zs : (x:positive) (POS (add_un x)) = (Zs (POS x)). +Theorem Zpos_succ_morphism : + forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p). Proof. -Intro; Rewrite -> ZL12; Unfold Zs; Simpl; Trivial with arith. +intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *; + trivial with arith. Qed. (** successor and predecessor are inverse functions *) -Theorem Zs_pred : (n:Z) n=(Zs (Zpred n)). +Theorem Zsucc_pred : forall n:Z, n = Zsucc (Zpred n). Proof. -Intros n; Unfold Zs Zpred ;Rewrite <- Zplus_assoc; Simpl; Rewrite Zero_right; -Trivial with arith. +intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *; + rewrite Zplus_0_r; trivial with arith. Qed. -Hints Immediate Zs_pred : zarith. +Hint Immediate Zsucc_pred: zarith. -Theorem Zpred_Sn : (x:Z) x=(Zpred (Zs x)). +Theorem Zpred_succ : forall n:Z, n = Zpred (Zsucc n). Proof. -Intros m; Unfold Zpred Zs; Rewrite <- Zplus_assoc; Simpl; -Rewrite Zplus_sym; Auto with arith. +intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *; + rewrite Zplus_comm; auto with arith. Qed. -Theorem Zeq_add_S : (n,m:Z) (Zs n)=(Zs m) -> n=m. +Theorem Zsucc_inj : forall n m:Z, Zsucc n = Zsucc m -> n = m. Proof. -Intros n m H. -Change (Zplus (Zplus (NEG xH) (POS xH)) n)= - (Zplus (Zplus (NEG xH) (POS xH)) m); -Do 2 Rewrite <- Zplus_assoc; Do 2 Rewrite (Zplus_sym (POS xH)); -Unfold Zs in H;Rewrite H; Trivial with arith. +intros n m H. +change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *; + do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1)); + unfold Zsucc in H; rewrite H; trivial with arith. Qed. (** Misc properties, usually redundant or non natural *) -Lemma Zeq_S : (n,m:Z) n=m -> (Zs n)=(Zs m). +Lemma Zsucc_eq_compat : forall n m:Z, n = m -> Zsucc n = Zsucc m. Proof. -Intros n m H; Rewrite H; Reflexivity. +intros n m H; rewrite H; reflexivity. Qed. -Lemma Znot_eq_S : (n,m:Z) ~(n=m) -> ~((Zs n)=(Zs m)). +Lemma Zsucc_inj_contrapositive : forall n m:Z, n <> m -> Zsucc n <> Zsucc m. Proof. -Unfold not ;Intros n m H1 H2;Apply H1;Apply Zeq_add_S; Assumption. +unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption. Qed. (**********************************************************************) (** Properties of subtraction on binary integer numbers *) -Lemma Zminus_0_r : (x:Z) (Zminus x ZERO)=x. +Lemma Zminus_0_r : forall n:Z, n - Z0 = n. Proof. -Intro; Unfold Zminus; Simpl;Rewrite Zero_right; Trivial with arith. +intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r; + trivial with arith. Qed. -Lemma Zminus_n_O : (x:Z) x=(Zminus x ZERO). +Lemma Zminus_0_l_reverse : forall n:Z, n = n - Z0. Proof. -Intro; Symmetry; Apply Zminus_0_r. +intro; symmetry in |- *; apply Zminus_0_r. Qed. -Lemma Zminus_diag : (n:Z)(Zminus n n)=ZERO. +Lemma Zminus_diag : forall n:Z, n - n = Z0. Proof. -Intro; Unfold Zminus; Rewrite Zplus_inverse_r; Trivial with arith. +intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith. Qed. -Lemma Zminus_n_n : (n:Z)(ZERO=(Zminus n n)). +Lemma Zminus_diag_reverse : forall n:Z, Z0 = n - n. Proof. -Intro; Symmetry; Apply Zminus_diag. +intro; symmetry in |- *; apply Zminus_diag. Qed. -Lemma Zplus_minus : (x,y,z:Z)(x=(Zplus y z))->(z=(Zminus x y)). +Lemma Zplus_minus_eq : forall n m p:Z, n = m + p -> p = n - m. Proof. -Intros n m p H;Unfold Zminus;Apply (Zsimpl_plus_l m); -Rewrite (Zplus_sym m (Zplus n (Zopp m))); Rewrite <- Zplus_assoc; -Rewrite Zplus_inverse_l; Rewrite Zero_right; Rewrite H; Trivial with arith. +intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m); + rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc; + rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; + trivial with arith. Qed. -Lemma Zminus_plus : (x,y:Z)(Zminus (Zplus x y) x)=y. +Lemma Zminus_plus : forall n m:Z, n + m - n = m. Proof. -Intros n m;Unfold Zminus ;Rewrite -> (Zplus_sym n m);Rewrite <- Zplus_assoc; -Rewrite -> Zplus_inverse_r; Apply Zero_right. +intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m); + rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r. Qed. -Lemma Zle_plus_minus : (n,m:Z) (Zplus n (Zminus m n))=m. +Lemma Zplus_minus : forall n m:Z, n + (m - n) = m. Proof. -Unfold Zminus; Intros n m; Rewrite Zplus_permute; Rewrite Zplus_inverse_r; -Apply Zero_right. +unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r; + apply Zplus_0_r. Qed. -Lemma Zminus_Sn_m : (n,m:Z)((Zs (Zminus n m))=(Zminus (Zs n) m)). +Lemma Zminus_succ_l : forall n m:Z, Zsucc (n - m) = Zsucc n - m. Proof. -Intros n m;Unfold Zminus Zs; Rewrite (Zplus_sym n (Zopp m)); -Rewrite <- Zplus_assoc;Apply Zplus_sym. +intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m)); + rewrite <- Zplus_assoc; apply Zplus_comm. Qed. -Lemma Zminus_plus_simpl_l : - (x,y,z:Z)(Zminus (Zplus z x) (Zplus z y))=(Zminus x y). +Lemma Zminus_plus_simpl_l : forall n m p:Z, p + n - (p + m) = n - m. Proof. -Intros n m p;Unfold Zminus; Rewrite Zopp_Zplus; Rewrite Zplus_assoc; -Rewrite (Zplus_sym p); Rewrite <- (Zplus_assoc n p); Rewrite Zplus_inverse_r; -Rewrite Zero_right; Trivial with arith. +intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr; + rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p); + rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith. Qed. -Lemma Zminus_plus_simpl : - (x,y,z:Z)((Zminus x y)=(Zminus (Zplus z x) (Zplus z y))). +Lemma Zminus_plus_simpl_l_reverse : forall n m p:Z, n - m = p + n - (p + m). Proof. -Intros; Symmetry; Apply Zminus_plus_simpl_l. +intros; symmetry in |- *; apply Zminus_plus_simpl_l. Qed. -Lemma Zminus_Zplus_compatible : - (x,y,z:Z) (Zminus (Zplus x z) (Zplus y z)) = (Zminus x y). -Intros x y n. -Unfold Zminus. -Rewrite -> Zopp_Zplus. -Rewrite -> (Zplus_sym (Zopp y) (Zopp n)). -Rewrite -> Zplus_assoc. -Rewrite <- (Zplus_assoc x n (Zopp n)). -Rewrite -> (Zplus_inverse_r n). -Rewrite <- Zplus_n_O. -Reflexivity. +Lemma Zminus_plus_simpl_r : forall n m p:Z, n + p - (m + p) = n - m. +intros x y n. +unfold Zminus in |- *. +rewrite Zopp_plus_distr. +rewrite (Zplus_comm (- y) (- n)). +rewrite Zplus_assoc. +rewrite <- (Zplus_assoc x n (- n)). +rewrite (Zplus_opp_r n). +rewrite <- Zplus_0_r_reverse. +reflexivity. Qed. (** Misc redundant properties *) -V7only [Set Implicit Arguments.]. -Lemma Zeq_Zminus : (x,y:Z)x=y -> (Zminus x y)=ZERO. +Lemma Zeq_minus : forall n m:Z, n = m -> n - m = Z0. Proof. -Intros x y H; Rewrite H; Symmetry; Apply Zminus_n_n. +intros x y H; rewrite H; symmetry in |- *; apply Zminus_diag_reverse. Qed. -Lemma Zminus_Zeq : (x,y:Z)(Zminus x y)=ZERO -> x=y. +Lemma Zminus_eq : forall n m:Z, n - m = Z0 -> n = m. Proof. -Intros x y H; Rewrite <- (Zle_plus_minus y x); Rewrite H; Apply Zero_right. +intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r. Qed. -V7only [Unset Implicit Arguments.]. (**********************************************************************) (** Properties of multiplication on binary integer numbers *) (** One is neutral for multiplication *) -Theorem Zmult_1_n : (n:Z)(Zmult (POS xH) n)=n. +Theorem Zmult_1_l : forall n:Z, Zpos 1 * n = n. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. -V7only [Notation Zmult_one := Zmult_1_n.]. -Theorem Zmult_n_1 : (n:Z)(Zmult n (POS xH))=n. +Theorem Zmult_1_r : forall n:Z, n * Zpos 1 = n. Proof. -Intro x; NewDestruct x; Simpl; Try Rewrite times_x_1; Reflexivity. +intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity. Qed. (** Zero property of multiplication *) -Theorem Zero_mult_left: (x:Z) (Zmult ZERO x) = ZERO. +Theorem Zmult_0_l : forall n:Z, Z0 * n = Z0. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. -Theorem Zero_mult_right: (x:Z) (Zmult x ZERO) = ZERO. +Theorem Zmult_0_r : forall n:Z, n * Z0 = Z0. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. -Hints Local Resolve Zero_mult_left Zero_mult_right. +Hint Local Resolve Zmult_0_l Zmult_0_r. -Lemma Zmult_n_O : (n:Z) ZERO=(Zmult n ZERO). +Lemma Zmult_0_r_reverse : forall n:Z, Z0 = n * Z0. Proof. -Intro x; NewDestruct x; Reflexivity. +intro x; destruct x; reflexivity. Qed. (** Commutativity of multiplication *) -Theorem Zmult_sym : (x,y:Z) (Zmult x y) = (Zmult y x). +Theorem Zmult_comm : forall n m:Z, n * m = m * n. Proof. -Intros x y; NewDestruct x as [|p|p]; NewDestruct y as [|q|q]; Simpl; - Try Rewrite (times_sym p q); Reflexivity. +intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *; + try rewrite (Pmult_comm p q); reflexivity. Qed. (** Associativity of multiplication *) -Theorem Zmult_assoc : - (x,y,z:Z) (Zmult x (Zmult y z))= (Zmult (Zmult x y) z). +Theorem Zmult_assoc : forall n m p:Z, n * (m * p) = n * m * p. Proof. -Intros x y z; NewDestruct x; NewDestruct y; NewDestruct z; Simpl; - Try Rewrite times_assoc; Reflexivity. +intros x y z; destruct x; destruct y; destruct z; simpl in |- *; + try rewrite Pmult_assoc; reflexivity. Qed. -V7only [Notation Zmult_assoc_l := Zmult_assoc.]. -Lemma Zmult_assoc_r : (n,m,p:Z)((Zmult (Zmult n m) p) = (Zmult n (Zmult m p))). +Lemma Zmult_assoc_reverse : forall n m p:Z, n * m * p = n * (m * p). Proof. -Intros n m p; Rewrite Zmult_assoc; Trivial with arith. +intros n m p; rewrite Zmult_assoc; trivial with arith. Qed. (** Associativity mixed with commutativity *) -Theorem Zmult_permute : (n,m,p:Z)(Zmult n (Zmult m p)) = (Zmult m (Zmult n p)). +Theorem Zmult_permute : forall n m p:Z, n * (m * p) = m * (n * p). Proof. -Intros x y z; Rewrite -> (Zmult_assoc y x z); Rewrite -> (Zmult_sym y x). -Apply Zmult_assoc. +intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x). +apply Zmult_assoc. Qed. (** Z is integral *) -Theorem Zmult_eq: (x,y:Z) ~(x=ZERO) -> (Zmult y x) = ZERO -> y = ZERO. +Theorem Zmult_integral_l : forall n m:Z, n <> Z0 -> m * n = Z0 -> m = Z0. Proof. -Intros x y; NewDestruct x as [|p|p]. - Intro H; Absurd ZERO=ZERO; Trivial. - Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate. - Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate. +intros x y; destruct x as [| p| p]. + intro H; absurd (Z0 = Z0); trivial. + intros _ H; destruct y as [| q| q]; reflexivity || discriminate. + intros _ H; destruct y as [| q| q]; reflexivity || discriminate. Qed. -V7only [Set Implicit Arguments.]. -Theorem Zmult_zero : (x,y:Z)(Zmult x y)=ZERO -> x=ZERO \/ y=ZERO. +Theorem Zmult_integral : forall n m:Z, n * m = Z0 -> n = Z0 \/ m = Z0. Proof. -Intros x y; NewDestruct x; NewDestruct y; Auto; Simpl; Intro H; Discriminate H. +intros x y; destruct x; destruct y; auto; simpl in |- *; intro H; + discriminate H. Qed. -V7only [Unset Implicit Arguments.]. -Lemma Zmult_1_inversion_l : - (x,y:Z) (Zmult x y)=(POS xH) -> x=(POS xH) \/ x=(NEG xH). +Lemma Zmult_1_inversion_l : + forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1. Proof. -Intros x y; NewDestruct x as [|p|p]; Intro; [ Discriminate | Left | Right ]; - (NewDestruct y as [|q|q]; Try Discriminate; - Simpl in H; Injection H; Clear H; Intro H; - Rewrite times_one_inversion_l with 1:=H; Reflexivity). +intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ]; + (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H; + intro H; rewrite Pmult_1_inversion_l with (1 := H); + reflexivity). Qed. (** Multiplication and Opposite *) -Theorem Zopp_Zmult_l : (x,y:Z)(Zopp (Zmult x y)) = (Zmult (Zopp x) y). +Theorem Zopp_mult_distr_l : forall n m:Z, - (n * m) = - n * m. Proof. -Intros x y; NewDestruct x; NewDestruct y; Reflexivity. +intros x y; destruct x; destruct y; reflexivity. Qed. -Theorem Zopp_Zmult_r : (x,y:Z)(Zopp (Zmult x y)) = (Zmult x (Zopp y)). -Intros x y; Rewrite (Zmult_sym x y); Rewrite Zopp_Zmult_l; Apply Zmult_sym. +Theorem Zopp_mult_distr_r : forall n m:Z, - (n * m) = n * - m. +intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l; + apply Zmult_comm. Qed. -Lemma Zopp_Zmult: (x,y:Z) (Zmult (Zopp x) y) = (Zopp (Zmult x y)). +Lemma Zopp_mult_distr_l_reverse : forall n m:Z, - n * m = - (n * m). Proof. -Intros x y; Symmetry; Apply Zopp_Zmult_l. +intros x y; symmetry in |- *; apply Zopp_mult_distr_l. Qed. -Theorem Zmult_Zopp_left : (x,y:Z)(Zmult (Zopp x) y) = (Zmult x (Zopp y)). -Intros x y; Rewrite Zopp_Zmult; Rewrite Zopp_Zmult_r; Trivial with arith. +Theorem Zmult_opp_comm : forall n m:Z, - n * m = n * - m. +intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r; + trivial with arith. Qed. -Theorem Zmult_Zopp_Zopp: (x,y:Z) (Zmult (Zopp x) (Zopp y)) = (Zmult x y). +Theorem Zmult_opp_opp : forall n m:Z, - n * - m = n * m. Proof. -Intros x y; NewDestruct x; NewDestruct y; Reflexivity. +intros x y; destruct x; destruct y; reflexivity. Qed. -Theorem Zopp_one : (x:Z)(Zopp x)=(Zmult x (NEG xH)). -Intro x; NewInduction x; Intros; Rewrite Zmult_sym; Auto with arith. +Theorem Zopp_eq_mult_neg_1 : forall n:Z, - n = n * Zneg 1. +intro x; induction x; intros; rewrite Zmult_comm; auto with arith. Qed. (** Distributivity of multiplication over addition *) -Lemma weak_Zmult_plus_distr_r: - (x:positive)(y,z:Z) - (Zmult (POS x) (Zplus y z)) = (Zplus (Zmult (POS x) y) (Zmult (POS x) z)). +Lemma weak_Zmult_plus_distr_r : + forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m. Proof. -Intros x y' z';Case y';Case z';Auto with arith;Intros y z; - (Simpl; Rewrite times_add_distr; Trivial with arith) -Orelse - (Simpl; ElimPcompare z y; Intros E0;Rewrite E0; [ - Rewrite (compare_convert_EGAL z y E0); - Rewrite (convert_compare_EGAL (times x y)); Trivial with arith - | Cut (compare (times x z) (times x y) EGAL)=INFERIEUR; [ - Intros E;Rewrite E; Rewrite times_true_sub_distr; [ - Trivial with arith - | Apply ZC2;Assumption ] - | Apply convert_compare_INFERIEUR;Do 2 Rewrite times_convert; - Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left; - Exact (compare_convert_INFERIEUR z y E0)] - | Cut (compare (times x z) (times x y) EGAL)=SUPERIEUR; [ - Intros E;Rewrite E; Rewrite times_true_sub_distr; Auto with arith - | Apply convert_compare_SUPERIEUR; Unfold gt; Do 2 Rewrite times_convert; - Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left; - Exact (compare_convert_SUPERIEUR z y E0) ]]). +intros x y' z'; case y'; case z'; auto with arith; intros y z; + (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) || + (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0; + [ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y)); + trivial with arith + | cut ((x * z ?= x * y)%positive Eq = Lt); + [ intros E; rewrite E; rewrite Pmult_minus_distr_l; + [ trivial with arith | apply ZC2; assumption ] + | apply nat_of_P_lt_Lt_compare_complement_morphism; + do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); + intros h H1; rewrite H1; apply mult_S_lt_compat_l; + exact (nat_of_P_lt_Lt_compare_morphism z y E0) ] + | cut ((x * z ?= x * y)%positive Eq = Gt); + [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith + | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; + do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); + intros h H1; rewrite H1; apply mult_S_lt_compat_l; + exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]). Qed. -Theorem Zmult_plus_distr_r: - (x,y,z:Z) (Zmult x (Zplus y z)) = (Zplus (Zmult x y) (Zmult x z)). +Theorem Zmult_plus_distr_r : forall n m p:Z, n * (m + p) = n * m + n * p. Proof. -Intros x y z; Case x; [ - Auto with arith -| Intros x';Apply weak_Zmult_plus_distr_r -| Intros p; Apply Zopp_intro; Rewrite Zopp_Zplus; - Do 3 Rewrite <- Zopp_Zmult; Rewrite Zopp_NEG; - Apply weak_Zmult_plus_distr_r ]. +intros x y z; case x; + [ auto with arith + | intros x'; apply weak_Zmult_plus_distr_r + | intros p; apply Zopp_inj; rewrite Zopp_plus_distr; + do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg; + apply weak_Zmult_plus_distr_r ]. Qed. -Theorem Zmult_plus_distr_l : - (n,m,p:Z)((Zmult (Zplus n m) p)=(Zplus (Zmult n p) (Zmult m p))). +Theorem Zmult_plus_distr_l : forall n m p:Z, (n + m) * p = n * p + m * p. Proof. -Intros n m p;Rewrite Zmult_sym;Rewrite Zmult_plus_distr_r; -Do 2 Rewrite -> (Zmult_sym p); Trivial with arith. +intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r; + do 2 rewrite (Zmult_comm p); trivial with arith. Qed. (** Distributivity of multiplication over subtraction *) -Lemma Zmult_Zminus_distr_l : - (x,y,z:Z)((Zmult (Zminus x y) z)=(Zminus (Zmult x z) (Zmult y z))). +Lemma Zmult_minus_distr_r : forall n m p:Z, (n - m) * p = n * p - m * p. Proof. -Intros x y z; Unfold Zminus. -Rewrite <- Zopp_Zmult. -Apply Zmult_plus_distr_l. +intros x y z; unfold Zminus in |- *. +rewrite <- Zopp_mult_distr_l_reverse. +apply Zmult_plus_distr_l. Qed. -V7only [Notation Zmult_minus_distr := Zmult_Zminus_distr_l.]. -Lemma Zmult_Zminus_distr_r : - (x,y,z:Z)(Zmult z (Zminus x y)) = (Zminus (Zmult z x) (Zmult z y)). +Lemma Zmult_minus_distr_l : forall n m p:Z, p * (n - m) = p * n - p * m. Proof. -Intros x y z; Rewrite (Zmult_sym z (Zminus x y)). -Rewrite (Zmult_sym z x). -Rewrite (Zmult_sym z y). -Apply Zmult_Zminus_distr_l. +intros x y z; rewrite (Zmult_comm z (x - y)). +rewrite (Zmult_comm z x). +rewrite (Zmult_comm z y). +apply Zmult_minus_distr_r. Qed. (** Simplification of multiplication for non-zero integers *) -V7only [Set Implicit Arguments.]. -Lemma Zmult_reg_left : (x,y,z:Z) z<>ZERO -> (Zmult z x)=(Zmult z y) -> x=y. +Lemma Zmult_reg_l : forall n m p:Z, p <> Z0 -> p * n = p * m -> n = m. Proof. -Intros x y z H H0. -Generalize (Zeq_Zminus H0). -Intro. -Apply Zminus_Zeq. -Rewrite <- Zmult_Zminus_distr_r in H1. -Clear H0; NewDestruct (Zmult_zero H1). -Contradiction. -Trivial. +intros x y z H H0. +generalize (Zeq_minus _ _ H0). +intro. +apply Zminus_eq. +rewrite <- Zmult_minus_distr_l in H1. +clear H0; destruct (Zmult_integral _ _ H1). +contradiction. +trivial. Qed. -Lemma Zmult_reg_right : (x,y,z:Z) z<>ZERO -> (Zmult x z)=(Zmult y z) -> x=y. +Lemma Zmult_reg_r : forall n m p:Z, p <> Z0 -> n * p = m * p -> n = m. Proof. -Intros x y z Hz. -Rewrite (Zmult_sym x z). -Rewrite (Zmult_sym y z). -Intro; Apply Zmult_reg_left with z; Assumption. +intros x y z Hz. +rewrite (Zmult_comm x z). +rewrite (Zmult_comm y z). +intro; apply Zmult_reg_l with z; assumption. Qed. -V7only [Unset Implicit Arguments.]. (** Addition and multiplication by 2 *) -Lemma Zplus_Zmult_2 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))). +Lemma Zplus_diag_eq_mult_2 : forall n:Z, n + n = n * Zpos 2. Proof. -Intros x; Pattern 1 2 x ; Rewrite <- (Zmult_n_1 x); -Rewrite <- Zmult_plus_distr_r; Reflexivity. +intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x); + rewrite <- Zmult_plus_distr_r; reflexivity. Qed. (** Multiplication and successor *) -Lemma Zmult_succ_r : (n,m:Z) (Zmult n (Zs m))=(Zplus (Zmult n m) n). +Lemma Zmult_succ_r : forall n m:Z, n * Zsucc m = n * m + n. Proof. -Intros n m;Unfold Zs; Rewrite Zmult_plus_distr_r; -Rewrite (Zmult_sym n (POS xH));Rewrite Zmult_one; Trivial with arith. +intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r; + rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; + trivial with arith. Qed. -Lemma Zmult_n_Sm : (n,m:Z) (Zplus (Zmult n m) n)=(Zmult n (Zs m)). +Lemma Zmult_succ_r_reverse : forall n m:Z, n * m + n = n * Zsucc m. Proof. -Intros; Symmetry; Apply Zmult_succ_r. +intros; symmetry in |- *; apply Zmult_succ_r. Qed. -Lemma Zmult_succ_l : (n,m:Z) (Zmult (Zs n) m)=(Zplus (Zmult n m) m). +Lemma Zmult_succ_l : forall n m:Z, Zsucc n * m = n * m + m. Proof. -Intros n m; Unfold Zs; Rewrite Zmult_plus_distr_l; Rewrite Zmult_1_n; -Trivial with arith. +intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l; + rewrite Zmult_1_l; trivial with arith. Qed. -Lemma Zmult_Sm_n : (n,m:Z) (Zplus (Zmult n m) m)=(Zmult (Zs n) m). +Lemma Zmult_succ_l_reverse : forall n m:Z, n * m + m = Zsucc n * m. Proof. -Intros; Symmetry; Apply Zmult_succ_l. +intros; symmetry in |- *; apply Zmult_succ_l. Qed. (** Misc redundant properties *) -Lemma Z_eq_mult: - (x,y:Z) y = ZERO -> (Zmult y x) = ZERO. -Intros x y H; Rewrite H; Auto with arith. +Lemma Z_eq_mult : forall n m:Z, m = Z0 -> m * n = Z0. +intros x y H; rewrite H; auto with arith. Qed. (**********************************************************************) (** Relating binary positive numbers and binary integers *) -Lemma POS_xI : (p:positive) (POS (xI p))=(Zplus (Zmult (POS (xO xH)) (POS p)) (POS xH)). +Lemma Zpos_xI : forall p:positive, Zpos (xI p) = Zpos 2 * Zpos p + Zpos 1. Proof. -Intro; Apply refl_equal. +intro; apply refl_equal. Qed. -Lemma POS_xO : (p:positive) (POS (xO p))=(Zmult (POS (xO xH)) (POS p)). +Lemma Zpos_xO : forall p:positive, Zpos (xO p) = Zpos 2 * Zpos p. Proof. -Intro; Apply refl_equal. +intro; apply refl_equal. Qed. -Lemma NEG_xI : (p:positive) (NEG (xI p))=(Zminus (Zmult (POS (xO xH)) (NEG p)) (POS xH)). +Lemma Zneg_xI : forall p:positive, Zneg (xI p) = Zpos 2 * Zneg p - Zpos 1. Proof. -Intro; Apply refl_equal. +intro; apply refl_equal. Qed. -Lemma NEG_xO : (p:positive) (NEG (xO p))=(Zmult (POS (xO xH)) (NEG p)). +Lemma Zneg_xO : forall p:positive, Zneg (xO p) = Zpos 2 * Zneg p. Proof. -Reflexivity. +reflexivity. Qed. -Lemma POS_add : (p,p':positive)(POS (add p p'))=(Zplus (POS p) (POS p')). +Lemma Zpos_plus_distr : forall p q:positive, Zpos (p + q) = Zpos p + Zpos q. Proof. -Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity. +intros p p'; destruct p; + [ destruct p' as [p0| p0| ] + | destruct p' as [p0| p0| ] + | destruct p' as [p| p| ] ]; reflexivity. Qed. -Lemma NEG_add : (p,p':positive)(NEG (add p p'))=(Zplus (NEG p) (NEG p')). +Lemma Zneg_plus_distr : forall p q:positive, Zneg (p + q) = Zneg p + Zneg q. Proof. -Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity. +intros p p'; destruct p; + [ destruct p' as [p0| p0| ] + | destruct p' as [p0| p0| ] + | destruct p' as [p| p| ] ]; reflexivity. Qed. (**********************************************************************) (** Order relations *) -Definition Zlt := [x,y:Z](Zcompare x y) = INFERIEUR. -Definition Zgt := [x,y:Z](Zcompare x y) = SUPERIEUR. -Definition Zle := [x,y:Z]~(Zcompare x y) = SUPERIEUR. -Definition Zge := [x,y:Z]~(Zcompare x y) = INFERIEUR. -Definition Zne := [x,y:Z] ~(x=y). +Definition Zlt (x y:Z) := (x ?= y) = Lt. +Definition Zgt (x y:Z) := (x ?= y) = Gt. +Definition Zle (x y:Z) := (x ?= y) <> Gt. +Definition Zge (x y:Z) := (x ?= y) <> Lt. +Definition Zne (x y:Z) := x <> y. -V8Infix "<=" Zle : Z_scope. -V8Infix "<" Zlt : Z_scope. -V8Infix ">=" Zge : Z_scope. -V8Infix ">" Zgt : Z_scope. +Infix "<=" := Zle : Z_scope. +Infix "<" := Zlt : Z_scope. +Infix ">=" := Zge : Z_scope. +Infix ">" := Zgt : Z_scope. -V8Notation "x <= y <= z" := (Zle x y)/\(Zle y z) :Z_scope. -V8Notation "x <= y < z" := (Zle x y)/\(Zlt y z) :Z_scope. -V8Notation "x < y < z" := (Zlt x y)/\(Zlt y z) :Z_scope. -V8Notation "x < y <= z" := (Zlt x y)/\(Zle 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. +Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope. (**********************************************************************) (** Absolute value on integers *) -Definition absolu [x:Z] : nat := - Cases x of - ZERO => O - | (POS p) => (convert p) - | (NEG p) => (convert p) +Definition Zabs_nat (x:Z) : nat := + match x with + | Z0 => 0%nat + | Zpos p => nat_of_P p + | Zneg p => nat_of_P p end. -Definition Zabs [z:Z] : Z := - Cases z of - ZERO => ZERO - | (POS p) => (POS p) - | (NEG p) => (POS p) +Definition Zabs (z:Z) : Z := + match z with + | Z0 => Z0 + | Zpos p => Zpos p + | Zneg p => Zpos p end. (**********************************************************************) (** From [nat] to [Z] *) -Definition inject_nat := - [x:nat]Cases x of - O => ZERO - | (S y) => (POS (anti_convert y)) - end. +Definition Z_of_nat (x:nat) := + match x with + | O => Z0 + | S y => Zpos (P_of_succ_nat y) + end. -Require BinNat. +Require Import BinNat. -Definition entier_of_Z := - [z:Z]Cases z of ZERO => Nul | (POS p) => (Pos p) | (NEG p) => (Pos p) end. +Definition Zabs_N (z:Z) := + match z with + | Z0 => 0%N + | Zpos p => Npos p + | Zneg p => Npos p + end. -Definition Z_of_entier := - [x:entier]Cases x of Nul => ZERO | (Pos p) => (POS p) end. +Definition Z_of_N (x:N) := match x with + | N0 => Z0 + | Npos p => Zpos p + end.
\ No newline at end of file diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v index eecfc42b2..4c2efceb1 100644 --- a/theories/ZArith/Wf_Z.v +++ b/theories/ZArith/Wf_Z.v @@ -8,14 +8,12 @@ (*i $Id$ i*) -Require BinInt. -Require Zcompare. -Require Zorder. -Require Znat. -Require Zmisc. -Require Zsyntax. -Require Wf_nat. -V7only [Import Z_scope.]. +Require Import BinInt. +Require Import Zcompare. +Require Import Zorder. +Require Import Znat. +Require Import Zmisc. +Require Import Wf_nat. Open Local Scope Z_scope. (** Our purpose is to write an induction shema for {0,1,2,...} @@ -36,86 +34,83 @@ Open Local Scope Z_scope. >> Then the diagram will be closed and the theorem proved. *) -Lemma inject_nat_complete : - (x:Z)`0 <= x` -> (EX n:nat | x=(inject_nat n)). -Intro x; NewDestruct x; Intros; -[ Exists O; Auto with arith -| Specialize (ZL4 p); Intros Hp; Elim Hp; Intros; - Exists (S x); Intros; Simpl; - Specialize (bij1 x); Intro Hx0; - Rewrite <- H0 in Hx0; - Apply f_equal with f:=POS; - Apply convert_intro; Auto with arith -| Absurd `0 <= (NEG p)`; - [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith - | Assumption] -]. +Lemma Z_of_nat_complete : + forall x:Z, 0 <= x -> exists n : nat | x = Z_of_nat n. +intro x; destruct x; intros; + [ exists 0%nat; auto with arith + | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros; + simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); + intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); + apply nat_of_P_inj; auto with arith + | absurd (0 <= Zneg p); + [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *; + auto with arith + | assumption ] ]. Qed. -Lemma ZL4_inf: (y:positive) { h:nat | (convert y)=(S h) }. -Intro y; NewInduction y as [p H|p H1|]; [ - Elim H; Intros x H1; Exists (plus (S x) (S x)); - Unfold convert ;Simpl; Rewrite ZL0; Rewrite ZL2; Unfold convert in H1; - Rewrite H1; Auto with arith -| Elim H1;Intros x H2; Exists (plus x (S x)); Unfold convert; - Simpl; Rewrite ZL0; Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith -| Exists O ;Auto with arith]. +Lemma ZL4_inf : forall y:positive, {h : nat | nat_of_P y = S h}. +intro y; induction y as [p H| p H1| ]; + [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *; + simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism; + unfold nat_of_P in H1; rewrite H1; auto with arith + | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *; + simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism; + unfold nat_of_P in H2; rewrite H2; auto with arith + | exists 0%nat; auto with arith ]. Qed. -Lemma inject_nat_complete_inf : - (x:Z)`0 <= x` -> { n:nat | (x=(inject_nat n)) }. -Intro x; NewDestruct x; Intros; -[ Exists O; Auto with arith -| Specialize (ZL4_inf p); Intros Hp; Elim Hp; Intros x0 H0; - Exists (S x0); Intros; Simpl; - Specialize (bij1 x0); Intro Hx0; - Rewrite <- H0 in Hx0; - Apply f_equal with f:=POS; - Apply convert_intro; Auto with arith -| Absurd `0 <= (NEG p)`; - [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith - | Assumption] -]. +Lemma Z_of_nat_complete_inf : + forall x:Z, 0 <= x -> {n : nat | x = Z_of_nat n}. +intro x; destruct x; intros; + [ exists 0%nat; auto with arith + | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0); + intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0); + intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); + apply nat_of_P_inj; auto with arith + | absurd (0 <= Zneg p); + [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *; + auto with arith + | assumption ] ]. Qed. -Lemma inject_nat_prop : - (P:Z->Prop)((n:nat)(P (inject_nat n))) -> - (x:Z) `0 <= x` -> (P x). -Intros P H x H0. -Specialize (inject_nat_complete x H0). -Intros Hn; Elim Hn; Intros. -Rewrite -> H1; Apply H. +Lemma Z_of_nat_prop : + forall P:Z -> Prop, + (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x. +intros P H x H0. +specialize (Z_of_nat_complete x H0). +intros Hn; elim Hn; intros. +rewrite H1; apply H. Qed. -Lemma inject_nat_set : - (P:Z->Set)((n:nat)(P (inject_nat n))) -> - (x:Z) `0 <= x` -> (P x). -Intros P H x H0. -Specialize (inject_nat_complete_inf x H0). -Intros Hn; Elim Hn; Intros. -Rewrite -> p; Apply H. +Lemma Z_of_nat_set : + forall P:Z -> Set, + (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x. +intros P H x H0. +specialize (Z_of_nat_complete_inf x H0). +intros Hn; elim Hn; intros. +rewrite p; apply H. Qed. -Lemma natlike_ind : (P:Z->Prop) (P `0`) -> - ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) -> - (x:Z) `0 <= x` -> (P x). -Intros P H H0 x H1; Apply inject_nat_prop; -[ Induction n; - [ Simpl; Assumption - | Intros; Rewrite -> (inj_S n0); - Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ] -| Assumption]. +Lemma natlike_ind : + forall P:Z -> Prop, + P 0 -> + (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x. +intros P H H0 x H1; apply Z_of_nat_prop; + [ simple induction n; + [ simpl in |- *; assumption + | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ] + | assumption ]. Qed. -Lemma natlike_rec : (P:Z->Set) (P `0`) -> - ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) -> - (x:Z) `0 <= x` -> (P x). -Intros P H H0 x H1; Apply inject_nat_set; -[ Induction n; - [ Simpl; Assumption - | Intros; Rewrite -> (inj_S n0); - Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ] -| Assumption]. +Lemma natlike_rec : + forall P:Z -> Set, + P 0 -> + (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x. +intros P H H0 x H1; apply Z_of_nat_set; + [ simple induction n; + [ simpl in |- *; assumption + | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ] + | assumption ]. Qed. Section Efficient_Rec. @@ -123,72 +118,87 @@ Section Efficient_Rec. (** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed to give a better extracted term. *) -Local R := [a,b:Z]`0<=a`/\`a<b`. +Let R (a b:Z) := 0 <= a /\ a < b. -Local R_wf : (well_founded Z R). +Let R_wf : well_founded R. Proof. -LetTac f := [z]Cases z of (POS p) => (convert p) | ZERO => O | (NEG _) => O end. -Apply well_founded_lt_compat with f. -Unfold R f; Clear f R. -Intros x y; Case x; Intros; Elim H; Clear H. -Case y; Intros; Apply compare_convert_O Orelse Inversion H0. -Case y; Intros; Apply compare_convert_INFERIEUR Orelse Inversion H0; Auto. -Intros; Elim H; Auto. +set + (f := + fun z => + match z with + | Zpos p => nat_of_P p + | Z0 => 0%nat + | Zneg _ => 0%nat + end) in *. +apply well_founded_lt_compat with f. +unfold R, f in |- *; clear f R. +intros x y; case x; intros; elim H; clear H. +case y; intros; apply lt_O_nat_of_P || inversion H0. +case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto. +intros; elim H; auto. Qed. -Lemma natlike_rec2 : (P:Z->Type)(P `0`) -> - ((z:Z)`0<=z` -> (P z) -> (P (Zs z))) -> (z:Z)`0<=z` -> (P z). +Lemma natlike_rec2 : + forall P:Z -> Type, + P 0 -> + (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z. Proof. -Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf). -Intro x; Case x. -Trivial. -Intros. -Assert `0<=(Zpred (POS p))`. -Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial. -Rewrite Zs_pred. -Apply Hrec. -Auto. -Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n. -Intros; Elim H; Simpl; Trivial. +intros P Ho Hrec z; pattern z in |- *; + apply (well_founded_induction_type R_wf). +intro x; case x. +trivial. +intros. +assert (0 <= Zpred (Zpos p)). +apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial. +rewrite Zsucc_pred. +apply Hrec. +auto. +apply X; auto; unfold R in |- *; intuition; apply Zlt_pred. +intros; elim H; simpl in |- *; trivial. Qed. (** A variant of the previous using [Zpred] instead of [Zs]. *) -Lemma natlike_rec3 : (P:Z->Type)(P `0`) -> - ((z:Z)`0<z` -> (P (Zpred z)) -> (P z)) -> (z:Z)`0<=z` -> (P z). +Lemma natlike_rec3 : + forall P:Z -> Type, + P 0 -> + (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z. Proof. -Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf). -Intro x; Case x. -Trivial. -Intros; Apply Hrec. -Unfold Zlt; Trivial. -Assert `0<=(Zpred (POS p))`. -Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial. -Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n. -Intros; Elim H; Simpl; Trivial. +intros P Ho Hrec z; pattern z in |- *; + apply (well_founded_induction_type R_wf). +intro x; case x. +trivial. +intros; apply Hrec. +unfold Zlt in |- *; trivial. +assert (0 <= Zpred (Zpos p)). +apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial. +apply X; auto; unfold R in |- *; intuition; apply Zlt_pred. +intros; elim H; simpl in |- *; trivial. Qed. (** A more general induction principal using [Zlt]. *) -Lemma Z_lt_rec : (P:Z->Type) - ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x)) -> (x:Z)`0 <= x`->(P x). +Lemma Z_lt_rec : + forall P:Z -> Type, + (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) -> + forall x:Z, 0 <= x -> P x. Proof. -Intros P Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf). -Intro x; Case x; Intros. -Apply Hrec; Intros. -Assert H2: `0<0`. - Apply Zle_lt_trans with y; Intuition. -Inversion H2. -Firstorder. -Unfold Zle Zcompare in H; Elim H; Auto. +intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf). +intro x; case x; intros. +apply Hrec; intros. +assert (H2 : 0 < 0). + apply Zle_lt_trans with y; intuition. +inversion H2. +firstorder. +unfold Zle, Zcompare in H; elim H; auto. Defined. -Lemma Z_lt_induction : - (P:Z->Prop) - ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x)) - -> (x:Z)`0 <= x`->(P x). +Lemma Z_lt_induction : + forall P:Z -> Prop, + (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) -> + forall x:Z, 0 <= x -> P x. Proof. -Exact Z_lt_rec. +exact Z_lt_rec. Qed. -End Efficient_Rec. +End Efficient_Rec.
\ No newline at end of file diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v index f85b0bddd..bc58a1a4b 100644 --- a/theories/ZArith/ZArith.v +++ b/theories/ZArith/ZArith.v @@ -19,4 +19,4 @@ Require Export Zsqrt. Require Export Zpower. Require Export Zdiv. Require Export Zlogarithm. -Require Export Zbool. +Require Export Zbool.
\ No newline at end of file diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v index 97f4c3f3e..ec57dda57 100644 --- a/theories/ZArith/ZArith_base.v +++ b/theories/ZArith/ZArith_base.v @@ -12,10 +12,6 @@ These are the basic modules, required by [Omega] and [Ring] for instance. The full library is [ZArith]. *) -V7only [ -Require Export fast_integer. -Require Export zarith_aux. -]. Require Export BinPos. Require Export BinNat. Require Export BinInt. @@ -26,14 +22,13 @@ Require Export Zmin. Require Export Zabs. Require Export Znat. Require Export auxiliary. -Require Export Zsyntax. Require Export ZArith_dec. Require Export Zbool. Require Export Zmisc. Require Export Wf_Z. -Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc - Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r - Zmult_plus_distr_l Zmult_plus_distr_r : zarith. +Hint Resolve Zle_refl Zplus_comm Zplus_assoc Zmult_comm Zmult_assoc Zplus_0_l + Zplus_0_r Zmult_1_l Zplus_opp_l Zplus_opp_r Zmult_plus_distr_l + Zmult_plus_distr_r: zarith. -Require Export Zhints. +Require Export Zhints.
\ No newline at end of file diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index e8f83fe1a..ed323a641 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -8,236 +8,219 @@ (*i $Id$ i*) -Require Sumbool. +Require Import Sumbool. -Require BinInt. -Require Zorder. -Require Zcompare. -Require Zsyntax. -V7only [Import Z_scope.]. +Require Import BinInt. +Require Import Zorder. +Require Import Zcompare. Open Local Scope Z_scope. -Lemma Dcompare_inf : (r:relation) {r=EGAL} + {r=INFERIEUR} + {r=SUPERIEUR}. +Lemma Dcompare_inf : forall r:comparison, {r = Eq} + {r = Lt} + {r = Gt}. Proof. -Induction r; Auto with arith. +simple induction r; auto with arith. Defined. Lemma Zcompare_rec : - (P:Set)(x,y:Z) - ((Zcompare x y)=EGAL -> P) -> - ((Zcompare x y)=INFERIEUR -> P) -> - ((Zcompare x y)=SUPERIEUR -> P) -> - P. + forall (P:Set) (n m:Z), + ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. Proof. -Intros P x y H1 H2 H3. -Elim (Dcompare_inf (Zcompare x y)). -Intro H. Elim H; Auto with arith. Auto with arith. +intros P x y H1 H2 H3. +elim (Dcompare_inf (x ?= y)). +intro H. elim H; auto with arith. auto with arith. Defined. Section decidability. -Variables x,y : Z. +Variables x y : Z. (** Decidability of equality on binary integers *) -Definition Z_eq_dec : {x=y}+{~x=y}. +Definition Z_eq_dec : {x = y} + {x <> y}. Proof. -Apply Zcompare_rec with x:=x y:=y. -Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith. -Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4. - Rewrite (H2 H4) in H3. Discriminate H3. -Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4. - Rewrite (H2 H4) in H3. Discriminate H3. +apply Zcompare_rec with (n := x) (m := y). +intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith. +intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4. + rewrite (H2 H4) in H3. discriminate H3. +intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4. + rewrite (H2 H4) in H3. discriminate H3. Defined. (** Decidability of order on binary integers *) -Definition Z_lt_dec : {(Zlt x y)}+{~(Zlt x y)}. +Definition Z_lt_dec : {x < y} + {~ x < y}. Proof. -Unfold Zlt. -Apply Zcompare_rec with x:=x y:=y; Intro H. -Right. Rewrite H. Discriminate. -Left; Assumption. -Right. Rewrite H. Discriminate. +unfold Zlt in |- *. +apply Zcompare_rec with (n := x) (m := y); intro H. +right. rewrite H. discriminate. +left; assumption. +right. rewrite H. discriminate. Defined. -Definition Z_le_dec : {(Zle x y)}+{~(Zle x y)}. +Definition Z_le_dec : {x <= y} + {~ x <= y}. Proof. -Unfold Zle. -Apply Zcompare_rec with x:=x y:=y; Intro H. -Left. Rewrite H. Discriminate. -Left. Rewrite H. Discriminate. -Right. Tauto. +unfold Zle in |- *. +apply Zcompare_rec with (n := x) (m := y); intro H. +left. rewrite H. discriminate. +left. rewrite H. discriminate. +right. tauto. Defined. -Definition Z_gt_dec : {(Zgt x y)}+{~(Zgt x y)}. +Definition Z_gt_dec : {x > y} + {~ x > y}. Proof. -Unfold Zgt. -Apply Zcompare_rec with x:=x y:=y; Intro H. -Right. Rewrite H. Discriminate. -Right. Rewrite H. Discriminate. -Left; Assumption. +unfold Zgt in |- *. +apply Zcompare_rec with (n := x) (m := y); intro H. +right. rewrite H. discriminate. +right. rewrite H. discriminate. +left; assumption. Defined. -Definition Z_ge_dec : {(Zge x y)}+{~(Zge x y)}. +Definition Z_ge_dec : {x >= y} + {~ x >= y}. Proof. -Unfold Zge. -Apply Zcompare_rec with x:=x y:=y; Intro H. -Left. Rewrite H. Discriminate. -Right. Tauto. -Left. Rewrite H. Discriminate. +unfold Zge in |- *. +apply Zcompare_rec with (n := x) (m := y); intro H. +left. rewrite H. discriminate. +right. tauto. +left. rewrite H. discriminate. Defined. -Definition Z_lt_ge_dec : {`x < y`}+{`x >= y`}. +Definition Z_lt_ge_dec : {x < y} + {x >= y}. Proof. -Exact Z_lt_dec. +exact Z_lt_dec. Defined. -V7only [ (* From Zextensions *) ]. -Lemma Z_lt_le_dec: {`x < y`}+{`y <= x`}. +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. +intros. +elim Z_lt_ge_dec. +intros; left; assumption. +intros; right; apply Zge_le; assumption. Qed. -Definition Z_le_gt_dec : {`x <= y`}+{`x > y`}. +Definition Z_le_gt_dec : {x <= y} + {x > y}. Proof. -Elim Z_le_dec; Auto with arith. -Intro. Right. Apply not_Zle; Auto with arith. +elim Z_le_dec; auto with arith. +intro. right. apply Znot_le_gt; auto with arith. Defined. -Definition Z_gt_le_dec : {`x > y`}+{`x <= y`}. +Definition Z_gt_le_dec : {x > y} + {x <= y}. Proof. -Exact Z_gt_dec. +exact Z_gt_dec. Defined. -Definition Z_ge_lt_dec : {`x >= y`}+{`x < y`}. +Definition Z_ge_lt_dec : {x >= y} + {x < y}. Proof. -Elim Z_ge_dec; Auto with arith. -Intro. Right. Apply not_Zge; Auto with arith. +elim Z_ge_dec; auto with arith. +intro. right. apply Znot_ge_lt; auto with arith. Defined. -Definition Z_le_lt_eq_dec : `x <= y` -> {`x < y`}+{x=y}. +Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}. Proof. -Intro H. -Apply Zcompare_rec with x:=x y:=y. -Intro. Right. Elim (Zcompare_EGAL x y); Auto with arith. -Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith. -Intro H1. Absurd `x > y`; Auto with arith. +intro H. +apply Zcompare_rec with (n := x) (m := y). +intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith. +intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith. +intro H1. absurd (x > y); auto with arith. Defined. End decidability. (** Cotransitivity of order on binary integers *) -Lemma Zlt_cotrans:(n,m:Z)`n<m`->(p:Z){`n<p`}+{`p<m`}. -Proof. - Intros x y H z. - Case (Z_lt_ge_dec x z). - Intro. - Left. - Assumption. - Intro. - Right. - Apply Zle_lt_trans with m:=x. - Apply Zge_le. - Assumption. - Assumption. -Defined. - -Lemma Zlt_cotrans_pos:(x,y:Z)`0<x+y`->{`0<x`}+{`0<y`}. -Proof. - Intros x y H. - Case (Zlt_cotrans `0` `x+y` H x). - Intro. - Left. - Assumption. - Intro. - Right. - Apply Zsimpl_lt_plus_l with p:=`x`. - Rewrite Zero_right. - Assumption. -Defined. - -Lemma Zlt_cotrans_neg:(x,y:Z)`x+y<0`->{`x<0`}+{`y<0`}. -Proof. - Intros x y H; - Case (Zlt_cotrans `x+y` `0` H x); - Intro Hxy; - [ Right; - Apply Zsimpl_lt_plus_l with p:=`x`; - Rewrite Zero_right - | Left - ]; - Assumption. -Defined. - -Lemma not_Zeq_inf:(x,y:Z)`x<>y`->{`x<y`}+{`y<x`}. -Proof. - Intros x y H. - Case Z_lt_ge_dec with x y. - Intro. - Left. - Assumption. - Intro H0. - Generalize (Zge_le ? ? H0). - Intro. - Case (Z_le_lt_eq_dec ? ? H1). - Intro. - Right. - Assumption. - Intro. - Apply False_rec. - Apply H. - Symmetry. - Assumption. -Defined. - -Lemma Z_dec:(x,y:Z){`x<y`}+{`x>y`}+{`x=y`}. -Proof. - Intros x y. - Case (Z_lt_ge_dec x y). - Intro H. - Left. - Left. - Assumption. - Intro H. - Generalize (Zge_le ? ? H). - Intro H0. - Case (Z_le_lt_eq_dec y x H0). - Intro H1. - Left. - Right. - Apply Zlt_gt. - Assumption. - Intro. - Right. - Symmetry. - Assumption. -Defined. - - -Lemma Z_dec':(x,y:Z){`x<y`}+{`y<x`}+{`x=y`}. -Proof. - Intros x y. - Case (Z_eq_dec x y); - Intro H; - [ Right; - Assumption - | Left; - Apply (not_Zeq_inf ?? H) - ]. -Defined. - - - -Definition Z_zerop : (x:Z){(`x = 0`)}+{(`x <> 0`)}. -Proof. -Exact [x:Z](Z_eq_dec x ZERO). -Defined. - -Definition Z_notzerop := [x:Z](sumbool_not ? ? (Z_zerop x)). - -Definition Z_noteq_dec := [x,y:Z](sumbool_not ? ? (Z_eq_dec x y)). +Lemma Zlt_cotrans : forall n m:Z, n < m -> forall p:Z, {n < p} + {p < m}. +Proof. + intros x y H z. + case (Z_lt_ge_dec x z). + intro. + left. + assumption. + intro. + right. + apply Zle_lt_trans with (m := x). + apply Zge_le. + assumption. + assumption. +Defined. + +Lemma Zlt_cotrans_pos : forall n m:Z, 0 < n + m -> {0 < n} + {0 < m}. +Proof. + intros x y H. + case (Zlt_cotrans 0 (x + y) H x). + intro. + left. + assumption. + intro. + right. + apply Zplus_lt_reg_l with (p := x). + rewrite Zplus_0_r. + assumption. +Defined. + +Lemma Zlt_cotrans_neg : forall n m:Z, n + m < 0 -> {n < 0} + {m < 0}. +Proof. + intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy; + [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ]; + assumption. +Defined. + +Lemma not_Zeq_inf : forall n m:Z, n <> m -> {n < m} + {m < n}. +Proof. + intros x y H. + case Z_lt_ge_dec with x y. + intro. + left. + assumption. + intro H0. + generalize (Zge_le _ _ H0). + intro. + case (Z_le_lt_eq_dec _ _ H1). + intro. + right. + assumption. + intro. + apply False_rec. + apply H. + symmetry in |- *. + assumption. +Defined. + +Lemma Z_dec : forall n m:Z, {n < m} + {n > m} + {n = m}. +Proof. + intros x y. + case (Z_lt_ge_dec x y). + intro H. + left. + left. + assumption. + intro H. + generalize (Zge_le _ _ H). + intro H0. + case (Z_le_lt_eq_dec y x H0). + intro H1. + left. + right. + apply Zlt_gt. + assumption. + intro. + right. + symmetry in |- *. + assumption. +Defined. + + +Lemma Z_dec' : forall n m:Z, {n < m} + {m < n} + {n = m}. +Proof. + intros x y. + case (Z_eq_dec x y); intro H; + [ right; assumption | left; apply (not_Zeq_inf _ _ H) ]. +Defined. + + + +Definition Z_zerop : forall x:Z, {x = 0} + {x <> 0}. +Proof. +exact (fun x:Z => Z_eq_dec x 0). +Defined. + +Definition Z_notzerop (x:Z) := sumbool_not _ _ (Z_zerop x). + +Definition Z_noteq_dec (x y:Z) := sumbool_not _ _ (Z_eq_dec x y).
\ No newline at end of file diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index 27c72c4d1..eff457fc5 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -9,130 +9,120 @@ (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *) -Require Arith. -Require BinPos. -Require BinInt. -Require Zorder. -Require Zsyntax. -Require ZArith_dec. - -V7only [Import nat_scope.]. +Require Import Arith. +Require Import BinPos. +Require Import BinInt. +Require Import Zorder. +Require Import ZArith_dec. + Open Local Scope Z_scope. (**********************************************************************) (** Properties of absolute value *) -Lemma Zabs_eq : (x:Z) (Zle ZERO x) -> (Zabs x)=x. -Intro x; NewDestruct x; Auto with arith. -Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith. +Lemma Zabs_eq : forall n:Z, 0 <= n -> Zabs n = n. +intro x; destruct x; auto with arith. +compute in |- *; intros; absurd (Gt = Gt); trivial with arith. Qed. -Lemma Zabs_non_eq : (x:Z) (Zle x ZERO) -> (Zabs x)=(Zopp x). +Lemma Zabs_non_eq : forall n:Z, n <= 0 -> Zabs n = - n. Proof. -Intro x; NewDestruct x; Auto with arith. -Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith. +intro x; destruct x; auto with arith. +compute in |- *; intros; absurd (Gt = Gt); trivial with arith. Qed. -V7only [ (* From Zdivides *) ]. -Theorem Zabs_Zopp: (z : Z) (Zabs (Zopp z)) = (Zabs z). +Theorem Zabs_Zopp : forall n:Z, Zabs (- n) = Zabs n. Proof. -Intros z; Case z; Simpl; Auto. +intros z; case z; simpl in |- *; auto. Qed. (** Proving a property of the absolute value by cases *) -Lemma Zabs_ind : - (P:Z->Prop)(x:Z)(`x >= 0` -> (P x)) -> (`x <= 0` -> (P `-x`)) -> - (P `|x|`). +Lemma Zabs_ind : + forall (P:Z -> Prop) (n:Z), + (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n). Proof. -Intros P x H H0; Elim (Z_lt_ge_dec x `0`); Intro. -Assert `x<=0`. Apply Zlt_le_weak; Assumption. -Rewrite Zabs_non_eq. Apply H0. Assumption. Assumption. -Rewrite Zabs_eq. Apply H; Assumption. Apply Zge_le. Assumption. -Save. - -V7only [ (* From Zdivides *) ]. -Theorem Zabs_intro: (P : ?) (z : Z) (P (Zopp z)) -> (P z) -> (P (Zabs z)). -Intros P z; Case z; Simpl; Auto. +intros P x H H0; elim (Z_lt_ge_dec x 0); intro. +assert (x <= 0). apply Zlt_le_weak; assumption. +rewrite Zabs_non_eq. apply H0. assumption. assumption. +rewrite Zabs_eq. apply H; assumption. apply Zge_le. assumption. +Qed. + +Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Zabs n). +intros P z; case z; simpl in |- *; auto. Qed. -Definition Zabs_dec : (x:Z){x=(Zabs x)}+{x=(Zopp (Zabs x))}. +Definition Zabs_dec : forall x:Z, {x = Zabs x} + {x = - Zabs x}. Proof. -Intro x; NewDestruct x;Auto with arith. +intro x; destruct x; auto with arith. Defined. -Lemma Zabs_pos : (x:Z)(Zle ZERO (Zabs x)). -Intro x; NewDestruct x;Auto with arith; Compute; Intros H;Inversion H. +Lemma Zabs_pos : forall n:Z, 0 <= Zabs n. +intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H. Qed. -V7only [ (* From Zdivides *) ]. -Theorem Zabs_eq_case: - (z1, z2 : Z) (Zabs z1) = (Zabs z2) -> z1 = z2 \/ z1 = (Zopp z2). +Theorem Zabs_eq_case : forall n m:Z, Zabs n = Zabs m -> n = m \/ n = - m. Proof. -Intros z1 z2; Case z1; Case z2; Simpl; Auto; Try (Intros; Discriminate); - Intros p1 p2 H1; Injection H1; (Intros H2; Rewrite H2); Auto. +intros z1 z2; case z1; case z2; simpl in |- *; auto; + try (intros; discriminate); intros p1 p2 H1; injection H1; + (intros H2; rewrite H2); auto. Qed. (** Triangular inequality *) -Hints Local Resolve Zle_NEG_POS :zarith. +Hint Local Resolve Zle_neg_pos: zarith. -V7only [ (* From Zdivides *) ]. -Theorem Zabs_triangle: - (z1, z2 : Z) (Zle (Zabs (Zplus z1 z2)) (Zplus (Zabs z1) (Zabs z2))). +Theorem Zabs_triangle : forall n m:Z, Zabs (n + m) <= Zabs n + Zabs m. Proof. -Intros z1 z2; Case z1; Case z2; Try (Simpl; Auto with zarith; Fail). -Intros p1 p2; - Apply Zabs_intro - with P := [x : ?] (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1)))); - Try Rewrite Zopp_Zplus; Auto with zarith. -Apply Zle_plus_plus; Simpl; Auto with zarith. -Apply Zle_plus_plus; Simpl; Auto with zarith. -Intros p1 p2; - Apply Zabs_intro - with P := [x : ?] (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1)))); - Try Rewrite Zopp_Zplus; Auto with zarith. -Apply Zle_plus_plus; Simpl; Auto with zarith. -Apply Zle_plus_plus; Simpl; Auto with zarith. +intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail). +intros p1 p2; + apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1)); + try rewrite Zopp_plus_distr; auto with zarith. +apply Zplus_le_compat; simpl in |- *; auto with zarith. +apply Zplus_le_compat; simpl in |- *; auto with zarith. +intros p1 p2; + apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1)); + try rewrite Zopp_plus_distr; auto with zarith. +apply Zplus_le_compat; simpl in |- *; auto with zarith. +apply Zplus_le_compat; simpl in |- *; auto with zarith. Qed. (** Absolute value and multiplication *) -Lemma Zsgn_Zabs: (x:Z)(Zmult x (Zsgn x))=(Zabs x). +Lemma Zsgn_Zabs : forall n:Z, n * Zsgn n = Zabs n. Proof. -Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith. +intro x; destruct x; rewrite Zmult_comm; auto with arith. Qed. -Lemma Zabs_Zsgn: (x:Z)(Zmult (Zabs x) (Zsgn x))=x. +Lemma Zabs_Zsgn : forall n:Z, Zabs n * Zsgn n = n. Proof. -Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith. +intro x; destruct x; rewrite Zmult_comm; auto with arith. Qed. -V7only [ (* From Zdivides *) ]. -Theorem Zabs_Zmult: - (z1, z2 : Z) (Zabs (Zmult z1 z2)) = (Zmult (Zabs z1) (Zabs z2)). +Theorem Zabs_Zmult : forall n m:Z, Zabs (n * m) = Zabs n * Zabs m. Proof. -Intros z1 z2; Case z1; Case z2; Simpl; Auto. +intros z1 z2; case z1; case z2; simpl in |- *; auto. Qed. (** absolute value in nat is compatible with order *) -Lemma absolu_lt : (x,y:Z) (Zle ZERO x)/\(Zlt x y) -> (lt (absolu x) (absolu y)). +Lemma Zabs_nat_lt : + forall n m:Z, 0 <= n /\ n < m -> (Zabs_nat n < Zabs_nat m)%nat. Proof. -Intros x y. Case x; Simpl. Case y; Simpl. +intros x y. case x; simpl in |- *. case y; simpl in |- *. -Intro. Absurd (Zlt ZERO ZERO). Compute. Intro H0. Discriminate H0. Intuition. -Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith. -Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith. +intro. absurd (0 < 0). compute in |- *. intro H0. discriminate H0. intuition. +intros. elim (ZL4 p). intros. rewrite H0. auto with arith. +intros. elim (ZL4 p). intros. rewrite H0. auto with arith. -Case y; Simpl. -Intros. Absurd (Zlt (POS p) ZERO). Compute. Intro H0. Discriminate H0. Intuition. -Intros. Change (gt (convert p) (convert p0)). -Apply compare_convert_SUPERIEUR. -Elim H; Auto with arith. Intro. Exact (ZC2 p0 p). +case y; simpl in |- *. +intros. absurd (Zpos p < 0). compute in |- *. intro H0. discriminate H0. intuition. +intros. change (nat_of_P p > nat_of_P p0)%nat in |- *. +apply nat_of_P_gt_Gt_compare_morphism. +elim H; auto with arith. intro. exact (ZC2 p0 p). -Intros. Absurd (Zlt (POS p0) (NEG p)). -Compute. Intro H0. Discriminate H0. Intuition. +intros. absurd (Zpos p0 < Zneg p). +compute in |- *. intro H0. discriminate H0. intuition. -Intros. Absurd (Zle ZERO (NEG p)). Compute. Auto with arith. Intuition. -Qed. +intros. absurd (0 <= Zneg p). compute in |- *. auto with arith. intuition. +Qed.
\ No newline at end of file diff --git a/theories/ZArith/Zbinary.v b/theories/ZArith/Zbinary.v index 142bfdef6..cd8872dac 100644 --- a/theories/ZArith/Zbinary.v +++ b/theories/ZArith/Zbinary.v @@ -11,10 +11,10 @@ (** Bit vectors interpreted as integers. Contribution by Jean Duprat (ENS Lyon). *) -Require Bvector. -Require ZArith. +Require Import Bvector. +Require Import ZArith. Require Export Zpower. -Require Omega. +Require Import Omega. (* L'évaluation des vecteurs de booléens se font à la fois en binaire et @@ -41,29 +41,29 @@ Le complément à deux n'a de sens que sur les vecteurs de taille supérieure ou égale à un, le bit de signe étant évalué négativement. *) -Definition bit_value [b:bool] : Z := -Cases b of - | true => `1` - | false => `0` -end. +Definition bit_value (b:bool) : Z := + match b with + | true => 1%Z + | false => 0%Z + end. -Lemma binary_value : (n:nat) (Bvector n) -> Z. +Lemma binary_value : forall n:nat, Bvector n -> Z. Proof. - Induction n; Intros. - Exact `0`. + simple induction n; intros. + exact 0%Z. - Inversion H0. - Exact (Zplus (bit_value a) (Zmult `2` (H H2))). + inversion H0. + exact (bit_value a + 2 * H H2)%Z. Defined. -Lemma two_compl_value : (n:nat) (Bvector (S n)) -> Z. +Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z. Proof. - Induction n; Intros. - Inversion H. - Exact (Zopp (bit_value a)). + simple induction n; intros. + inversion H. + exact (- bit_value a)%Z. - Inversion H0. - Exact (Zplus (bit_value a) (Zmult `2` (H H2))). + inversion H0. + exact (bit_value a + 2 * H H2)%Z. Defined. (* @@ -91,52 +91,50 @@ La valeur en complément à deux est calculée selon un schema de Horner avec Zmod2, le paramètre est la taille moins un. *) -Definition Zmod2 := [z:Z] Cases z of - | ZERO => `0` - | ((POS p)) => Cases p of - | (xI q) => (POS q) - | (xO q) => (POS q) - | xH => `0` - end - | ((NEG p)) => Cases p of - | (xI q) => `(NEG q) - 1` - | (xO q) => (NEG q) - | xH => `-1` - end - end. - -V7only [ -Notation double_moins_un_add_un := - [p](sym_eq ? ? ? (double_moins_un_add_un_xI p)). -]. - -Lemma Zmod2_twice : (z:Z) - `z = (2*(Zmod2 z) + (bit_value (Zodd_bool z)))`. +Definition Zmod2 (z:Z) := + match z with + | Z0 => 0%Z + | Zpos p => match p with + | xI q => Zpos q + | xO q => Zpos q + | xH => 0%Z + end + | Zneg p => + match p with + | xI q => (Zneg q - 1)%Z + | xO q => Zneg q + | xH => (-1)%Z + end + end. + + +Lemma Zmod2_twice : + forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z. Proof. - NewDestruct z; Simpl. - Trivial. + destruct z; simpl in |- *. + trivial. - NewDestruct p; Simpl; Trivial. + destruct p; simpl in |- *; trivial. - NewDestruct p; Simpl. - NewDestruct p as [p|p|]; Simpl. - Rewrite <- (double_moins_un_add_un_xI p); Trivial. + destruct p; simpl in |- *. + destruct p as [p| p| ]; simpl in |- *. + rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial. - Trivial. + trivial. - Trivial. + trivial. - Trivial. + trivial. - Trivial. -Save. + trivial. +Qed. -Lemma Z_to_binary : (n:nat) Z -> (Bvector n). +Lemma Z_to_binary : forall n:nat, Z -> Bvector n. Proof. - Induction n; Intros. - Exact Bnil. + simple induction n; intros. + exact Bnil. - Exact (Bcons (Zodd_bool H0) n0 (H (Zdiv2 H0))). + exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))). Defined. (* @@ -148,12 +146,12 @@ Eval Compute in (Z_to_binary (5) `5`). : (Bvector (5)) *) -Lemma Z_to_two_compl : (n:nat) Z -> (Bvector (S n)). +Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n). Proof. - Induction n; Intros. - Exact (Bcons (Zodd_bool H) (0) Bnil). + simple induction n; intros. + exact (Bcons (Zeven.Zodd_bool H) 0 Bnil). - Exact (Bcons (Zodd_bool H0) (S n0) (H (Zmod2 H0))). + exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))). Defined. (* @@ -186,93 +184,97 @@ Utilise largement ZArith. Meriterait d'etre reecrite. *) -Lemma binary_value_Sn : (n:nat) (b:bool) (bv : (Bvector n)) - (binary_value (S n) (Vcons bool b n bv))=`(bit_value b) + 2*(binary_value n bv)`. +Lemma binary_value_Sn : + forall (n:nat) (b:bool) (bv:Bvector n), + binary_value (S n) (Vcons bool b n bv) = + (bit_value b + 2 * binary_value n bv)%Z. Proof. - Intros; Auto. -Save. + intros; auto. +Qed. -Lemma Z_to_binary_Sn : (n:nat) (b:bool) (z:Z) - `z>=0`-> - (Z_to_binary (S n) `(bit_value b) + 2*z`)=(Bcons b n (Z_to_binary n z)). +Lemma Z_to_binary_Sn : + forall (n:nat) (b:bool) (z:Z), + (z >= 0)%Z -> + Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z). Proof. - NewDestruct b; NewDestruct z; Simpl; Auto. - Intro H; Elim H; Trivial. -Save. + destruct b; destruct z; simpl in |- *; auto. + intro H; elim H; trivial. +Qed. -Lemma binary_value_pos : (n:nat) (bv:(Bvector n)) - `(binary_value n bv) >= 0`. +Lemma binary_value_pos : + forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z. Proof. - NewInduction bv as [|a n v IHbv]; Simpl. - Omega. + induction bv as [| a n v IHbv]; simpl in |- *. + omega. - NewDestruct a; NewDestruct (binary_value n v); Simpl; Auto. - Auto with zarith. -Save. + destruct a; destruct (binary_value n v); simpl in |- *; auto. + auto with zarith. +Qed. -V7only [Notation add_un_double_moins_un_xO := is_double_moins_un.]. -Lemma two_compl_value_Sn : (n:nat) (bv : (Bvector (S n))) (b:bool) - (two_compl_value (S n) (Bcons b (S n) bv)) = - `(bit_value b) + 2*(two_compl_value n bv)`. +Lemma two_compl_value_Sn : + forall (n:nat) (bv:Bvector (S n)) (b:bool), + two_compl_value (S n) (Bcons b (S n) bv) = + (bit_value b + 2 * two_compl_value n bv)%Z. Proof. - Intros; Auto. -Save. + intros; auto. +Qed. -Lemma Z_to_two_compl_Sn : (n:nat) (b:bool) (z:Z) - (Z_to_two_compl (S n) `(bit_value b) + 2*z`) = - (Bcons b (S n) (Z_to_two_compl n z)). +Lemma Z_to_two_compl_Sn : + forall (n:nat) (b:bool) (z:Z), + Z_to_two_compl (S n) (bit_value b + 2 * z) = + Bcons b (S n) (Z_to_two_compl n z). Proof. - NewDestruct b; NewDestruct z as [|p|p]; Auto. - NewDestruct p as [p|p|]; Auto. - NewDestruct p as [p|p|]; Simpl; Auto. - Intros; Rewrite (add_un_double_moins_un_xO p); Trivial. -Save. - -Lemma Z_to_binary_Sn_z : (n:nat) (z:Z) - (Z_to_binary (S n) z)=(Bcons (Zodd_bool z) n (Z_to_binary n (Zdiv2 z))). + destruct b; destruct z as [| p| p]; auto. + destruct p as [p| p| ]; auto. + destruct p as [p| p| ]; simpl in |- *; auto. + intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial. +Qed. + +Lemma Z_to_binary_Sn_z : + forall (n:nat) (z:Z), + Z_to_binary (S n) z = + Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)). Proof. - Intros; Auto. -Save. + intros; auto. +Qed. -Lemma Z_div2_value : (z:Z) - ` z>=0 `-> - `(bit_value (Zodd_bool z))+2*(Zdiv2 z) = z`. +Lemma Z_div2_value : + forall z:Z, + (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z. Proof. - NewDestruct z as [|p|p]; Auto. - NewDestruct p; Auto. - Intro H; Elim H; Trivial. -Save. + destruct z as [| p| p]; auto. + destruct p; auto. + intro H; elim H; trivial. +Qed. -Lemma Zdiv2_pos : (z:Z) - ` z >= 0 ` -> - `(Zdiv2 z) >= 0 `. +Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z. Proof. - NewDestruct z as [|p|p]. - Auto. + destruct z as [| p| p]. + auto. - NewDestruct p; Auto. - Simpl; Intros; Omega. + destruct p; auto. + simpl in |- *; intros; omega. - Intro H; Elim H; Trivial. + intro H; elim H; trivial. -Save. +Qed. -Lemma Zdiv2_two_power_nat : (z:Z) (n:nat) - ` z >= 0 ` -> - ` z < (two_power_nat (S n)) ` -> - `(Zdiv2 z) < (two_power_nat n) `. +Lemma Zdiv2_two_power_nat : + forall (z:Z) (n:nat), + (z >= 0)%Z -> + (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z. Proof. - Intros. - Cut (Zlt (Zmult `2` (Zdiv2 z)) (Zmult `2` (two_power_nat n))); Intros. - Omega. + intros. + cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros. + omega. - Rewrite <- two_power_nat_S. - NewDestruct (Zeven_odd_dec z); Intros. - Rewrite <- Zeven_div2; Auto. + rewrite <- two_power_nat_S. + destruct (Zeven.Zeven_odd_dec z); intros. + rewrite <- Zeven.Zeven_div2; auto. - Generalize (Zodd_div2 z H z0); Omega. -Save. + generalize (Zeven.Zodd_div2 z H z0); omega. +Qed. (* @@ -299,54 +301,54 @@ Proof. Save. *) -Lemma Z_to_two_compl_Sn_z : (n:nat) (z:Z) - (Z_to_two_compl (S n) z)=(Bcons (Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z))). +Lemma Z_to_two_compl_Sn_z : + forall (n:nat) (z:Z), + Z_to_two_compl (S n) z = + Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)). Proof. - Intros; Auto. -Save. + intros; auto. +Qed. -Lemma Zeven_bit_value : (z:Z) - (Zeven z) -> - `(bit_value (Zodd_bool z))=0`. +Lemma Zeven_bit_value : + forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z. Proof. - NewDestruct z; Unfold bit_value; Auto. - NewDestruct p; Tauto Orelse (Intro H; Elim H). - NewDestruct p; Tauto Orelse (Intro H; Elim H). -Save. + destruct z; unfold bit_value in |- *; auto. + destruct p; tauto || (intro H; elim H). + destruct p; tauto || (intro H; elim H). +Qed. -Lemma Zodd_bit_value : (z:Z) - (Zodd z) -> - `(bit_value (Zodd_bool z))=1`. +Lemma Zodd_bit_value : + forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z. Proof. - NewDestruct z; Unfold bit_value; Auto. - Intros; Elim H. - NewDestruct p; Tauto Orelse (Intros; Elim H). - NewDestruct p; Tauto Orelse (Intros; Elim H). -Save. - -Lemma Zge_minus_two_power_nat_S : (n:nat) (z:Z) - `z >= (-(two_power_nat (S n)))`-> - `(Zmod2 z) >= (-(two_power_nat n))`. + destruct z; unfold bit_value in |- *; auto. + intros; elim H. + destruct p; tauto || (intros; elim H). + destruct p; tauto || (intros; elim H). +Qed. + +Lemma Zge_minus_two_power_nat_S : + forall (n:nat) (z:Z), + (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z. Proof. - Intros n z; Rewrite (two_power_nat_S n). - Generalize (Zmod2_twice z). - NewDestruct (Zeven_odd_dec z) as [H|H]. - Rewrite (Zeven_bit_value z H); Intros; Omega. + intros n z; rewrite (two_power_nat_S n). + generalize (Zmod2_twice z). + destruct (Zeven.Zeven_odd_dec z) as [H| H]. + rewrite (Zeven_bit_value z H); intros; omega. - Rewrite (Zodd_bit_value z H); Intros; Omega. -Save. + rewrite (Zodd_bit_value z H); intros; omega. +Qed. -Lemma Zlt_two_power_nat_S : (n:nat) (z:Z) - `z < (two_power_nat (S n))`-> - `(Zmod2 z) < (two_power_nat n)`. +Lemma Zlt_two_power_nat_S : + forall (n:nat) (z:Z), + (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z. Proof. - Intros n z; Rewrite (two_power_nat_S n). - Generalize (Zmod2_twice z). - NewDestruct (Zeven_odd_dec z) as [H|H]. - Rewrite (Zeven_bit_value z H); Intros; Omega. + intros n z; rewrite (two_power_nat_S n). + generalize (Zmod2_twice z). + destruct (Zeven.Zeven_odd_dec z) as [H| H]. + rewrite (Zeven_bit_value z H); intros; omega. - Rewrite (Zodd_bit_value z H); Intros; Omega. -Save. + rewrite (Zodd_bit_value z H); intros; omega. +Qed. End Z_BRIC_A_BRAC. @@ -358,68 +360,67 @@ réciproques l'une de l'autre. Elles utilisent les lemmes du bric-a-brac. *) -Lemma binary_to_Z_to_binary : (n:nat) (bv : (Bvector n)) - (Z_to_binary n (binary_value n bv))=bv. +Lemma binary_to_Z_to_binary : + forall (n:nat) (bv:Bvector n), Z_to_binary n (binary_value n bv) = bv. Proof. - NewInduction bv as [|a n bv IHbv]. - Auto. + induction bv as [| a n bv IHbv]. + auto. - Rewrite binary_value_Sn. - Rewrite Z_to_binary_Sn. - Rewrite IHbv; Trivial. + rewrite binary_value_Sn. + rewrite Z_to_binary_Sn. + rewrite IHbv; trivial. - Apply binary_value_pos. -Save. + apply binary_value_pos. +Qed. -Lemma two_compl_to_Z_to_two_compl : (n:nat) (bv : (Bvector n)) (b:bool) - (Z_to_two_compl n (two_compl_value n (Bcons b n bv)))= - (Bcons b n bv). +Lemma two_compl_to_Z_to_two_compl : + forall (n:nat) (bv:Bvector n) (b:bool), + Z_to_two_compl n (two_compl_value n (Bcons b n bv)) = Bcons b n bv. Proof. - NewInduction bv as [|a n bv IHbv]; Intro b. - NewDestruct b; Auto. - - Rewrite two_compl_value_Sn. - Rewrite Z_to_two_compl_Sn. - Rewrite IHbv; Trivial. -Save. - -Lemma Z_to_binary_to_Z : (n:nat) (z : Z) - `z >= 0 `-> - `z < (two_power_nat n) `-> - (binary_value n (Z_to_binary n z))=z. + induction bv as [| a n bv IHbv]; intro b. + destruct b; auto. + + rewrite two_compl_value_Sn. + rewrite Z_to_two_compl_Sn. + rewrite IHbv; trivial. +Qed. + +Lemma Z_to_binary_to_Z : + forall (n:nat) (z:Z), + (z >= 0)%Z -> + (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z. Proof. - NewInduction n as [|n IHn]. - Unfold two_power_nat shift_nat; Simpl; Intros; Omega. + induction n as [| n IHn]. + unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega. - Intros; Rewrite Z_to_binary_Sn_z. - Rewrite binary_value_Sn. - Rewrite IHn. - Apply Z_div2_value; Auto. + intros; rewrite Z_to_binary_Sn_z. + rewrite binary_value_Sn. + rewrite IHn. + apply Z_div2_value; auto. - Apply Zdiv2_pos; Trivial. + apply Pdiv2; trivial. - Apply Zdiv2_two_power_nat; Trivial. -Save. + apply Zdiv2_two_power_nat; trivial. +Qed. -Lemma Z_to_two_compl_to_Z : (n:nat) (z : Z) - `z >= -(two_power_nat n) `-> - `z < (two_power_nat n) `-> - (two_compl_value n (Z_to_two_compl n z))=z. +Lemma Z_to_two_compl_to_Z : + forall (n:nat) (z:Z), + (z >= - two_power_nat n)%Z -> + (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z. Proof. - NewInduction n as [|n IHn]. - Unfold two_power_nat shift_nat; Simpl; Intros. - Assert `z=-1`\/`z=0`. Omega. -Intuition; Subst z; Trivial. + induction n as [| n IHn]. + unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros. + assert (z = (-1)%Z \/ z = 0%Z). omega. +intuition; subst z; trivial. - Intros; Rewrite Z_to_two_compl_Sn_z. - Rewrite two_compl_value_Sn. - Rewrite IHn. - Generalize (Zmod2_twice z); Omega. + intros; rewrite Z_to_two_compl_Sn_z. + rewrite two_compl_value_Sn. + rewrite IHn. + generalize (Zmod2_twice z); omega. - Apply Zge_minus_two_power_nat_S; Auto. + apply Zge_minus_two_power_nat_S; auto. - Apply Zlt_two_power_nat_S; Auto. -Save. + apply Zlt_two_power_nat_S; auto. +Qed. End COHERENT_VALUE. - diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v index fcbdd1141..a95218b63 100644 --- a/theories/ZArith/Zbool.v +++ b/theories/ZArith/Zbool.v @@ -8,151 +8,179 @@ (* $Id$ *) -Require BinInt. -Require Zeven. -Require Zorder. -Require Zcompare. -Require ZArith_dec. -Require Zsyntax. -Require Sumbool. +Require Import BinInt. +Require Import Zeven. +Require Import Zorder. +Require Import Zcompare. +Require Import ZArith_dec. +Require Import Sumbool. (** The decidability of equality and order relations over type [Z] give some boolean functions with the adequate specification. *) -Definition Z_lt_ge_bool := [x,y:Z](bool_of_sumbool (Z_lt_ge_dec x y)). -Definition Z_ge_lt_bool := [x,y:Z](bool_of_sumbool (Z_ge_lt_dec x y)). +Definition Z_lt_ge_bool (x y:Z) := bool_of_sumbool (Z_lt_ge_dec x y). +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_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_noteq_bool := [x,y:Z](bool_of_sumbool (Z_noteq_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)). +Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x). (**********************************************************************) (** Boolean comparisons of binary integers *) -Definition Zle_bool := - [x,y:Z]Cases `x ?= y` of SUPERIEUR => false | _ => true end. -Definition Zge_bool := - [x,y:Z]Cases `x ?= y` of INFERIEUR => false | _ => true end. -Definition Zlt_bool := - [x,y:Z]Cases `x ?= y` of INFERIEUR => true | _ => false end. -Definition Zgt_bool := - [x,y:Z]Cases ` x ?= y` of SUPERIEUR => true | _ => false end. -Definition Zeq_bool := - [x,y:Z]Cases `x ?= y` of EGAL => true | _ => false end. -Definition Zneq_bool := - [x,y:Z]Cases `x ?= y` of EGAL => false | _ => true end. - -Lemma Zle_cases : (x,y:Z)if (Zle_bool x y) then `x<=y` else `x>y`. +Definition Zle_bool (x y:Z) := + match (x ?= y)%Z with + | Gt => false + | _ => true + end. +Definition Zge_bool (x y:Z) := + match (x ?= y)%Z with + | Lt => false + | _ => true + end. +Definition Zlt_bool (x y:Z) := + match (x ?= y)%Z with + | Lt => true + | _ => false + end. +Definition Zgt_bool (x y:Z) := + match (x ?= y)%Z with + | Gt => true + | _ => false + end. +Definition Zeq_bool (x y:Z) := + match (x ?= y)%Z with + | Eq => true + | _ => false + end. +Definition Zneq_bool (x y:Z) := + match (x ?= y)%Z with + | Eq => false + | _ => true + end. + +Lemma Zle_cases : + forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z. Proof. -Intros x y; Unfold Zle_bool Zle Zgt. -Case (Zcompare x y); Auto; Discriminate. +intros x y; unfold Zle_bool, Zle, Zgt in |- *. +case (x ?= y)%Z; auto; discriminate. Qed. -Lemma Zlt_cases : (x,y:Z)if (Zlt_bool x y) then `x<y` else `x>=y`. +Lemma Zlt_cases : + forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z. Proof. -Intros x y; Unfold Zlt_bool Zlt Zge. -Case (Zcompare x y); Auto; Discriminate. +intros x y; unfold Zlt_bool, Zlt, Zge in |- *. +case (x ?= y)%Z; auto; discriminate. Qed. -Lemma Zge_cases : (x,y:Z)if (Zge_bool x y) then `x>=y` else `x<y`. +Lemma Zge_cases : + forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z. Proof. -Intros x y; Unfold Zge_bool Zge Zlt. -Case (Zcompare x y); Auto; Discriminate. +intros x y; unfold Zge_bool, Zge, Zlt in |- *. +case (x ?= y)%Z; auto; discriminate. Qed. -Lemma Zgt_cases : (x,y:Z)if (Zgt_bool x y) then `x>y` else `x<=y`. +Lemma Zgt_cases : + forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z. Proof. -Intros x y; Unfold Zgt_bool Zgt Zle. -Case (Zcompare x y); Auto; Discriminate. +intros x y; unfold Zgt_bool, Zgt, Zle in |- *. +case (x ?= y)%Z; auto; discriminate. Qed. (** Lemmas on [Zle_bool] used in contrib/graphs *) -Lemma Zle_bool_imp_le : (x,y:Z) (Zle_bool x y)=true -> (Zle x y). +Lemma Zle_bool_imp_le : forall n m:Z, Zle_bool n m = true -> (n <= m)%Z. Proof. - Unfold Zle_bool Zle. Intros x y. Unfold not. - Case (Zcompare x y); Intros; Discriminate. + unfold Zle_bool, Zle in |- *. intros x y. unfold not in |- *. + case (x ?= y)%Z; intros; discriminate. Qed. -Lemma Zle_imp_le_bool : (x,y:Z) (Zle x y) -> (Zle_bool x y)=true. +Lemma Zle_imp_le_bool : forall n m:Z, (n <= m)%Z -> Zle_bool n m = true. Proof. - Unfold Zle Zle_bool. Intros x y. Case (Zcompare x y); Trivial. Intro. Elim (H (refl_equal ? ?)). + unfold Zle, Zle_bool in |- *. intros x y. case (x ?= y)%Z; trivial. intro. elim (H (refl_equal _)). Qed. -Lemma Zle_bool_refl : (x:Z) (Zle_bool x x)=true. +Lemma Zle_bool_refl : forall n:Z, Zle_bool n n = true. Proof. - Intro. Apply Zle_imp_le_bool. Apply Zle_refl. Reflexivity. + intro. apply Zle_imp_le_bool. apply Zeq_le. reflexivity. Qed. -Lemma Zle_bool_antisym : (x,y:Z) (Zle_bool x y)=true -> (Zle_bool y x)=true -> x=y. +Lemma Zle_bool_antisym : + forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m. Proof. - Intros. Apply Zle_antisym. Apply Zle_bool_imp_le. Assumption. - Apply Zle_bool_imp_le. Assumption. + intros. apply Zle_antisym. apply Zle_bool_imp_le. assumption. + apply Zle_bool_imp_le. assumption. Qed. -Lemma Zle_bool_trans : (x,y,z:Z) (Zle_bool x y)=true -> (Zle_bool y z)=true -> (Zle_bool x z)=true. +Lemma Zle_bool_trans : + forall n m p:Z, + Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true. Proof. - Intros x y z; Intros. Apply Zle_imp_le_bool. Apply Zle_trans with m:=y. Apply Zle_bool_imp_le. Assumption. - Apply Zle_bool_imp_le. Assumption. + intros x y z; intros. apply Zle_imp_le_bool. apply Zle_trans with (m := y). apply Zle_bool_imp_le. assumption. + apply Zle_bool_imp_le. assumption. Qed. -Definition Zle_bool_total : (x,y:Z) {(Zle_bool x y)=true}+{(Zle_bool y x)=true}. +Definition Zle_bool_total : + forall x y:Z, {Zle_bool x y = true} + {Zle_bool y x = true}. Proof. - Intros x y; Intros. Unfold Zle_bool. Cut (Zcompare x y)=SUPERIEUR<->(Zcompare y x)=INFERIEUR. - Case (Zcompare x y). Left . Reflexivity. - Left . Reflexivity. - Right . Rewrite (proj1 ? ? H (refl_equal ? ?)). Reflexivity. - Apply Zcompare_ANTISYM. + intros x y; intros. unfold Zle_bool in |- *. cut ((x ?= y)%Z = Gt <-> (y ?= x)%Z = Lt). + case (x ?= y)%Z. left. reflexivity. + left. reflexivity. + right. rewrite (proj1 H (refl_equal _)). reflexivity. + apply Zcompare_Gt_Lt_antisym. Defined. -Lemma Zle_bool_plus_mono : (x,y,z,t:Z) (Zle_bool x y)=true -> (Zle_bool z t)=true -> - (Zle_bool (Zplus x z) (Zplus y t))=true. +Lemma Zle_bool_plus_mono : + forall n m p q:Z, + Zle_bool n m = true -> + Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true. Proof. - Intros. Apply Zle_imp_le_bool. Apply Zle_plus_plus. Apply Zle_bool_imp_le. Assumption. - Apply Zle_bool_imp_le. Assumption. + intros. apply Zle_imp_le_bool. apply Zplus_le_compat. apply Zle_bool_imp_le. assumption. + apply Zle_bool_imp_le. assumption. Qed. -Lemma Zone_pos : (Zle_bool `1` `0`)=false. +Lemma Zone_pos : Zle_bool 1 0 = false. Proof. - Reflexivity. + reflexivity. Qed. -Lemma Zone_min_pos : (x:Z) (Zle_bool x `0`)=false -> (Zle_bool `1` x)=true. +Lemma Zone_min_pos : forall n:Z, Zle_bool n 0 = false -> Zle_bool 1 n = true. Proof. - Intros x; Intros. Apply Zle_imp_le_bool. Change (Zle (Zs ZERO) x). Apply Zgt_le_S. Generalize H. - Unfold Zle_bool Zgt. Case (Zcompare x ZERO). Intro H0. Discriminate H0. - Intro H0. Discriminate H0. - Reflexivity. + intros x; intros. apply Zle_imp_le_bool. change (Zsucc 0 <= x)%Z in |- *. apply Zgt_le_succ. generalize H. + unfold Zle_bool, Zgt in |- *. case (x ?= 0)%Z. intro H0. discriminate H0. + intro H0. discriminate H0. + reflexivity. Qed. - Lemma Zle_is_le_bool : (x,y:Z) (Zle x y) <-> (Zle_bool x y)=true. + Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true. Proof. - Intros. Split. Intro. Apply Zle_imp_le_bool. Assumption. - Intro. Apply Zle_bool_imp_le. Assumption. + intros. split. intro. apply Zle_imp_le_bool. assumption. + intro. apply Zle_bool_imp_le. assumption. Qed. - Lemma Zge_is_le_bool : (x,y:Z) (Zge x y) <-> (Zle_bool y x)=true. + Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true. Proof. - Intros. Split. Intro. Apply Zle_imp_le_bool. Apply Zge_le. Assumption. - Intro. Apply Zle_ge. Apply Zle_bool_imp_le. Assumption. + intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption. + intro. apply Zle_ge. apply Zle_bool_imp_le. assumption. Qed. - Lemma Zlt_is_le_bool : (x,y:Z) (Zlt x y) <-> (Zle_bool x `y-1`)=true. + Lemma Zlt_is_le_bool : + forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true. Proof. - Intros x y. Split. Intro. Apply Zle_imp_le_bool. Apply Zlt_n_Sm_le. Rewrite (Zs_pred y) in H. - Assumption. - Intro. Rewrite (Zs_pred y). Apply Zle_lt_n_Sm. Apply Zle_bool_imp_le. Assumption. + intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H. + assumption. + intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption. Qed. - Lemma Zgt_is_le_bool : (x,y:Z) (Zgt x y) <-> (Zle_bool y `x-1`)=true. + Lemma Zgt_is_le_bool : + forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true. Proof. - Intros x y. Apply iff_trans with `y < x`. Split. Exact (Zgt_lt x y). - Exact (Zlt_gt y x). - Exact (Zlt_is_le_bool y x). + intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y). + exact (Zlt_gt y x). + exact (Zlt_is_le_bool y x). Qed. - diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 2383e90cb..f7015089c 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -10,11 +10,10 @@ Require Export BinPos. Require Export BinInt. -Require Zsyntax. -Require Lt. -Require Gt. -Require Plus. -Require Mult. +Require Import Lt. +Require Import Gt. +Require Import Plus. +Require Import Mult. Open Local Scope Z_scope. @@ -25,456 +24,478 @@ Open Local Scope Z_scope. (**********************************************************************) (** Comparison on integers *) -Lemma Zcompare_x_x : (x:Z) (Zcompare x x) = EGAL. +Lemma Zcompare_refl : forall n:Z, (n ?= n) = Eq. Proof. -Intro x; NewDestruct x as [|p|p]; Simpl; [ Reflexivity | Apply convert_compare_EGAL - | Rewrite convert_compare_EGAL; Reflexivity ]. +intro x; destruct x as [| p| p]; simpl in |- *; + [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ]. Qed. -Lemma Zcompare_EGAL_eq : (x,y:Z) (Zcompare x y) = EGAL -> x = y. +Lemma Zcompare_Eq_eq : forall n m:Z, (n ?= m) = Eq -> n = m. Proof. -Intros x y; NewDestruct x as [|x'|x'];NewDestruct y as [|y'|y'];Simpl;Intro H; Reflexivity Orelse Try Discriminate H; [ - Rewrite (compare_convert_EGAL x' y' H); Reflexivity - | Rewrite (compare_convert_EGAL x' y'); [ - Reflexivity - | NewDestruct (compare x' y' EGAL); - Reflexivity Orelse Discriminate]]. +intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *; + intro H; reflexivity || (try discriminate H); + [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity + | rewrite (Pcompare_Eq_eq x' y'); + [ reflexivity + | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ]. Qed. -Lemma Zcompare_EGAL : (x,y:Z) (Zcompare x y) = EGAL <-> x = y. +Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m. Proof. -Intros x y;Split; Intro E; [ Apply Zcompare_EGAL_eq; Assumption - | Rewrite E; Apply Zcompare_x_x ]. +intros x y; split; intro E; + [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ]. Qed. -Lemma Zcompare_antisym : - (x,y:Z)(Op (Zcompare x y)) = (Zcompare y x). +Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n). Proof. -Intros x y; NewDestruct x; NewDestruct y; Simpl; - Reflexivity Orelse Discriminate H Orelse - Rewrite Pcompare_antisym; Reflexivity. +intros x y; destruct x; destruct y; simpl in |- *; + reflexivity || discriminate H || rewrite Pcompare_antisym; + reflexivity. Qed. -Lemma Zcompare_ANTISYM : - (x,y:Z) (Zcompare x y) = SUPERIEUR <-> (Zcompare y x) = INFERIEUR. +Lemma Zcompare_Gt_Lt_antisym : forall n m:Z, (n ?= m) = Gt <-> (m ?= n) = Lt. Proof. -Intros x y; Split; Intro H; [ - Change INFERIEUR with (Op SUPERIEUR); - Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity -| Change SUPERIEUR with (Op INFERIEUR); - Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity ]. +intros x y; split; intro H; + [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym; + rewrite H; reflexivity + | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym; + rewrite H; reflexivity ]. Qed. (** Transitivity of comparison *) -Lemma Zcompare_trans_SUPERIEUR : - (x,y,z:Z) (Zcompare x y) = SUPERIEUR -> - (Zcompare y z) = SUPERIEUR -> - (Zcompare x z) = SUPERIEUR. +Lemma Zcompare_Gt_trans : + forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt. Proof. -Intros x y z;Case x;Case y;Case z; Simpl; -Try (Intros; Discriminate H Orelse Discriminate H0); -Auto with arith; [ - Intros p q r H H0;Apply convert_compare_SUPERIEUR; Unfold gt; - Apply lt_trans with m:=(convert q); - Apply compare_convert_INFERIEUR;Apply ZC1;Assumption -| Intros p q r; Do 3 Rewrite <- ZC4; Intros H H0; - Apply convert_compare_SUPERIEUR;Unfold gt;Apply lt_trans with m:=(convert q); - Apply compare_convert_INFERIEUR;Apply ZC1;Assumption ]. +intros x y z; case x; case y; case z; simpl in |- *; + try (intros; discriminate H || discriminate H0); auto with arith; + [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P q); + apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption + | intros p q r; do 3 rewrite <- ZC4; intros H H0; + apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P q); + apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption ]. Qed. (** Comparison and opposite *) -Lemma Zcompare_Zopp : - (x,y:Z) (Zcompare x y) = (Zcompare (Zopp y) (Zopp x)). +Lemma Zcompare_opp : forall n m:Z, (n ?= m) = (- m ?= - n). Proof. -(Intros x y;Case x;Case y;Simpl;Auto with arith); -Intros;Rewrite <- ZC4;Trivial with arith. +intros x y; case x; case y; simpl in |- *; auto with arith; intros; + rewrite <- ZC4; trivial with arith. Qed. -Hints Local Resolve convert_compare_EGAL. +Hint Local Resolve Pcompare_refl. (** Comparison first-order specification *) -Lemma SUPERIEUR_POS : - (x,y:Z) (Zcompare x y) = SUPERIEUR -> - (EX h:positive |(Zplus x (Zopp y)) = (POS h)). +Lemma Zcompare_Gt_spec : + forall n m:Z, (n ?= m) = Gt -> exists h : positive | n + - m = Zpos h. Proof. -Intros x y;Case x;Case y; [ - Simpl; Intros H; Discriminate H -| Simpl; Intros p H; Discriminate H -| Intros p H; Exists p; Simpl; Auto with arith -| Intros p H; Exists p; Simpl; Auto with arith -| Intros q p H; Exists (true_sub p q); Unfold Zplus Zopp; - Unfold Zcompare in H; Rewrite H; Trivial with arith -| Intros q p H; Exists (add p q); Simpl; Trivial with arith -| Simpl; Intros p H; Discriminate H -| Simpl; Intros q p H; Discriminate H -| Unfold Zcompare; Intros q p; Rewrite <- ZC4; Intros H; Exists (true_sub q p); - Simpl; Rewrite (ZC1 q p H); Trivial with arith]. +intros x y; case x; case y; + [ simpl in |- *; intros H; discriminate H + | simpl in |- *; intros p H; discriminate H + | intros p H; exists p; simpl in |- *; auto with arith + | intros p H; exists p; simpl in |- *; auto with arith + | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *; + unfold Zcompare in H; rewrite H; trivial with arith + | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith + | simpl in |- *; intros p H; discriminate H + | simpl in |- *; intros q p H; discriminate H + | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H; + exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H); + trivial with arith ]. Qed. (** Comparison and addition *) -Lemma weaken_Zcompare_Zplus_compatible : - ((n,m:Z) (p:positive) - (Zcompare (Zplus (POS p) n) (Zplus (POS p) m)) = (Zcompare n m)) -> - (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y). +Lemma weaken_Zcompare_Zplus_compatible : + (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) -> + forall n m p:Z, (p + n ?= p + m) = (n ?= m). Proof. -Intros H x y z; NewDestruct z; [ - Reflexivity -| Apply H -| Rewrite (Zcompare_Zopp x y); Rewrite Zcompare_Zopp; - Do 2 Rewrite Zopp_Zplus; Rewrite Zopp_NEG; Apply H ]. +intros H x y z; destruct z; + [ reflexivity + | apply H + | rewrite (Zcompare_opp x y); rewrite Zcompare_opp; + do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; + apply H ]. Qed. -Hints Local Resolve ZC4. +Hint Local Resolve ZC4. -Lemma weak_Zcompare_Zplus_compatible : - (x,y:Z) (z:positive) - (Zcompare (Zplus (POS z) x) (Zplus (POS z) y)) = (Zcompare x y). +Lemma weak_Zcompare_Zplus_compatible : + forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m). Proof. -Intros x y z;Case x;Case y;Simpl;Auto with arith; [ - Intros p;Apply convert_compare_INFERIEUR; Apply ZL17 -| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith; - Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [ Unfold gt ; - Apply ZL16 | Assumption ] -| Intros p;ElimPcompare z p; - Intros E;Auto with arith; Apply convert_compare_SUPERIEUR; - Unfold gt;Apply ZL17 -| Intros p q; - ElimPcompare q p; - Intros E;Rewrite E;[ - Rewrite (compare_convert_EGAL q p E); Apply convert_compare_EGAL - | Apply convert_compare_INFERIEUR;Do 2 Rewrite convert_add;Apply lt_reg_l; - Apply compare_convert_INFERIEUR with 1:=E - | Apply convert_compare_SUPERIEUR;Unfold gt ;Do 2 Rewrite convert_add; - Apply lt_reg_l;Exact (compare_convert_SUPERIEUR q p E) ] -| Intros p q; - ElimPcompare z p; - Intros E;Rewrite E;Auto with arith; - Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [ - Unfold gt; Apply lt_trans with m:=(convert z); [Apply ZL16 | Apply ZL17] - | Assumption ] -| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith; Simpl; - Apply convert_compare_INFERIEUR;Rewrite true_sub_convert;[Apply ZL16| - Assumption] -| Intros p q; - ElimPcompare z q; - Intros E;Rewrite E;Auto with arith; Simpl;Apply convert_compare_INFERIEUR; - Rewrite true_sub_convert;[ - Apply lt_trans with m:=(convert z) ;[Apply ZL16|Apply ZL17] - | Assumption] -| Intros p q; ElimPcompare z q; Intros E0;Rewrite E0; - ElimPcompare z p; Intros E1;Rewrite E1; ElimPcompare q p; - Intros E2;Rewrite E2;Auto with arith; [ - Absurd (compare q p EGAL)=INFERIEUR; [ - Rewrite <- (compare_convert_EGAL z q E0); - Rewrite <- (compare_convert_EGAL z p E1); - Rewrite (convert_compare_EGAL z); Discriminate - | Assumption ] - | Absurd (compare q p EGAL)=SUPERIEUR; [ - Rewrite <- (compare_convert_EGAL z q E0); - Rewrite <- (compare_convert_EGAL z p E1); - Rewrite (convert_compare_EGAL z);Discriminate - | Assumption] - | Absurd (compare z p EGAL)=INFERIEUR; [ - Rewrite (compare_convert_EGAL z q E0); - Rewrite <- (compare_convert_EGAL q p E2); - Rewrite (convert_compare_EGAL q);Discriminate - | Assumption ] - | Absurd (compare z p EGAL)=INFERIEUR; [ - Rewrite (compare_convert_EGAL z q E0); Rewrite E2;Discriminate - | Assumption] - | Absurd (compare z p EGAL)=SUPERIEUR;[ - Rewrite (compare_convert_EGAL z q E0); - Rewrite <- (compare_convert_EGAL q p E2); - Rewrite (convert_compare_EGAL q);Discriminate - | Assumption] - | Absurd (compare z p EGAL)=SUPERIEUR;[ - Rewrite (compare_convert_EGAL z q E0);Rewrite E2;Discriminate - | Assumption] - | Absurd (compare z q EGAL)=INFERIEUR;[ - Rewrite (compare_convert_EGAL z p E1); - Rewrite (compare_convert_EGAL q p E2); - Rewrite (convert_compare_EGAL p); Discriminate - | Assumption] - | Absurd (compare p q EGAL)=SUPERIEUR; [ - Rewrite <- (compare_convert_EGAL z p E1); - Rewrite E0; Discriminate - | Apply ZC2;Assumption ] - | Simpl; Rewrite (compare_convert_EGAL q p E2); - Rewrite (convert_compare_EGAL (true_sub p z)); Auto with arith - | Simpl; Rewrite <- ZC4; Apply convert_compare_SUPERIEUR; - Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Unfold gt; Apply simpl_lt_plus_l with p:=(convert z); - Rewrite le_plus_minus_r; [ - Rewrite le_plus_minus_r; [ - Apply compare_convert_INFERIEUR;Assumption - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ] - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ] - | Apply ZC2;Assumption ] - | Apply ZC2;Assumption ] - | Simpl; Rewrite <- ZC4; Apply convert_compare_INFERIEUR; - Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Apply simpl_lt_plus_l with p:=(convert z); - Rewrite le_plus_minus_r; [ - Rewrite le_plus_minus_r; [ - Apply compare_convert_INFERIEUR;Apply ZC1;Assumption - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ] - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ] - | Apply ZC2;Assumption] - | Apply ZC2;Assumption ] - | Absurd (compare z q EGAL)=INFERIEUR; [ - Rewrite (compare_convert_EGAL q p E2);Rewrite E1;Discriminate - | Assumption ] - | Absurd (compare q p EGAL)=INFERIEUR; [ - Cut (compare q p EGAL)=SUPERIEUR; [ - Intros E;Rewrite E;Discriminate - | Apply convert_compare_SUPERIEUR; Unfold gt; - Apply lt_trans with m:=(convert z); [ - Apply compare_convert_INFERIEUR;Apply ZC1;Assumption - | Apply compare_convert_INFERIEUR;Assumption ]] - | Assumption ] - | Absurd (compare z q EGAL)=SUPERIEUR; [ - Rewrite (compare_convert_EGAL z p E1); - Rewrite (compare_convert_EGAL q p E2); - Rewrite (convert_compare_EGAL p); Discriminate - | Assumption ] - | Absurd (compare z q EGAL)=SUPERIEUR; [ - Rewrite (compare_convert_EGAL z p E1); - Rewrite ZC1; [Discriminate | Assumption ] - | Assumption ] - | Absurd (compare z q EGAL)=SUPERIEUR; [ - Rewrite (compare_convert_EGAL q p E2); Rewrite E1; Discriminate - | Assumption ] - | Absurd (compare q p EGAL)=SUPERIEUR; [ - Rewrite ZC1; [ - Discriminate - | Apply convert_compare_SUPERIEUR; Unfold gt; - Apply lt_trans with m:=(convert z); [ - Apply compare_convert_INFERIEUR;Apply ZC1;Assumption - | Apply compare_convert_INFERIEUR;Assumption ]] - | Assumption ] - | Simpl; Rewrite (compare_convert_EGAL q p E2); Apply convert_compare_EGAL - | Simpl; Apply convert_compare_SUPERIEUR; Unfold gt; - Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Apply simpl_lt_plus_l with p:=(convert p); Rewrite le_plus_minus_r; [ - Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert q); - Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [ - Rewrite (plus_sym (convert q)); Apply lt_reg_l; - Apply compare_convert_INFERIEUR;Assumption - | Apply lt_le_weak; Apply compare_convert_INFERIEUR; - Apply ZC1;Assumption ] - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; - Assumption ] - | Assumption ] - | Assumption ] - | Simpl; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [ - Rewrite true_sub_convert; [ - Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [ - Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p); - Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [ - Rewrite (plus_sym (convert p)); Apply lt_reg_l; - Apply compare_convert_INFERIEUR;Apply ZC1;Assumption - | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; - Assumption ] - | Apply lt_le_weak;Apply compare_convert_INFERIEUR;Apply ZC1;Assumption] - | Assumption] - | Assumption]]]. +intros x y z; case x; case y; simpl in |- *; auto with arith; + [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17 + | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith; + apply nat_of_P_gt_Gt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply ZL16 | assumption ] + | intros p; ElimPcompare z p; intros E; auto with arith; + apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply ZL17 + | intros p q; ElimPcompare q p; intros E; rewrite E; + [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl + | apply nat_of_P_lt_Lt_compare_complement_morphism; + do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism with (1 := E) + | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; + do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l; + exact (nat_of_P_gt_Gt_compare_morphism q p E) ] + | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith; + apply nat_of_P_gt_Gt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z); + [ apply ZL16 | apply ZL17 ] + | assumption ] + | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith; + simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ] + | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith; + simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ] + | assumption ] + | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p; + intros E1; rewrite E1; ElimPcompare q p; intros E2; + rewrite E2; auto with arith; + [ absurd ((q ?= p)%positive Eq = Lt); + [ rewrite <- (Pcompare_Eq_eq z q E0); + rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z); + discriminate + | assumption ] + | absurd ((q ?= p)%positive Eq = Gt); + [ rewrite <- (Pcompare_Eq_eq z q E0); + rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z); + discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl q); discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl q); discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate + | assumption ] + | absurd ((z ?= q)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl p); discriminate + | assumption ] + | absurd ((p ?= q)%positive Eq = Gt); + [ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate + | apply ZC2; assumption ] + | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl (p - z)); auto with arith + | simpl in |- *; rewrite <- ZC4; + apply nat_of_P_gt_Gt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z); + rewrite le_plus_minus_r; + [ rewrite le_plus_minus_r; + [ apply nat_of_P_lt_Lt_compare_morphism; assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply ZC2; assumption ] + | apply ZC2; assumption ] + | simpl in |- *; rewrite <- ZC4; + apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P z); + rewrite le_plus_minus_r; + [ rewrite le_plus_minus_r; + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply ZC2; assumption ] + | apply ZC2; assumption ] + | absurd ((z ?= q)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate + | assumption ] + | absurd ((q ?= p)%positive Eq = Lt); + [ cut ((q ?= p)%positive Eq = Gt); + [ intros E; rewrite E; discriminate + | apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P z); + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption + | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ] + | assumption ] + | absurd ((z ?= q)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl p); discriminate + | assumption ] + | absurd ((z ?= q)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1; + [ discriminate | assumption ] + | assumption ] + | absurd ((z ?= q)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate + | assumption ] + | absurd ((q ?= p)%positive Eq = Gt); + [ rewrite ZC1; + [ discriminate + | apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P z); + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption + | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ] + | assumption ] + | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl + | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P p); + rewrite le_plus_minus_r; + [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q); + rewrite plus_assoc; rewrite le_plus_minus_r; + [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism; + assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | assumption ] + | assumption ] + | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P q); + rewrite le_plus_minus_r; + [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p); + rewrite plus_assoc; rewrite le_plus_minus_r; + [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | assumption ] + | assumption ] ] ]. Qed. -Lemma Zcompare_Zplus_compatible : - (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y). +Lemma Zcompare_plus_compat : forall n m p:Z, (p + n ?= p + m) = (n ?= m). Proof. -Exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible). +exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible). Qed. -Lemma Zcompare_Zplus_compatible2 : - (r:relation)(x,y,z,t:Z) - (Zcompare x y) = r -> (Zcompare z t) = r -> - (Zcompare (Zplus x z) (Zplus y t)) = r. +Lemma Zplus_compare_compat : + forall (r:comparison) (n m p q:Z), + (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r. Proof. -Intros r x y z t; Case r; [ - Intros H1 H2; Elim (Zcompare_EGAL x y); Elim (Zcompare_EGAL z t); - Intros H3 H4 H5 H6; Rewrite H3; [ - Rewrite H5; [ Elim (Zcompare_EGAL (Zplus y t) (Zplus y t)); Auto with arith | Auto with arith ] - | Auto with arith ] -| Intros H1 H2; Elim (Zcompare_ANTISYM (Zplus y t) (Zplus x z)); - Intros H3 H4; Apply H3; - Apply Zcompare_trans_SUPERIEUR with y:=(Zplus y z) ; [ - Rewrite Zcompare_Zplus_compatible; - Elim (Zcompare_ANTISYM t z); Auto with arith - | Do 2 Rewrite <- (Zplus_sym z); - Rewrite Zcompare_Zplus_compatible; - Elim (Zcompare_ANTISYM y x); Auto with arith] -| Intros H1 H2; - Apply Zcompare_trans_SUPERIEUR with y:=(Zplus x t) ; [ - Rewrite Zcompare_Zplus_compatible; Assumption - | Do 2 Rewrite <- (Zplus_sym t); - Rewrite Zcompare_Zplus_compatible; Assumption]]. +intros r x y z t; case r; + [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t); + intros H3 H4 H5 H6; rewrite H3; + [ rewrite H5; + [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith + | auto with arith ] + | auto with arith ] + | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4; + apply H3; apply Zcompare_Gt_trans with (m := y + z); + [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z); + auto with arith + | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat; + elim (Zcompare_Gt_Lt_antisym y x); auto with arith ] + | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t); + [ rewrite Zcompare_plus_compat; assumption + | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat; + assumption ] ]. Qed. -Lemma Zcompare_Zs_SUPERIEUR : (x:Z)(Zcompare (Zs x) x)=SUPERIEUR. +Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt. Proof. -Intro x; Unfold Zs; Pattern 2 x; Rewrite <- (Zero_right x); -Rewrite Zcompare_Zplus_compatible;Reflexivity. +intro x; unfold Zsucc in |- *; pattern x at 2 in |- *; + rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; + reflexivity. Qed. -Lemma Zcompare_et_un: - (x,y:Z) (Zcompare x y)=SUPERIEUR <-> - ~(Zcompare x (Zplus y (POS xH)))=INFERIEUR. +Lemma Zcompare_Gt_not_Lt : forall n m:Z, (n ?= m) = Gt <-> (n ?= m + 1) <> Lt. Proof. -Intros x y; Split; [ - Intro H; (ElimCompare 'x '(Zplus y (POS xH)));[ - Intro H1; Rewrite H1; Discriminate - | Intros H1; Elim SUPERIEUR_POS with 1:=H; Intros h H2; - Absurd (gt (convert h) O) /\ (lt (convert h) (S O)); [ - Unfold not ;Intros H3;Elim H3;Intros H4 H5; Absurd (gt (convert h) O); [ - Unfold gt ;Apply le_not_lt; Apply le_S_n; Exact H5 - | Assumption] - | Split; [ - Elim (ZL4 h); Intros i H3;Rewrite H3; Apply gt_Sn_O - | Change (lt (convert h) (convert xH)); - Apply compare_convert_INFERIEUR; - Change (Zcompare (POS h) (POS xH))=INFERIEUR; - Rewrite <- H2; Rewrite <- [m,n:Z](Zcompare_Zplus_compatible m n y); - Rewrite (Zplus_sym x);Rewrite Zplus_assoc; Rewrite Zplus_inverse_r; - Simpl; Exact H1 ]] - | Intros H1;Rewrite -> H1;Discriminate ] -| Intros H; (ElimCompare 'x '(Zplus y (POS xH))); [ - Intros H1;Elim (Zcompare_EGAL x (Zplus y (POS xH))); Intros H2 H3; - Rewrite (H2 H1); Exact (Zcompare_Zs_SUPERIEUR y) - | Intros H1;Absurd (Zcompare x (Zplus y (POS xH)))=INFERIEUR;Assumption - | Intros H1; Apply Zcompare_trans_SUPERIEUR with y:=(Zs y); - [ Exact H1 | Exact (Zcompare_Zs_SUPERIEUR y)]]]. +intros x y; split; + [ intro H; elim_compare x (y + 1); + [ intro H1; rewrite H1; discriminate + | intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2; + absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat); + [ unfold not in |- *; intros H3; elim H3; intros H4 H5; + absurd (nat_of_P h > 0)%nat; + [ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5 + | assumption ] + | split; + [ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O + | change (nat_of_P h < nat_of_P 1)%nat in |- *; + apply nat_of_P_lt_Lt_compare_morphism; + change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2; + rewrite <- (fun m n:Z => Zcompare_plus_compat m n y); + rewrite (Zplus_comm x); rewrite Zplus_assoc; + rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ] + | intros H1; rewrite H1; discriminate ] + | intros H; elim_compare x (y + 1); + [ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3; + rewrite (H2 H1); exact (Zcompare_succ_Gt y) + | intros H1; absurd ((x ?= y + 1) = Lt); assumption + | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y); + [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ]. Qed. (** Successor and comparison *) -Lemma Zcompare_n_S : (n,m:Z)(Zcompare (Zs n) (Zs m)) = (Zcompare n m). +Lemma Zcompare_succ_compat : forall n m:Z, (Zsucc n ?= Zsucc m) = (n ?= m). Proof. -Intros n m;Unfold Zs ;Do 2 Rewrite -> [t:Z](Zplus_sym t (POS xH)); -Rewrite -> Zcompare_Zplus_compatible;Auto with arith. +intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1); + rewrite Zcompare_plus_compat; auto with arith. Qed. (** Multiplication and comparison *) -Lemma Zcompare_Zmult_compatible : - (x:positive)(y,z:Z) - (Zcompare (Zmult (POS x) y) (Zmult (POS x) z)) = (Zcompare y z). +Lemma Zcompare_mult_compat : + forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m). Proof. -Intros x; NewInduction x as [p H|p H|]; [ - Intros y z; - Cut (POS (xI p))=(Zplus (Zplus (POS p) (POS p)) (POS xH)); [ - Intros E; Rewrite E; Do 4 Rewrite Zmult_plus_distr_l; - Do 2 Rewrite Zmult_one; - Apply Zcompare_Zplus_compatible2; [ - Apply Zcompare_Zplus_compatible2; Apply H - | Trivial with arith] - | Simpl; Rewrite (add_x_x p); Trivial with arith] -| Intros y z; Cut (POS (xO p))=(Zplus (POS p) (POS p)); [ - Intros E; Rewrite E; Do 2 Rewrite Zmult_plus_distr_l; - Apply Zcompare_Zplus_compatible2; Apply H - | Simpl; Rewrite (add_x_x p); Trivial with arith] - | Intros y z; Do 2 Rewrite Zmult_one; Trivial with arith]. +intros x; induction x as [p H| p H| ]; + [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1); + [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l; + do 2 rewrite Zmult_1_l; apply Zplus_compare_compat; + [ apply Zplus_compare_compat; apply H | trivial with arith ] + | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ] + | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p); + [ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l; + apply Zplus_compare_compat; apply H + | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ] + | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ]. Qed. (** Reverting [x ?= y] to trichotomy *) -Lemma rename : (A:Set)(P:A->Prop)(x:A) ((y:A)(x=y)->(P y)) -> (P x). +Lemma rename : + forall (A:Set) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x. Proof. -Auto with arith. +auto with arith. Qed. Lemma Zcompare_elim : - (c1,c2,c3:Prop)(x,y:Z) - ((x=y) -> c1) ->(`x<y` -> c2) ->(`x>y`-> c3) - -> Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end. + forall (c1 c2 c3:Prop) (n m:Z), + (n = m -> c1) -> + (n < m -> c2) -> + (n > m -> c3) -> match n ?= m with + | Eq => c1 + | Lt => c2 + | Gt => c3 + end. Proof. -Intros c1 c2 c3 x y; Intros. -Apply rename with x:=(Zcompare x y); Intro r; Elim r; -[ Intro; Apply H; Apply (Zcompare_EGAL_eq x y); Assumption -| Unfold Zlt in H0; Assumption -| Unfold Zgt in H1; Assumption ]. +intros c1 c2 c3 x y; intros. +apply rename with (x := x ?= y); intro r; elim r; + [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption + | unfold Zlt in H0; assumption + | unfold Zgt in H1; assumption ]. Qed. -Lemma Zcompare_eq_case : - (c1,c2,c3:Prop)(x,y:Z) c1 -> x=y -> - Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end. +Lemma Zcompare_eq_case : + forall (c1 c2 c3:Prop) (n m:Z), + c1 -> n = m -> match n ?= m with + | Eq => c1 + | Lt => c2 + | Gt => c3 + end. Proof. -Intros c1 c2 c3 x y; Intros. -Rewrite H0; Rewrite (Zcompare_x_x). -Assumption. +intros c1 c2 c3 x y; intros. +rewrite H0; rewrite Zcompare_refl. +assumption. Qed. (** Decompose an egality between two [?=] relations into 3 implications *) Lemma Zcompare_egal_dec : - (x1,y1,x2,y2:Z) - (`x1<y1`->`x2<y2`) - ->((Zcompare x1 y1)=EGAL -> (Zcompare x2 y2)=EGAL) - ->(`x1>y1`->`x2>y2`)->(Zcompare x1 y1)=(Zcompare x2 y2). + forall n m p q:Z, + (n < m -> p < q) -> + ((n ?= m) = Eq -> (p ?= q) = Eq) -> + (n > m -> p > q) -> (n ?= m) = (p ?= q). Proof. -Intros x1 y1 x2 y2. -Unfold Zgt; Unfold Zlt; -Case (Zcompare x1 y1); Case (Zcompare x2 y2); Auto with arith; Symmetry; Auto with arith. +intros x1 y1 x2 y2. +unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2); + auto with arith; symmetry in |- *; auto with arith. Qed. (** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *) -Lemma Zle_Zcompare : - (x,y:Z)`x<=y` -> - Cases (Zcompare x y) of EGAL => True | INFERIEUR => True | SUPERIEUR => False end. +Lemma Zle_compare : + forall n m:Z, + n <= m -> match n ?= m with + | Eq => True + | Lt => True + | Gt => False + end. Proof. -Intros x y; Unfold Zle; Elim (Zcompare x y); Auto with arith. +intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith. Qed. -Lemma Zlt_Zcompare : - (x,y:Z)`x<y` -> - Cases (Zcompare x y) of EGAL => False | INFERIEUR => True | SUPERIEUR => False end. +Lemma Zlt_compare : + forall n m:Z, + n < m -> match n ?= m with + | Eq => False + | Lt => True + | Gt => False + end. Proof. -Intros x y; Unfold Zlt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith. +intros x y; unfold Zlt in |- *; elim (x ?= y); intros; + discriminate || trivial with arith. Qed. -Lemma Zge_Zcompare : - (x,y:Z)`x>=y`-> - Cases (Zcompare x y) of EGAL => True | INFERIEUR => False | SUPERIEUR => True end. +Lemma Zge_compare : + forall n m:Z, + n >= m -> match n ?= m with + | Eq => True + | Lt => False + | Gt => True + end. Proof. -Intros x y; Unfold Zge; Elim (Zcompare x y); Auto with arith. +intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. Qed. -Lemma Zgt_Zcompare : - (x,y:Z)`x>y` -> - Cases (Zcompare x y) of EGAL => False | INFERIEUR => False | SUPERIEUR => True end. +Lemma Zgt_compare : + forall n m:Z, + n > m -> match n ?= m with + | Eq => False + | Lt => False + | Gt => True + end. Proof. -Intros x y; Unfold Zgt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith. +intros x y; unfold Zgt in |- *; elim (x ?= y); intros; + discriminate || trivial with arith. Qed. (**********************************************************************) (* Other properties *) -V7only [Set Implicit Arguments.]. -Lemma Zcompare_Zmult_left : (x,y,z:Z)`z>0` -> `x ?= y`=`z*x ?= z*y`. +Lemma Zmult_compare_compat_l : + forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m). Proof. -Intros x y z H; NewDestruct z. - Discriminate H. - Rewrite Zcompare_Zmult_compatible; Reflexivity. - Discriminate H. +intros x y z H; destruct z. + discriminate H. + rewrite Zcompare_mult_compat; reflexivity. + discriminate H. Qed. -Lemma Zcompare_Zmult_right : (x,y,z:Z)` z>0` -> `x ?= y`=`x*z ?= y*z`. +Lemma Zmult_compare_compat_r : + forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p). Proof. -Intros x y z H; -Rewrite (Zmult_sym x z); -Rewrite (Zmult_sym y z); -Apply Zcompare_Zmult_left; Assumption. +intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z); + apply Zmult_compare_compat_l; assumption. Qed. -V7only [Unset Implicit Arguments.]. - diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index 8d27f81d2..01e8d4870 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -8,39 +8,38 @@ (*i $Id$ i*) -Require ZArithRing. -Require ZArith_base. -Require Omega. -Require Wf_nat. -V7only [Import Z_scope.]. +Require Import ZArithRing. +Require Import ZArith_base. +Require Import Omega. +Require Import Wf_nat. Open Local Scope Z_scope. -V7only [Set Implicit Arguments.]. (**********************************************************************) (** About parity *) -Lemma two_or_two_plus_one : (x:Z) { y:Z | `x = 2*y`}+{ y:Z | `x = 2*y+1`}. +Lemma two_or_two_plus_one : + forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. Proof. -Intro x; NewDestruct x. -Left ; Split with ZERO; Reflexivity. +intro x; destruct x. +left; split with 0; reflexivity. -NewDestruct p. -Right ; Split with (POS p); Reflexivity. +destruct p. +right; split with (Zpos p); reflexivity. -Left ; Split with (POS p); Reflexivity. +left; split with (Zpos p); reflexivity. -Right ; Split with ZERO; Reflexivity. +right; split with 0; reflexivity. -NewDestruct p. -Right ; Split with (NEG (add xH p)). -Rewrite NEG_xI. -Rewrite NEG_add. -Omega. +destruct p. +right; split with (Zneg (1 + p)). +rewrite BinInt.Zneg_xI. +rewrite BinInt.Zneg_plus_distr. +omega. -Left ; Split with (NEG p); Reflexivity. +left; split with (Zneg p); reflexivity. -Right ; Split with `-1`; Reflexivity. +right; split with (-1); reflexivity. Qed. (**********************************************************************) @@ -49,164 +48,165 @@ Qed. Easy to compute: replace all "1" of the binary representation by "0", except the first "1" (or the first one :-) *) -Fixpoint floor_pos [a : positive] : positive := - Cases a of - | xH => xH - | (xO a') => (xO (floor_pos a')) - | (xI b') => (xO (floor_pos b')) +Fixpoint floor_pos (a:positive) : positive := + match a with + | xH => 1%positive + | xO a' => xO (floor_pos a') + | xI b' => xO (floor_pos b') end. -Definition floor := [a:positive](POS (floor_pos a)). +Definition floor (a:positive) := Zpos (floor_pos a). -Lemma floor_gt0 : (x:positive) `(floor x) > 0`. +Lemma floor_gt0 : forall p:positive, floor p > 0. Proof. -Intro. -Compute. -Trivial. +intro. +compute in |- *. +trivial. Qed. -Lemma floor_ok : (a:positive) - `(floor a) <= (POS a) < 2*(floor a)`. +Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. Proof. -Unfold floor. -Intro a; NewInduction a as [p|p|]. - -Simpl. -Repeat Rewrite POS_xI. -Rewrite (POS_xO (xO (floor_pos p))). -Rewrite (POS_xO (floor_pos p)). -Omega. - -Simpl. -Repeat Rewrite POS_xI. -Rewrite (POS_xO (xO (floor_pos p))). -Rewrite (POS_xO (floor_pos p)). -Rewrite (POS_xO p). -Omega. - -Simpl; Omega. +unfold floor in |- *. +intro a; induction a as [p| p| ]. + +simpl in |- *. +repeat rewrite BinInt.Zpos_xI. +rewrite (BinInt.Zpos_xO (xO (floor_pos p))). +rewrite (BinInt.Zpos_xO (floor_pos p)). +omega. + +simpl in |- *. +repeat rewrite BinInt.Zpos_xI. +rewrite (BinInt.Zpos_xO (xO (floor_pos p))). +rewrite (BinInt.Zpos_xO (floor_pos p)). +rewrite (BinInt.Zpos_xO p). +omega. + +simpl in |- *; omega. Qed. (**********************************************************************) (** Two more induction principles over [Z]. *) -Theorem Z_lt_abs_rec : (P: Z -> Set) - ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p). +Theorem Z_lt_abs_rec : + forall P:Z -> Set, + (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) -> + forall n:Z, P n. Proof. -Intros P HP p. -LetTac Q:=[z]`0<=z`->(P z)*(P `-z`). -Cut (Q `|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;Clear Q;Intros. -Apply pair;Apply HP. -Rewrite Zabs_eq;Auto;Intros. -Elim (H `|m|`);Intros;Auto with zarith. -Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial. -Rewrite Zabs_non_eq;Auto with zarith. -Rewrite Zopp_Zopp;Intros. -Elim (H `|m|`);Intros;Auto with zarith. -Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial. +intros P HP p. +set (Q := fun z => 0 <= z -> P z * P (- z)) in *. +cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ]. +elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith. +unfold Q in |- *; clear Q; intros. +apply pair; apply HP. +rewrite Zabs_eq; auto; intros. +elim (H (Zabs m)); intros; auto with zarith. +elim (Zabs_dec m); intro eq; rewrite eq; trivial. +rewrite Zabs_non_eq; auto with zarith. +rewrite Zopp_involutive; intros. +elim (H (Zabs m)); intros; auto with zarith. +elim (Zabs_dec m); intro eq; rewrite eq; trivial. Qed. -Theorem Z_lt_abs_induction : (P: Z -> Prop) - ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p). +Theorem Z_lt_abs_induction : + forall P:Z -> Prop, + (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) -> + forall n:Z, P n. Proof. -Intros P HP p. -LetTac Q:=[z]`0<=z`->(P z) /\ (P `-z`). -Cut (Q `|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;Clear Q;Intros. -Split;Apply HP. -Rewrite Zabs_eq;Auto;Intros. -Elim (H `|m|`);Intros;Auto with zarith. -Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial. -Rewrite Zabs_non_eq;Auto with zarith. -Rewrite Zopp_Zopp;Intros. -Elim (H `|m|`);Intros;Auto with zarith. -Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial. +intros P HP p. +set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *. +cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ]. +elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith. +unfold Q in |- *; clear Q; intros. +split; apply HP. +rewrite Zabs_eq; auto; intros. +elim (H (Zabs m)); intros; auto with zarith. +elim (Zabs_dec m); intro eq; rewrite eq; trivial. +rewrite Zabs_non_eq; auto with zarith. +rewrite Zopp_involutive; intros. +elim (H (Zabs m)); intros; auto with zarith. +elim (Zabs_dec m); intro eq; rewrite eq; trivial. Qed. -V7only [Unset Implicit Arguments.]. (** To do case analysis over the sign of [z] *) -Lemma Zcase_sign : (x:Z)(P:Prop) - (`x=0` -> P) -> - (`x>0` -> P) -> - (`x<0` -> P) -> P. +Lemma Zcase_sign : + forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P. Proof. -Intros x P Hzero Hpos Hneg. -Induction x. -Apply Hzero; Trivial. -Apply Hpos; Apply POS_gt_ZERO. -Apply Hneg; Apply NEG_lt_ZERO. -Save. - -Lemma sqr_pos : (x:Z)`x*x >= 0`. +intros x P Hzero Hpos Hneg. +induction x as [| p| p]. +apply Hzero; trivial. +apply Hpos; apply Zorder.Zgt_pos_0. +apply Hneg; apply Zorder.Zlt_neg_0. +Qed. + +Lemma sqr_pos : forall n:Z, n * n >= 0. Proof. -Intro x. -Apply (Zcase_sign x `x*x >= 0`). -Intros H; Rewrite H; Omega. -Intros H; Replace `0` with `0*0`. -Apply Zge_Zmult_pos_compat; Omega. -Omega. -Intros H; Replace `0` with `0*0`. -Replace `x*x` with `(-x)*(-x)`. -Apply Zge_Zmult_pos_compat; Omega. -Ring. -Omega. -Save. +intro x. +apply (Zcase_sign x (x * x >= 0)). +intros H; rewrite H; omega. +intros H; replace 0 with (0 * 0). +apply Zmult_ge_compat; omega. +omega. +intros H; replace 0 with (0 * 0). +replace (x * x) with (- x * - x). +apply Zmult_ge_compat; omega. +ring. +omega. +Qed. (**********************************************************************) (** A list length in Z, tail recursive. *) -Require PolyList. +Require Import List. -Fixpoint Zlength_aux [acc: Z; A:Set; l:(list A)] : Z := Cases l of - nil => acc - | (cons _ l) => (Zlength_aux (Zs acc) A l) -end. +Fixpoint Zlength_aux (acc:Z) (A:Set) (l:list A) {struct l} : Z := + match l with + | nil => acc + | _ :: l => Zlength_aux (Zsucc acc) A l + end. -Definition Zlength := (Zlength_aux 0). -Implicits Zlength [1]. +Definition Zlength := Zlength_aux 0. +Implicit Arguments Zlength [A]. Section Zlength_properties. -Variable A:Set. +Variable A : Set. -Implicit Variable Type l:(list A). +Implicit Type l : list A. -Lemma Zlength_correct : (l:(list A))(Zlength l)=(inject_nat (length l)). +Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l). Proof. -Assert (l:(list A))(acc:Z)(Zlength_aux acc A l)=acc+(inject_nat (length l)). -Induction l. -Simpl; Auto with zarith. -Intros; Simpl (length (cons a l0)); Rewrite inj_S. -Simpl; Rewrite H; Auto with zarith. -Unfold Zlength; Intros; Rewrite H; Auto. +assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). +simple induction l. +simpl in |- *; auto with zarith. +intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S. +simpl in |- *; rewrite H; auto with zarith. +unfold Zlength in |- *; intros; rewrite H; auto. Qed. -Lemma Zlength_nil : (Zlength 1!A (nil A))=0. +Lemma Zlength_nil : Zlength (A:=A) nil = 0. Proof. -Auto. +auto. Qed. -Lemma Zlength_cons : (x:A)(l:(list A))(Zlength (cons x l))=(Zs (Zlength l)). +Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l). Proof. -Intros; Do 2 Rewrite Zlength_correct. -Simpl (length (cons x l)); Rewrite inj_S; Auto. +intros; do 2 rewrite Zlength_correct. +simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto. Qed. -Lemma Zlength_nil_inv : (l:(list A))(Zlength l)=0 -> l=(nil ?). +Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil. Proof. -Intro l; Rewrite Zlength_correct. -Case l; Auto. -Intros x l'; Simpl (length (cons x l')). -Rewrite inj_S. -Intros; ElimType False; Generalize (ZERO_le_inj (length l')); Omega. +intro l; rewrite Zlength_correct. +case l; auto. +intros x l'; simpl (length (x :: l')) in |- *. +rewrite Znat.inj_S. +intros; elimtype False; generalize (Zle_0_nat (length l')); omega. Qed. End Zlength_properties. -Implicits Zlength_correct [1]. -Implicits Zlength_cons [1]. -Implicits Zlength_nil_inv [1]. +Implicit Arguments Zlength_correct [A]. +Implicit Arguments Zlength_cons [A]. +Implicit Arguments Zlength_nil_inv [A].
\ No newline at end of file diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index ee6987215..7738e868c 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -20,11 +20,10 @@ Then only after proves the main required property. *) Require Export ZArith_base. -Require Zbool. -Require Omega. -Require ZArithRing. -Require Zcomplements. -V7only [Import Z_scope.]. +Require Import Zbool. +Require Import Omega. +Require Import ZArithRing. +Require Import Zcomplements. Open Local Scope Z_scope. (** @@ -37,16 +36,19 @@ Open Local Scope Z_scope. *) -Fixpoint Zdiv_eucl_POS [a:positive] : Z -> Z*Z := [b:Z] - Cases a of - | xH => if `(Zge_bool b 2)` then `(0,1)` else `(1,0)` - | (xO a') => - let (q,r) = (Zdiv_eucl_POS a' b) in - [r':=`2*r`] if `(Zgt_bool b r')` then `(2*q,r')` else `(2*q+1,r'-b)` - | (xI a') => - let (q,r) = (Zdiv_eucl_POS a' b) in - [r':=`2*r+1`] if `(Zgt_bool b r')` then `(2*q,r')` else `(2*q+1,r'-b)` - end. +Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : + Z * Z := + match a with + | xH => if Zge_bool b 2 then (0, 1) else (1, 0) + | xO a' => + let (q, r) := Zdiv_eucl_POS a' b in + let r' := 2 * r in + if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b) + | xI a' => + let (q, r) := Zdiv_eucl_POS a' b in + let r' := 2 * r + 1 in + if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b) + end. (** @@ -78,33 +80,32 @@ Fixpoint Zdiv_eucl_POS [a:positive] : Z -> Z*Z := [b:Z] *) -Definition Zdiv_eucl [a,b:Z] : Z*Z := - Cases a b of - | ZERO _ => `(0,0)` - | _ ZERO => `(0,0)` - | (POS a') (POS _) => (Zdiv_eucl_POS a' b) - | (NEG a') (POS _) => - let (q,r) = (Zdiv_eucl_POS a' b) in - Cases r of - | ZERO => `(-q,0)` - | _ => `(-(q+1),b-r)` +Definition Zdiv_eucl (a b:Z) : Z * Z := + match a, b with + | Z0, _ => (0, 0) + | _, Z0 => (0, 0) + | Zpos a', Zpos _ => Zdiv_eucl_POS a' b + | Zneg a', Zpos _ => + let (q, r) := Zdiv_eucl_POS a' b in + match r with + | Z0 => (- q, 0) + | _ => (- (q + 1), b - r) end - | (NEG a') (NEG b') => - let (q,r) = (Zdiv_eucl_POS a' (POS b')) in `(q,-r)` - | (POS a') (NEG b') => - let (q,r) = (Zdiv_eucl_POS a' (POS b')) in - Cases r of - | ZERO => `(-q,0)` - | _ => `(-(q+1),b+r)` + | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r) + | Zpos a', Zneg b' => + let (q, r) := Zdiv_eucl_POS a' (Zpos b') in + match r with + | Z0 => (- q, 0) + | _ => (- (q + 1), b + r) end - end. + end. (** Division and modulo are projections of [Zdiv_eucl] *) -Definition Zdiv [a,b:Z] : Z := let (q,_) = (Zdiv_eucl a b) in q. +Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q. -Definition Zmod [a,b:Z] : Z := let (_,r) = (Zdiv_eucl a b) in r. +Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r. (* Tests: @@ -127,306 +128,296 @@ Eval Compute in `(Zdiv_eucl (-7) (-3))`. *) -Lemma Z_div_mod_POS : (b:Z)`b > 0` -> (a:positive) - let (q,r)=(Zdiv_eucl_POS a b) in `(POS a) = b*q + r`/\`0<=r<b`. +Lemma Z_div_mod_POS : + forall b:Z, + b > 0 -> + forall a:positive, + let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b. Proof. -Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS. - -Intro p; Case (Zdiv_eucl_POS p b); Intros q r (H0,H1). -Generalize (Zgt_cases b `2*r+1`). -Case (Zgt_bool b `2*r+1`); -(Rewrite POS_xI; Rewrite H0; Split ; [ Ring | Omega ]). - -Intros p; Case (Zdiv_eucl_POS p b); Intros q r (H0,H1). -Generalize (Zgt_cases b `2*r`). -Case (Zgt_bool b `2*r`); - Rewrite POS_xO; Change (POS (xO p)) with `2*(POS p)`; - Rewrite H0; (Split; [Ring | Omega]). - -Generalize (Zge_cases b `2`). -Case (Zge_bool b `2`); (Intros; Split; [Ring | Omega ]). -Omega. +simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *. + +intro p; case (Zdiv_eucl_POS p b); intros q r [H0 H1]. +generalize (Zgt_cases b (2 * r + 1)). +case (Zgt_bool b (2 * r + 1)); + (rewrite BinInt.Zpos_xI; rewrite H0; split; [ ring | omega ]). + +intros p; case (Zdiv_eucl_POS p b); intros q r [H0 H1]. +generalize (Zgt_cases b (2 * r)). +case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO; + change (Zpos (xO p)) with (2 * Zpos p) in |- *; rewrite H0; + (split; [ ring | omega ]). + +generalize (Zge_cases b 2). +case (Zge_bool b 2); (intros; split; [ ring | omega ]). +omega. Qed. -Theorem Z_div_mod : (a,b:Z)`b > 0` -> - let (q,r) = (Zdiv_eucl a b) in `a = b*q + r` /\ `0<=r<b`. +Theorem Z_div_mod : + forall a b:Z, + b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b. Proof. -Intros a b; Case a; Case b; Try (Simpl; Intros; Omega). -Unfold Zdiv_eucl; Intros; Apply Z_div_mod_POS; Trivial. +intros a b; case a; case b; try (simpl in |- *; intros; omega). +unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial. -Intros; Discriminate. +intros; discriminate. -Intros. -Generalize (Z_div_mod_POS (POS p) H p0). -Unfold Zdiv_eucl. -Case (Zdiv_eucl_POS p0 (POS p)). -Intros z z0. -Case z0. +intros. +generalize (Z_div_mod_POS (Zpos p) H p0). +unfold Zdiv_eucl in |- *. +case (Zdiv_eucl_POS p0 (Zpos p)). +intros z z0. +case z0. -Intros [H1 H2]. -Split; Trivial. -Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ]. +intros [H1 H2]. +split; trivial. +replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. -Intros p1 [H1 H2]. -Split; Trivial. -Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ]. -Generalize (POS_gt_ZERO p1); Omega. +intros p1 [H1 H2]. +split; trivial. +replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. +generalize (Zorder.Zgt_pos_0 p1); omega. -Intros p1 [H1 H2]. -Split; Trivial. -Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ]. -Generalize (NEG_lt_ZERO p1); Omega. +intros p1 [H1 H2]. +split; trivial. +replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. +generalize (Zorder.Zlt_neg_0 p1); omega. -Intros; Discriminate. +intros; discriminate. Qed. (** Existence theorems *) -Theorem Zdiv_eucl_exist : (b:Z)`b > 0` -> (a:Z) - { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < b` }. +Theorem Zdiv_eucl_exist : + forall b:Z, + b > 0 -> + forall a:Z, {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}. Proof. -Intros b Hb a. -Exists (Zdiv_eucl a b). -Exact (Z_div_mod a b Hb). +intros b Hb a. +exists (Zdiv_eucl a b). +exact (Z_div_mod a b Hb). Qed. -Implicits Zdiv_eucl_exist. +Implicit Arguments Zdiv_eucl_exist. -Theorem Zdiv_eucl_extended : (b:Z)`b <> 0` -> (a:Z) - { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < |b|` }. +Theorem Zdiv_eucl_extended : + forall b:Z, + b <> 0 -> + forall a:Z, + {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}. Proof. -Intros b Hb a. -Elim (Z_le_gt_dec `0` b);Intro Hb'. -Cut `b>0`;[Intro Hb''|Omega]. -Rewrite Zabs_eq;[Apply Zdiv_eucl_exist;Assumption|Assumption]. -Cut `-b>0`;[Intro Hb''|Omega]. -Elim (Zdiv_eucl_exist Hb'' a);Intros qr. -Elim qr;Intros q r Hqr. -Exists (pair ? ? `-q` r). -Elim Hqr;Intros. -Split. -Rewrite <- Zmult_Zopp_left;Assumption. -Rewrite Zabs_non_eq;[Assumption|Omega]. +intros b Hb a. +elim (Z_le_gt_dec 0 b); intro Hb'. +cut (b > 0); [ intro Hb'' | omega ]. +rewrite Zabs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ]. +cut (- b > 0); [ intro Hb'' | omega ]. +elim (Zdiv_eucl_exist Hb'' a); intros qr. +elim qr; intros q r Hqr. +exists (- q, r). +elim Hqr; intros. +split. +rewrite <- Zmult_opp_comm; assumption. +rewrite Zabs_non_eq; [ assumption | omega ]. Qed. -Implicits Zdiv_eucl_extended. +Implicit Arguments Zdiv_eucl_extended. (** Auxiliary lemmas about [Zdiv] and [Zmod] *) -Lemma Z_div_mod_eq : (a,b:Z)`b > 0` -> `a = b * (Zdiv a b) + (Zmod a b)`. +Lemma Z_div_mod_eq : forall a b:Z, b > 0 -> a = b * Zdiv a b + Zmod a b. Proof. -Unfold Zdiv Zmod. -Intros a b Hb. -Generalize (Z_div_mod a b Hb). -Case (Zdiv_eucl); Tauto. -Save. +unfold Zdiv, Zmod in |- *. +intros a b Hb. +generalize (Z_div_mod a b Hb). +case Zdiv_eucl; tauto. +Qed. -Lemma Z_mod_lt : (a,b:Z)`b > 0` -> `0 <= (Zmod a b) < b`. +Lemma Z_mod_lt : forall a b:Z, b > 0 -> 0 <= Zmod a b < b. Proof. -Unfold Zmod. -Intros a b Hb. -Generalize (Z_div_mod a b Hb). -Case (Zdiv_eucl a b); Tauto. -Save. - -Lemma Z_div_POS_ge0 : (b:Z)(a:positive) - let (q,_) = (Zdiv_eucl_POS a b) in `q >= 0`. +unfold Zmod in |- *. +intros a b Hb. +generalize (Z_div_mod a b Hb). +case (Zdiv_eucl a b); tauto. +Qed. + +Lemma Z_div_POS_ge0 : + forall (b:Z) (a:positive), let (q, _) := Zdiv_eucl_POS a b in q >= 0. Proof. -Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS. -Intro p; Case (Zdiv_eucl_POS p b). -Intros; Case (Zgt_bool b `2*z0+1`); Intros; Omega. -Intro p; Case (Zdiv_eucl_POS p b). -Intros; Case (Zgt_bool b `2*z0`); Intros; Omega. -Case (Zge_bool b `2`); Simpl; Omega. -Save. - -Lemma Z_div_ge0 : (a,b:Z)`b > 0` -> `a >= 0` -> `(Zdiv a b) >= 0`. +simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *. +intro p; case (Zdiv_eucl_POS p b). +intros; case (Zgt_bool b (2 * z0 + 1)); intros; omega. +intro p; case (Zdiv_eucl_POS p b). +intros; case (Zgt_bool b (2 * z0)); intros; omega. +case (Zge_bool b 2); simpl in |- *; omega. +Qed. + +Lemma Z_div_ge0 : forall a b:Z, b > 0 -> a >= 0 -> Zdiv a b >= 0. Proof. -Intros a b Hb; Unfold Zdiv Zdiv_eucl; Case a; Simpl; Intros. -Case b; Simpl; Trivial. -Generalize Hb; Case b; Try Trivial. -Auto with zarith. -Intros p0 Hp0; Generalize (Z_div_POS_ge0 (POS p0) p). -Case (Zdiv_eucl_POS p (POS p0)); Simpl; Tauto. -Intros; Discriminate. -Elim H; Trivial. -Save. - -Lemma Z_div_lt : (a,b:Z)`b >= 2` -> `a > 0` -> `(Zdiv a b) < a`. +intros a b Hb; unfold Zdiv, Zdiv_eucl in |- *; case a; simpl in |- *; intros. +case b; simpl in |- *; trivial. +generalize Hb; case b; try trivial. +auto with zarith. +intros p0 Hp0; generalize (Z_div_POS_ge0 (Zpos p0) p). +case (Zdiv_eucl_POS p (Zpos p0)); simpl in |- *; tauto. +intros; discriminate. +elim H; trivial. +Qed. + +Lemma Z_div_lt : forall a b:Z, b >= 2 -> a > 0 -> Zdiv a b < a. Proof. -Intros. Cut `b > 0`; [Intro Hb | Omega]. -Generalize (Z_div_mod a b Hb). -Cut `a >= 0`; [Intro Ha | Omega]. -Generalize (Z_div_ge0 a b Hb Ha). -Unfold Zdiv; Case (Zdiv_eucl a b); Intros q r H1 [H2 H3]. -Cut `a >= 2*q` -> `q < a`; [ Intro h; Apply h; Clear h | Intros; Omega ]. -Apply Zge_trans with `b*q`. -Omega. -Auto with zarith. -Save. +intros. cut (b > 0); [ intro Hb | omega ]. +generalize (Z_div_mod a b Hb). +cut (a >= 0); [ intro Ha | omega ]. +generalize (Z_div_ge0 a b Hb Ha). +unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3]. +cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ]. +apply Zge_trans with (b * q). +omega. +auto with zarith. +Qed. (** Syntax *) -V7only[ -Grammar znatural expr2 : constr := - expr_div [ expr2($p) "/" expr2($c) ] -> [ (Zdiv $p $c) ] -| expr_mod [ expr2($p) "%" expr2($c) ] -> [ (Zmod $p $c) ] -. - -Syntax constr - level 6: - Zdiv [ (Zdiv $n1 $n2) ] - -> [ [<hov 0> "`"(ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L "`"] ] - | Zmod [ (Zmod $n1 $n2) ] - -> [ [<hov 0> "`"(ZEXPR $n1):E "%" [0 0] (ZEXPR $n2):L "`"] ] - | Zdiv_inside - [ << (ZEXPR <<(Zdiv $n1 $n2)>>) >> ] - -> [ (ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L ] - | Zmod_inside - [ << (ZEXPR <<(Zmod $n1 $n2)>>) >> ] - -> [ (ZEXPR $n1):E " %" [1 0] (ZEXPR $n2):L ] -. -]. - - -Infix 3 "/" Zdiv (no associativity) : Z_scope V8only. -Infix 3 "mod" Zmod (no associativity) : Z_scope. + + +Infix "/" := Zdiv : Z_scope. +Infix "mod" := Zmod (at level 40, no associativity) : Z_scope. (** Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *) -Lemma Z_div_ge : (a,b,c:Z)`c > 0`->`a >= b`->`a/c >= b/c`. +Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a / c >= b / c. Proof. -Intros a b c cPos aGeb. -Generalize (Z_div_mod_eq a c cPos). -Generalize (Z_mod_lt a c cPos). -Generalize (Z_div_mod_eq b c cPos). -Generalize (Z_mod_lt b c cPos). -Intros. -Elim (Z_ge_lt_dec `a/c` `b/c`); Trivial. -Intro. -Absurd `b-a >= 1`. -Omega. -Rewrite -> H0. -Rewrite -> H2. -Assert `c*(b/c)+b % c-(c*(a/c)+a % c) = c*(b/c - a/c) + b % c - a % c`. -Ring. -Rewrite H3. -Assert `c*(b/c-a/c) >= c*1`. -Apply Zge_Zmult_pos_left. -Omega. -Omega. -Assert `c*1=c`. -Ring. -Omega. -Save. - -Lemma Z_mod_plus : (a,b,c:Z)`c > 0`->`(a+b*c) % c = a % c`. +intros a b c cPos aGeb. +generalize (Z_div_mod_eq a c cPos). +generalize (Z_mod_lt a c cPos). +generalize (Z_div_mod_eq b c cPos). +generalize (Z_mod_lt b c cPos). +intros. +elim (Z_ge_lt_dec (a / c) (b / c)); trivial. +intro. +absurd (b - a >= 1). +omega. +rewrite H0. +rewrite H2. +assert + (c * (b / c) + b mod c - (c * (a / c) + a mod c) = + c * (b / c - a / c) + b mod c - a mod c). +ring. +rewrite H3. +assert (c * (b / c - a / c) >= c * 1). +apply Zmult_ge_compat_l. +omega. +omega. +assert (c * 1 = c). +ring. +omega. +Qed. + +Lemma Z_mod_plus : forall a b c:Z, c > 0 -> (a + b * c) mod c = a mod c. Proof. -Intros a b c cPos. -Generalize (Z_div_mod_eq a c cPos). -Generalize (Z_mod_lt a c cPos). -Generalize (Z_div_mod_eq `a+b*c` c cPos). -Generalize (Z_mod_lt `a+b*c` c cPos). -Intros. - -Assert `(a+b*c) % c - a % c = c*(b+a/c - (a+b*c)/c)`. -Replace `(a+b*c) % c` with `a+b*c - c*((a+b*c)/c)`. -Replace `a % c` with `a - c*(a/c)`. -Ring. -Omega. -Omega. -LetTac q := `b+a/c-(a+b*c)/c`. -Apply (Zcase_sign q); Intros. -Assert `c*q=0`. -Rewrite H4; Ring. -Rewrite H5 in H3. -Omega. - -Assert `c*q >= c`. -Pattern 2 c; Replace c with `c*1`. -Apply Zge_Zmult_pos_left; Omega. -Ring. -Omega. - -Assert `c*q <= -c`. -Replace `-c` with `c*(-1)`. -Apply Zle_Zmult_pos_left; Omega. -Ring. -Omega. -Save. - -Lemma Z_div_plus : (a,b,c:Z)`c > 0`->`(a+b*c)/c = a/c+b`. +intros a b c cPos. +generalize (Z_div_mod_eq a c cPos). +generalize (Z_mod_lt a c cPos). +generalize (Z_div_mod_eq (a + b * c) c cPos). +generalize (Z_mod_lt (a + b * c) c cPos). +intros. + +assert ((a + b * c) mod c - a mod c = c * (b + a / c - (a + b * c) / c)). +replace ((a + b * c) mod c) with (a + b * c - c * ((a + b * c) / c)). +replace (a mod c) with (a - c * (a / c)). +ring. +omega. +omega. +set (q := b + a / c - (a + b * c) / c) in *. +apply (Zcase_sign q); intros. +assert (c * q = 0). +rewrite H4; ring. +rewrite H5 in H3. +omega. + +assert (c * q >= c). +pattern c at 2 in |- *; replace c with (c * 1). +apply Zmult_ge_compat_l; omega. +ring. +omega. + +assert (c * q <= - c). +replace (- c) with (c * -1). +apply Zmult_le_compat_l; omega. +ring. +omega. +Qed. + +Lemma Z_div_plus : forall a b c:Z, c > 0 -> (a + b * c) / c = a / c + b. Proof. -Intros a b c cPos. -Generalize (Z_div_mod_eq a c cPos). -Generalize (Z_mod_lt a c cPos). -Generalize (Z_div_mod_eq `a+b*c` c cPos). -Generalize (Z_mod_lt `a+b*c` c cPos). -Intros. -Apply Zmult_reg_left with c. Omega. -Replace `c*((a+b*c)/c)` with `a+b*c-(a+b*c) % c`. -Rewrite (Z_mod_plus a b c cPos). -Pattern 1 a; Rewrite H2. -Ring. -Pattern 1 `a+b*c`; Rewrite H0. -Ring. -Save. - -Lemma Z_div_mult : (a,b:Z)`b > 0`->`(a*b)/b = a`. -Intros; Replace `a*b` with `0+a*b`; Auto. -Rewrite Z_div_plus; Auto. -Save. - -Lemma Z_mult_div_ge : (a,b:Z)`b>0`->`b*(a/b) <= a`. +intros a b c cPos. +generalize (Z_div_mod_eq a c cPos). +generalize (Z_mod_lt a c cPos). +generalize (Z_div_mod_eq (a + b * c) c cPos). +generalize (Z_mod_lt (a + b * c) c cPos). +intros. +apply Zmult_reg_l with c. omega. +replace (c * ((a + b * c) / c)) with (a + b * c - (a + b * c) mod c). +rewrite (Z_mod_plus a b c cPos). +pattern a at 1 in |- *; rewrite H2. +ring. +pattern (a + b * c) at 1 in |- *; rewrite H0. +ring. +Qed. + +Lemma Z_div_mult : forall a b:Z, b > 0 -> a * b / b = a. +intros; replace (a * b) with (0 + a * b); auto. +rewrite Z_div_plus; auto. +Qed. + +Lemma Z_mult_div_ge : forall a b:Z, b > 0 -> b * (a / b) <= a. Proof. -Intros a b bPos. -Generalize (Z_div_mod_eq `a` ? bPos); Intros. -Generalize (Z_mod_lt `a` ? bPos); Intros. -Pattern 2 a; Rewrite H. -Omega. -Save. - -Lemma Z_mod_same : (a:Z)`a>0`->`a % a=0`. +intros a b bPos. +generalize (Z_div_mod_eq a _ bPos); intros. +generalize (Z_mod_lt a _ bPos); intros. +pattern a at 2 in |- *; rewrite H. +omega. +Qed. + +Lemma Z_mod_same : forall a:Z, a > 0 -> a mod a = 0. Proof. -Intros a aPos. -Generalize (Z_mod_plus `0` `1` a aPos). -Replace `0+1*a` with `a`. -Intros. -Rewrite H. -Compute. -Trivial. -Ring. -Save. - -Lemma Z_div_same : (a:Z)`a>0`->`a/a=1`. +intros a aPos. +generalize (Z_mod_plus 0 1 a aPos). +replace (0 + 1 * a) with a. +intros. +rewrite H. +compute in |- *. +trivial. +ring. +Qed. + +Lemma Z_div_same : forall a:Z, a > 0 -> a / a = 1. Proof. -Intros a aPos. -Generalize (Z_div_plus `0` `1` a aPos). -Replace `0+1*a` with `a`. -Intros. -Rewrite H. -Compute. -Trivial. -Ring. -Save. - -Lemma Z_div_exact_1 : (a,b:Z)`b>0` -> `a = b*(a/b)` -> `a%b = 0`. -Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv. -Case (Zdiv_eucl a b); Intros q r; Omega. -Save. - -Lemma Z_div_exact_2 : (a,b:Z)`b>0` -> `a%b = 0` -> `a = b*(a/b)`. -Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv. -Case (Zdiv_eucl a b); Intros q r; Omega. -Save. - -Lemma Z_mod_zero_opp : (a,b:Z)`b>0` -> `a%b = 0` -> `(-a)%b = 0`. -Intros a b Hb. -Intros. -Rewrite Z_div_exact_2 with a b; Auto. -Replace `-(b*(a/b))` with `0+(-(a/b))*b`. -Rewrite Z_mod_plus; Auto. -Ring. -Save. +intros a aPos. +generalize (Z_div_plus 0 1 a aPos). +replace (0 + 1 * a) with a. +intros. +rewrite H. +compute in |- *. +trivial. +ring. +Qed. + +Lemma Z_div_exact_1 : forall a b:Z, b > 0 -> a = b * (a / b) -> a mod b = 0. +intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *. +case (Zdiv_eucl a b); intros q r; omega. +Qed. +Lemma Z_div_exact_2 : forall a b:Z, b > 0 -> a mod b = 0 -> a = b * (a / b). +intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *. +case (Zdiv_eucl a b); intros q r; omega. +Qed. + +Lemma Z_mod_zero_opp : forall a b:Z, b > 0 -> a mod b = 0 -> - a mod b = 0. +intros a b Hb. +intros. +rewrite Z_div_exact_2 with a b; auto. +replace (- (b * (a / b))) with (0 + - (a / b) * b). +rewrite Z_mod_plus; auto. +ring. +Qed. diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v index e22dc20f6..728e16da9 100644 --- a/theories/ZArith/Zeven.v +++ b/theories/ZArith/Zeven.v @@ -8,8 +8,7 @@ (*i $Id$ i*) -Require BinInt. -Require Zsyntax. +Require Import BinInt. (**********************************************************************) (** About parity: even and odd predicates on Z, division by 2 on Z *) @@ -17,168 +16,189 @@ Require Zsyntax. (**********************************************************************) (** [Zeven], [Zodd], [Zdiv2] and their related properties *) -Definition Zeven := - [z:Z]Cases z of ZERO => True - | (POS (xO _)) => True - | (NEG (xO _)) => True - | _ => False - end. - -Definition Zodd := - [z:Z]Cases z of (POS xH) => True - | (NEG xH) => True - | (POS (xI _)) => True - | (NEG (xI _)) => True - | _ => False - end. - -Definition Zeven_bool := - [z:Z]Cases z of ZERO => true - | (POS (xO _)) => true - | (NEG (xO _)) => true - | _ => false - end. - -Definition Zodd_bool := - [z:Z]Cases z of ZERO => false - | (POS (xO _)) => false - | (NEG (xO _)) => false - | _ => true - end. - -Definition Zeven_odd_dec : (z:Z) { (Zeven z) }+{ (Zodd z) }. +Definition Zeven (z:Z) := + match z with + | Z0 => True + | Zpos (xO _) => True + | Zneg (xO _) => True + | _ => False + end. + +Definition Zodd (z:Z) := + match z with + | Zpos xH => True + | Zneg xH => True + | Zpos (xI _) => True + | Zneg (xI _) => True + | _ => False + end. + +Definition Zeven_bool (z:Z) := + match z with + | Z0 => true + | Zpos (xO _) => true + | Zneg (xO _) => true + | _ => false + end. + +Definition Zodd_bool (z:Z) := + match z with + | Z0 => false + | Zpos (xO _) => false + | Zneg (xO _) => false + | _ => true + end. + +Definition Zeven_odd_dec : forall z:Z, {Zeven z} + {Zodd z}. Proof. - Intro z. Case z; - [ Left; Compute; Trivial - | Intro p; Case p; Intros; - (Right; Compute; Exact I) Orelse (Left; Compute; Exact I) - | Intro p; Case p; Intros; - (Right; Compute; Exact I) Orelse (Left; Compute; Exact I) ]. + intro z. case z; + [ left; compute in |- *; trivial + | intro p; case p; intros; + (right; compute in |- *; exact I) || (left; compute in |- *; exact I) + | intro p; case p; intros; + (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ]. Defined. -Definition Zeven_dec : (z:Z) { (Zeven z) }+{ ~(Zeven z) }. +Definition Zeven_dec : forall z:Z, {Zeven z} + {~ Zeven z}. Proof. - Intro z. Case z; - [ Left; Compute; Trivial - | Intro p; Case p; Intros; - (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) - | Intro p; Case p; Intros; - (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ]. + intro z. case z; + [ left; compute in |- *; trivial + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ]. Defined. -Definition Zodd_dec : (z:Z) { (Zodd z) }+{ ~(Zodd z) }. +Definition Zodd_dec : forall z:Z, {Zodd z} + {~ Zodd z}. Proof. - Intro z. Case z; - [ Right; Compute; Trivial - | Intro p; Case p; Intros; - (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) - | Intro p; Case p; Intros; - (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ]. + intro z. case z; + [ right; compute in |- *; trivial + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ]. Defined. -Lemma Zeven_not_Zodd : (z:Z)(Zeven z) -> ~(Zodd z). +Lemma Zeven_not_Zodd : forall n:Z, Zeven n -> ~ Zodd n. Proof. - Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p ]; Compute; Trivial. + intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *; + trivial. Qed. -Lemma Zodd_not_Zeven : (z:Z)(Zodd z) -> ~(Zeven z). +Lemma Zodd_not_Zeven : forall n:Z, Zodd n -> ~ Zeven n. Proof. - Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p ]; Compute; Trivial. + intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *; + trivial. Qed. -Lemma Zeven_Sn : (z:Z)(Zodd z) -> (Zeven (Zs z)). +Lemma Zeven_Sn : forall n:Z, Zodd n -> Zeven (Zsucc n). Proof. - Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial. - Unfold double_moins_un; Case p; Simpl; Auto. + intro z; destruct z; unfold Zsucc in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. -Lemma Zodd_Sn : (z:Z)(Zeven z) -> (Zodd (Zs z)). +Lemma Zodd_Sn : forall n:Z, Zeven n -> Zodd (Zsucc n). Proof. - Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial. - Unfold double_moins_un; Case p; Simpl; Auto. + intro z; destruct z; unfold Zsucc in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. -Lemma Zeven_pred : (z:Z)(Zodd z) -> (Zeven (Zpred z)). +Lemma Zeven_pred : forall n:Z, Zodd n -> Zeven (Zpred n). Proof. - Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial. - Unfold double_moins_un; Case p; Simpl; Auto. + intro z; destruct z; unfold Zpred in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. -Lemma Zodd_pred : (z:Z)(Zeven z) -> (Zodd (Zpred z)). +Lemma Zodd_pred : forall n:Z, Zeven n -> Zodd (Zpred n). Proof. - Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p ]; Simpl; Trivial. - Unfold double_moins_un; Case p; Simpl; Auto. + intro z; destruct z; unfold Zpred in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. -Hints Unfold Zeven Zodd : zarith. +Hint Unfold Zeven Zodd: zarith. (**********************************************************************) (** [Zdiv2] is defined on all [Z], but notice that for odd negative integers it is not the euclidean quotient: in that case we have [n = 2*(n/2)-1] *) -Definition Zdiv2 := - [z:Z]Cases z of ZERO => ZERO - | (POS xH) => ZERO - | (POS p) => (POS (Zdiv2_pos p)) - | (NEG xH) => ZERO - | (NEG p) => (NEG (Zdiv2_pos p)) - end. +Definition Zdiv2 (z:Z) := + match z with + | Z0 => 0%Z + | Zpos xH => 0%Z + | Zpos p => Zpos (Pdiv2 p) + | Zneg xH => 0%Z + | Zneg p => Zneg (Pdiv2 p) + end. -Lemma Zeven_div2 : (x:Z) (Zeven x) -> `x = 2*(Zdiv2 x)`. +Lemma Zeven_div2 : forall n:Z, Zeven n -> n = (2 * Zdiv2 n)%Z. Proof. -Intro x; NewDestruct x. -Auto with arith. -NewDestruct p; Auto with arith. -Intros. Absurd (Zeven (POS (xI p))); Red; Auto with arith. -Intros. Absurd (Zeven `1`); Red; Auto with arith. -NewDestruct p; Auto with arith. -Intros. Absurd (Zeven (NEG (xI p))); Red; Auto with arith. -Intros. Absurd (Zeven `-1`); Red; Auto with arith. +intro x; destruct x. +auto with arith. +destruct p; auto with arith. +intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith. +intros. absurd (Zeven 1); red in |- *; auto with arith. +destruct p; auto with arith. +intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith. +intros. absurd (Zeven (-1)); red in |- *; auto with arith. Qed. -Lemma Zodd_div2 : (x:Z) `x >= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)+1`. +Lemma Zodd_div2 : forall n:Z, (n >= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n + 1)%Z. Proof. -Intro x; NewDestruct x. -Intros. Absurd (Zodd `0`); Red; Auto with arith. -NewDestruct p; Auto with arith. -Intros. Absurd (Zodd (POS (xO p))); Red; Auto with arith. -Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith. +intro x; destruct x. +intros. absurd (Zodd 0); red in |- *; auto with arith. +destruct p; auto with arith. +intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith. +intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith. Qed. -Lemma Zodd_div2_neg : (x:Z) `x <= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)-1`. +Lemma Zodd_div2_neg : + forall n:Z, (n <= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n - 1)%Z. Proof. -Intro x; NewDestruct x. -Intros. Absurd (Zodd `0`); Red; Auto with arith. -Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith. -NewDestruct p; Auto with arith. -Intros. Absurd (Zodd (NEG (xO p))); Red; Auto with arith. +intro x; destruct x. +intros. absurd (Zodd 0); red in |- *; auto with arith. +intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith. +destruct p; auto with arith. +intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith. Qed. -Lemma Z_modulo_2 : (x:Z) { y:Z | `x=2*y` }+{ y:Z | `x=2*y+1` }. +Lemma Z_modulo_2 : + forall n:Z, {y : Z | n = (2 * y)%Z} + {y : Z | n = (2 * y + 1)%Z}. Proof. -Intros x. -Elim (Zeven_odd_dec x); Intro. -Left. Split with (Zdiv2 x). Exact (Zeven_div2 x a). -Right. Generalize b; Clear b; Case x. -Intro b; Inversion b. -Intro p; Split with (Zdiv2 (POS p)). Apply (Zodd_div2 (POS p)); Trivial. -Unfold Zge Zcompare; Simpl; Discriminate. -Intro p; Split with (Zdiv2 (Zpred (NEG p))). -Pattern 1 (NEG p); Rewrite (Zs_pred (NEG p)). -Pattern 1 (Zpred (NEG p)); Rewrite (Zeven_div2 (Zpred (NEG p))). -Reflexivity. -Apply Zeven_pred; Assumption. +intros x. +elim (Zeven_odd_dec x); intro. +left. split with (Zdiv2 x). exact (Zeven_div2 x a). +right. generalize b; clear b; case x. +intro b; inversion b. +intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial. +unfold Zge, Zcompare in |- *; simpl in |- *; discriminate. +intro p; split with (Zdiv2 (Zpred (Zneg p))). +pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)). +pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))). +reflexivity. +apply Zeven_pred; assumption. Qed. -Lemma Zsplit2 : (x:Z) { p : Z*Z | let (x1,x2)=p in (`x=x1+x2` /\ (x1=x2 \/ `x2=x1+1`)) }. +Lemma Zsplit2 : + forall n:Z, + {p : Z * Z | + let (x1, x2) := p in n = (x1 + x2)%Z /\ (x1 = x2 \/ x2 = (x1 + 1)%Z)}. Proof. -Intros x. -Elim (Z_modulo_2 x); Intros (y,Hy); Rewrite Zmult_sym in Hy; Rewrite <- Zplus_Zmult_2 in Hy. -Exists (y,y); Split. -Assumption. -Left; Reflexivity. -Exists (y,`y+1`); Split. -Rewrite Zplus_assoc; Assumption. -Right; Reflexivity. -Qed. +intros x. +elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy; + rewrite <- Zplus_diag_eq_mult_2 in Hy. +exists (y, y); split. +assumption. +left; reflexivity. +exists (y, (y + 1)%Z); split. +rewrite Zplus_assoc; assumption. +right; reflexivity. +Qed.
\ No newline at end of file diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v index 6eb668a5a..5cce66fc5 100644 --- a/theories/ZArith/Zhints.v +++ b/theories/ZArith/Zhints.v @@ -27,81 +27,80 @@ (* Lemmas involving positive and compare are not taken into account *) -Require BinInt. -Require Zorder. -Require Zmin. -Require Zabs. -Require Zcompare. -Require Znat. -Require auxiliary. -Require Zsyntax. -Require Zmisc. -Require Wf_Z. +Require Import BinInt. +Require Import Zorder. +Require Import Zmin. +Require Import Zabs. +Require Import Zcompare. +Require Import Znat. +Require Import auxiliary. +Require Import Zmisc. +Require Import Wf_Z. (**********************************************************************) (* Simplification lemmas *) (* No subgoal or smaller subgoals *) -Hints Resolve +Hint Resolve (* A) Reversible simplification lemmas (no loss of information) *) (* Should clearly declared as hints *) (* Lemmas ending by eq *) - Zeq_S (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *) + Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *) (* Lemmas ending by Zgt *) - Zgt_n_S (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *) - Zgt_Sn_n (* :(n:Z)`(Zs n) > n` *) - POS_gt_ZERO (* :(p:positive)`(POS p) > 0` *) - Zgt_reg_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *) - Zgt_reg_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *) + 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_n_Sn (* :(n:Z)`n < (Zs n)` *) - Zlt_n_S (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *) - Zlt_pred_n_n (* :(n:Z)`(Zpred n) < n` *) - Zlt_reg_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *) - Zlt_reg_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *) + 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 *) - ZERO_le_inj (* :(n:nat)`0 <= (inject_nat n)` *) - ZERO_le_POS (* :(p:positive)`0 <= (POS p)` *) - Zle_n (* :(n:Z)`n <= n` *) - Zle_n_Sn (* :(n:Z)`n <= (Zs n)` *) - Zle_n_S (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *) - Zle_pred_n (* :(n:Z)`(Zpred n) <= n` *) + 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` *) - Zle_reg_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *) - Zle_reg_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *) + 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|` *) (* B) Irreversible simplification lemmas : Probably to be declared as *) (* hints, when no other simplification is possible *) (* Lemmas ending by eq *) - Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *) - Zplus_simpl (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *) + BinInt.Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *) + Zplus_eq_compat (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *) (* Lemmas ending by Zge *) - Zge_Zmult_pos_right (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *) - Zge_Zmult_pos_left (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *) - Zge_Zmult_pos_compat (* : - (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *) + Zorder.Zmult_ge_compat_r (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *) + Zorder.Zmult_ge_compat_l (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *) + Zorder.Zmult_ge_compat (* : + (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *) (* Lemmas ending by Zlt *) - Zgt_ZERO_mult (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *) - Zlt_S (* :(n,m:Z)`n < m`->`n < (Zs m)` *) + 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 *) - Zle_ZERO_mult (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *) - Zle_Zmult_pos_right (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *) - Zle_Zmult_pos_left (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *) - OMEGA2 (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *) - Zle_le_S (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *) - Zle_plus_plus (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *) - -: zarith. + 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` *) + + : zarith. (**********************************************************************) (* Reversible lemmas relating operators *) @@ -384,4 +383,4 @@ inj_minus2: (x,y:nat)(gt y x)->`(inject_nat (minus x y)) = 0` Zred_factor5: (x,y:Z)`x*0+y = y` *) -(*i*) +(*i*)
\ No newline at end of file diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v index 2879fefe8..ba6d21c4d 100644 --- a/theories/ZArith/Zlogarithm.v +++ b/theories/ZArith/Zlogarithm.v @@ -20,161 +20,161 @@ - [Log_nearest]: [y= (Log_nearest x) iff 2^(y-1/2) < x <= 2^(y+1/2)] i.e. [Log_nearest x] is the integer nearest from [Log x] *) -Require ZArith_base. -Require Omega. -Require Zcomplements. -Require Zpower. -V7only [Import Z_scope.]. +Require Import ZArith_base. +Require Import Omega. +Require Import Zcomplements. +Require Import Zpower. Open Local Scope Z_scope. Section Log_pos. (* Log of positive integers *) (** First we build [log_inf] and [log_sup] *) -Fixpoint log_inf [p:positive] : Z := - Cases p of - xH => `0` (* 1 *) - | (xO q) => (Zs (log_inf q)) (* 2n *) - | (xI q) => (Zs (log_inf q)) (* 2n+1 *) +Fixpoint log_inf (p:positive) : Z := + match p with + | xH => 0 (* 1 *) + | xO q => Zsucc (log_inf q) (* 2n *) + | xI q => Zsucc (log_inf q) (* 2n+1 *) end. -Fixpoint log_sup [p:positive] : Z := - Cases p of - xH => `0` (* 1 *) - | (xO n) => (Zs (log_sup n)) (* 2n *) - | (xI n) => (Zs (Zs (log_inf n))) (* 2n+1 *) +Fixpoint log_sup (p:positive) : Z := + match p with + | xH => 0 (* 1 *) + | xO n => Zsucc (log_sup n) (* 2n *) + | xI n => Zsucc (Zsucc (log_inf n)) (* 2n+1 *) end. -Hints Unfold log_inf log_sup. +Hint Unfold log_inf log_sup. (** Then we give the specifications of [log_inf] and [log_sup] and prove their validity *) (*i Hints Resolve ZERO_le_S : zarith. i*) -Hints Resolve Zle_trans : zarith. - -Theorem log_inf_correct : (x:positive) ` 0 <= (log_inf x)` /\ - ` (two_p (log_inf x)) <= (POS x) < (two_p (Zs (log_inf x)))`. -Induction x; Intros; Simpl; -[ Elim H; Intros Hp HR; Clear H; Split; - [ Auto with zarith - | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p)); - Conditional Trivial Rewrite two_p_S; - Conditional Trivial Rewrite two_p_S in HR; - Rewrite (POS_xI p); Omega ] -| Elim H; Intros Hp HR; Clear H; Split; - [ Auto with zarith - | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p)); - Conditional Trivial Rewrite two_p_S; - Conditional Trivial Rewrite two_p_S in HR; - Rewrite (POS_xO p); Omega ] -| Unfold two_power_pos; Unfold shift_pos; Simpl; Omega -]. +Hint Resolve Zle_trans: zarith. + +Theorem log_inf_correct : + forall x:positive, + 0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)). +simple induction x; intros; simpl in |- *; + [ elim H; intros Hp HR; clear H; split; + [ auto with zarith + | conditional apply Zle_le_succ; trivial rewrite + two_p_S with (x := Zsucc (log_inf p)); + conditional trivial rewrite two_p_S; + conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xI p); + omega ] + | elim H; intros Hp HR; clear H; split; + [ auto with zarith + | conditional apply Zle_le_succ; trivial rewrite + two_p_S with (x := Zsucc (log_inf p)); + conditional trivial rewrite two_p_S; + conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xO p); + omega ] + | unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *; + omega ]. Qed. -Definition log_inf_correct1 := - [p:positive](proj1 ? ? (log_inf_correct p)). -Definition log_inf_correct2 := - [p:positive](proj2 ? ? (log_inf_correct p)). +Definition log_inf_correct1 (p:positive) := proj1 (log_inf_correct p). +Definition log_inf_correct2 (p:positive) := proj2 (log_inf_correct p). Opaque log_inf_correct1 log_inf_correct2. -Hints Resolve log_inf_correct1 log_inf_correct2 : zarith. +Hint Resolve log_inf_correct1 log_inf_correct2: zarith. -Lemma log_sup_correct1 : (p:positive)` 0 <= (log_sup p)`. -Induction p; Intros; Simpl; Auto with zarith. +Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p. +simple induction p; intros; simpl in |- *; auto with zarith. Qed. (** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)] either [(log_sup p)=(log_inf p)+1] *) -Theorem log_sup_log_inf : (p:positive) - IF (POS p)=(two_p (log_inf p)) - then (POS p)=(two_p (log_sup p)) - else ` (log_sup p)=(Zs (log_inf p))`. - -Induction p; Intros; -[ Elim H; Right; Simpl; - Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - Rewrite POS_xI; Unfold Zs; Omega -| Elim H; Clear H; Intro Hif; - [ 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; - Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - Rewrite POS_xO; Unfold Zs; Omega ] -| Left; Auto ]. +Theorem log_sup_log_inf : + forall p:positive, + IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p) + else log_sup p = Zsucc (log_inf p). + +simple induction p; intros; + [ elim H; right; simpl in |- *; + rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); + rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega + | elim H; clear H; intro Hif; + [ left; simpl in |- *; + rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); + rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0)); + rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); + auto + | right; simpl in |- *; + rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); + rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; + omega ] + | left; auto ]. Qed. -Theorem log_sup_correct2 : (x:positive) - ` (two_p (Zpred (log_sup x))) < (POS x) <= (two_p (log_sup x))`. +Theorem log_sup_correct2 : + forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x). -Intro. -Elim (log_sup_log_inf x). +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_n ]. -Intros (E1,E2); Rewrite E2. -Rewrite <- (Zpred_Sn (log_inf x)). -Generalize (log_inf_correct2 x); Omega. +intros [E1 E2]; rewrite E2. +split; [ apply two_p_pred; apply log_sup_correct1 | apply Zle_refl ]. +intros [E1 E2]; rewrite E2. +rewrite <- (Zpred_succ (log_inf x)). +generalize (log_inf_correct2 x); omega. Qed. -Lemma log_inf_le_log_sup : - (p:positive) `(log_inf p) <= (log_sup p)`. -Induction p; Simpl; Intros; Omega. +Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p. +simple induction p; simpl in |- *; intros; omega. Qed. -Lemma log_sup_le_Slog_inf : - (p:positive) `(log_sup p) <= (Zs (log_inf p))`. -Induction p; Simpl; Intros; Omega. +Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p). +simple induction p; simpl in |- *; intros; omega. Qed. (** Now it's possible to specify and build the [Log] rounded to the nearest *) -Fixpoint log_near[x:positive] : Z := - Cases x of - xH => `0` - | (xO xH) => `1` - | (xI xH) => `2` - | (xO y) => (Zs (log_near y)) - | (xI y) => (Zs (log_near y)) +Fixpoint log_near (x:positive) : Z := + match x with + | xH => 0 + | xO xH => 1 + | xI xH => 2 + | xO y => Zsucc (log_near y) + | xI y => Zsucc (log_near y) end. -Theorem log_near_correct1 : (p:positive)` 0 <= (log_near p)`. -Induction p; Simpl; Intros; -[Elim p0; Auto with zarith | Elim p0; Auto with zarith | Trivial with zarith ]. -Intros; Apply Zle_le_S. -Generalize H0; Elim p1; Intros; Simpl; - [ Assumption | Assumption | Apply ZERO_le_POS ]. -Intros; Apply Zle_le_S. -Generalize H0; Elim p1; Intros; Simpl; - [ Assumption | Assumption | Apply ZERO_le_POS ]. +Theorem log_near_correct1 : forall p:positive, 0 <= log_near p. +simple induction p; simpl in |- *; intros; + [ elim p0; auto with zarith + | elim p0; auto with zarith + | trivial with zarith ]. +intros; apply Zle_le_succ. +generalize H0; elim p1; intros; simpl in |- *; + [ assumption | assumption | apply Zorder.Zle_0_pos ]. +intros; apply Zle_le_succ. +generalize H0; elim p1; intros; simpl in |- *; + [ assumption | assumption | apply Zorder.Zle_0_pos ]. Qed. -Theorem log_near_correct2: (p:positive) - (log_near p)=(log_inf p) -\/(log_near p)=(log_sup p). -Induction p. -Intros p0 [Einf|Esup]. -Simpl. Rewrite Einf. -Case p0; [Left | Left | Right]; Reflexivity. -Simpl; Rewrite Esup. -Elim (log_sup_log_inf p0). -Generalize (log_inf_le_log_sup p0). -Generalize (log_sup_le_Slog_inf p0). -Case p0; Auto with zarith. -Intros; Omega. -Case p0; Intros; Auto with zarith. -Intros p0 [Einf|Esup]. -Simpl. -Repeat Rewrite Einf. -Case p0; Intros; Auto with zarith. -Simpl. -Repeat Rewrite Esup. -Case p0; Intros; Auto with zarith. -Auto. +Theorem log_near_correct2 : + forall p:positive, log_near p = log_inf p \/ log_near p = log_sup p. +simple induction p. +intros p0 [Einf| Esup]. +simpl in |- *. rewrite Einf. +case p0; [ left | left | right ]; reflexivity. +simpl in |- *; rewrite Esup. +elim (log_sup_log_inf p0). +generalize (log_inf_le_log_sup p0). +generalize (log_sup_le_Slog_inf p0). +case p0; auto with zarith. +intros; omega. +case p0; intros; auto with zarith. +intros p0 [Einf| Esup]. +simpl in |- *. +repeat rewrite Einf. +case p0; intros; auto with zarith. +simpl in |- *. +repeat rewrite Esup. +case p0; intros; auto with zarith. +auto. Qed. (*i****************** @@ -205,61 +205,55 @@ Section divers. (** Number of significative digits. *) -Definition N_digits := - [x:Z]Cases x of - (POS p) => (log_inf p) - | (NEG p) => (log_inf p) - | ZERO => `0` - end. - -Lemma ZERO_le_N_digits : (x:Z) ` 0 <= (N_digits x)`. -Induction x; Simpl; -[ Apply Zle_n -| Exact log_inf_correct1 -| Exact log_inf_correct1]. +Definition N_digits (x:Z) := + match x with + | Zpos p => log_inf p + | Zneg p => log_inf p + | Z0 => 0 + end. + +Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x. +simple induction x; simpl in |- *; + [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ]. Qed. -Lemma log_inf_shift_nat : - (n:nat)(log_inf (shift_nat n xH))=(inject_nat n). -Induction n; Intros; -[ Try Trivial -| Rewrite -> inj_S; Rewrite <- H; Reflexivity]. +Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n. +simple induction n; intros; + [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ]. Qed. -Lemma log_sup_shift_nat : - (n:nat)(log_sup (shift_nat n xH))=(inject_nat n). -Induction n; Intros; -[ Try Trivial -| Rewrite -> inj_S; Rewrite <- H; Reflexivity]. +Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n. +simple induction n; intros; + [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ]. Qed. (** [Is_power p] means that p is a power of two *) -Fixpoint Is_power[p:positive] : Prop := - Cases p of - xH => True - | (xO q) => (Is_power q) - | (xI q) => False +Fixpoint Is_power (p:positive) : Prop := + match p with + | xH => True + | xO q => Is_power q + | xI q => False end. Lemma Is_power_correct : - (p:positive) (Is_power p) <-> (Ex [y:nat](p=(shift_nat y xH))). - -Split; -[ Elim p; - [ Simpl; Tauto - | Simpl; Intros; Generalize (H H0); Intro H1; Elim H1; Intros y0 Hy0; - Exists (S y0); Rewrite Hy0; Reflexivity - | Intro; Exists O; Reflexivity] -| Intros; Elim H; Intros; Rewrite -> H0; Elim x; Intros; Simpl; Trivial]. + forall p:positive, Is_power p <-> ( exists y : nat | p = shift_nat y 1). + +split; + [ elim p; + [ simpl in |- *; tauto + | simpl in |- *; intros; generalize (H H0); intro H1; elim H1; + intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity + | intro; exists 0%nat; reflexivity ] + | intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ]. Qed. -Lemma Is_power_or : (p:positive) (Is_power p)\/~(Is_power p). -Induction p; -[ Intros; Right; Simpl; Tauto -| Intros; Elim H; - [ Intros; Left; Simpl; Exact H0 - | Intros; Right; Simpl; Exact H0] -| Left; Simpl; Trivial]. +Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p. +simple induction p; + [ intros; right; simpl in |- *; tauto + | intros; elim H; + [ intros; left; simpl in |- *; exact H0 + | intros; right; simpl in |- *; exact H0 ] + | left; simpl in |- *; trivial ]. Qed. End divers. @@ -269,4 +263,3 @@ End divers. - diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v index 01192c3bc..deab63392 100644 --- a/theories/ZArith/Zmin.v +++ b/theories/ZArith/Zmin.v @@ -9,94 +9,98 @@ (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *) -Require Arith. -Require BinInt. -Require Zcompare. -Require Zorder. +Require Import Arith. +Require Import BinInt. +Require Import Zcompare. +Require Import Zorder. Open Local Scope Z_scope. (**********************************************************************) (** Minimum on binary integer numbers *) -Definition Zmin := [n,m:Z] - <Z>Cases (Zcompare n m) of - EGAL => n - | INFERIEUR => n - | SUPERIEUR => m - end. +Definition Zmin (n m:Z) := + match n ?= m return Z with + | Eq => n + | Lt => n + | Gt => m + end. (** Properties of minimum on binary integer numbers *) -Lemma Zmin_SS : (n,m:Z)((Zs (Zmin n m))=(Zmin (Zs n) (Zs m))). +Lemma Zmin_SS : forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m). Proof. -Intros n m;Unfold Zmin; Rewrite (Zcompare_n_S n m); -(ElimCompare 'n 'm);Intros E;Rewrite E;Auto with arith. +intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m); + elim_compare n m; intros E; rewrite E; auto with arith. Qed. -Lemma Zle_min_l : (n,m:Z)(Zle (Zmin n m) n). +Lemma Zle_min_l : forall n m:Z, Zmin n m <= n. Proof. -Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E; - [ Apply Zle_n | Apply Zle_n | Apply Zlt_le_weak; Apply Zgt_lt;Exact E ]. +intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E; + [ apply Zle_refl + | apply Zle_refl + | apply Zlt_le_weak; apply Zgt_lt; exact E ]. Qed. -Lemma Zle_min_r : (n,m:Z)(Zle (Zmin n m) m). +Lemma Zle_min_r : forall n m:Z, Zmin n m <= m. Proof. -Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;[ - Unfold Zle ;Rewrite -> E;Discriminate -| Unfold Zle ;Rewrite -> E;Discriminate -| Apply Zle_n ]. +intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E; + [ unfold Zle in |- *; rewrite E; discriminate + | unfold Zle in |- *; rewrite E; discriminate + | apply Zle_refl ]. Qed. -Lemma Zmin_case : (n,m:Z)(P:Z->Set)(P n)->(P m)->(P (Zmin n m)). +Lemma Zmin_case : forall (n m:Z) (P:Z -> Set), P n -> P m -> P (Zmin n m). Proof. -Intros n m P H1 H2; Unfold Zmin; Case (Zcompare n m);Auto with arith. +intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith. Qed. -Lemma Zmin_or : (n,m:Z)(Zmin n m)=n \/ (Zmin n m)=m. +Lemma Zmin_or : forall n m:Z, Zmin n m = n \/ Zmin n m = m. Proof. -Unfold Zmin; Intros; Elim (Zcompare n m); Auto. +unfold Zmin in |- *; intros; elim (n ?= m); auto. Qed. -Lemma Zmin_n_n : (n:Z) (Zmin n n)=n. +Lemma Zmin_n_n : forall n:Z, Zmin n n = n. Proof. -Unfold Zmin; Intros; Elim (Zcompare n n); Auto. +unfold Zmin in |- *; intros; elim (n ?= n); auto. Qed. -Lemma Zmin_plus : - (x,y,n:Z)(Zmin (Zplus x n) (Zplus y n))=(Zplus (Zmin x y) n). +Lemma Zmin_plus : forall n m p:Z, Zmin (n + p) (m + p) = Zmin n m + p. Proof. -Intros x y n; Unfold Zmin. -Rewrite (Zplus_sym x n); -Rewrite (Zplus_sym y n); -Rewrite (Zcompare_Zplus_compatible x y n). -Case (Zcompare x y); Apply Zplus_sym. +intros x y n; unfold Zmin in |- *. +rewrite (Zplus_comm x n); rewrite (Zplus_comm y n); + rewrite (Zcompare_plus_compat x y n). +case (x ?= y); apply Zplus_comm. Qed. (**********************************************************************) (** Maximum of two binary integer numbers *) -V7only [ (* From Zdivides *) ]. -Definition Zmax := - [a, b : ?] Cases (Zcompare a b) of INFERIEUR => b | _ => a end. +Definition Zmax a b := match a ?= b with + | Lt => b + | _ => a + end. (** Properties of maximum on binary integer numbers *) -Tactic Definition CaseEq name := -Generalize (refl_equal ? name); Pattern -1 name; Case name. +Ltac CaseEq name := + generalize (refl_equal name); pattern name at -1 in |- *; case name. -Theorem Zmax1: (a, b : ?) (Zle a (Zmax a b)). +Theorem Zmax1 : forall a b, a <= Zmax a b. Proof. -Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith. -Unfold Zle; Intros H; Rewrite H; Red; Intros; Discriminate. +intros a b; unfold Zmax in |- *; CaseEq (a ?= b); simpl in |- *; + auto with zarith. +unfold Zle in |- *; intros H; rewrite H; red in |- *; intros; discriminate. Qed. -Theorem Zmax2: (a, b : ?) (Zle b (Zmax a b)). +Theorem Zmax2 : forall a b, b <= Zmax a b. Proof. -Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith. -Intros H; - (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate). -Intros H; - (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate). +intros a b; unfold Zmax in |- *; CaseEq (a ?= b); simpl in |- *; + auto with zarith. +intros H; + (case (Zle_or_lt b a); auto; unfold Zlt in |- *; rewrite H; intros; + discriminate). +intros H; + (case (Zle_or_lt b a); auto; unfold Zlt in |- *; rewrite H; intros; + discriminate). Qed. - diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v index a8bbcfc00..0ad0ef288 100644 --- a/theories/ZArith/Zmisc.v +++ b/theories/ZArith/Zmisc.v @@ -8,181 +8,90 @@ (*i $Id$ i*) -Require BinInt. -Require Zcompare. -Require Zorder. -Require Zsyntax. -Require Bool. -V7only [Import Z_scope.]. +Require Import BinInt. +Require Import Zcompare. +Require Import Zorder. +Require Import Bool. Open Local Scope Z_scope. (**********************************************************************) (** Iterators *) (** [n]th iteration of the function [f] *) -Fixpoint iter_nat[n:nat] : (A:Set)(f:A->A)A->A := - [A:Set][f:A->A][x:A] - Cases n of - O => x - | (S n') => (f (iter_nat n' A f x)) - end. +Fixpoint iter_nat (n:nat) (A:Set) (f:A -> A) (x:A) {struct n} : A := + match n with + | O => x + | S n' => f (iter_nat n' A f x) + end. -Fixpoint iter_pos[n:positive] : (A:Set)(f:A->A)A->A := - [A:Set][f:A->A][x:A] - Cases n of - xH => (f x) - | (xO n') => (iter_pos n' A f (iter_pos n' A f x)) - | (xI n') => (f (iter_pos n' A f (iter_pos n' A f x))) - end. +Fixpoint iter_pos (n:positive) (A:Set) (f:A -> A) (x:A) {struct n} : A := + match n with + | xH => f x + | xO n' => iter_pos n' A f (iter_pos n' A f x) + | xI n' => f (iter_pos n' A f (iter_pos n' A f x)) + end. -Definition iter := - [n:Z][A:Set][f:A->A][x:A]Cases n of - ZERO => x - | (POS p) => (iter_pos p A f x) - | (NEG p) => x +Definition iter (n:Z) (A:Set) (f:A -> A) (x:A) := + match n with + | Z0 => x + | Zpos p => iter_pos p A f x + | Zneg p => x end. Theorem iter_nat_plus : - (n,m:nat)(A:Set)(f:A->A)(x:A) - (iter_nat (plus n m) A f x)=(iter_nat n A f (iter_nat m A f x)). + forall (n m:nat) (A:Set) (f:A -> A) (x:A), + iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x). Proof. -Induction n; -[ Simpl; Auto with arith -| Intros; Simpl; Apply f_equal with f:=f; Apply H -]. +simple induction n; + [ simpl in |- *; auto with arith + | intros; simpl in |- *; apply f_equal with (f := f); apply H ]. Qed. -Theorem iter_convert : (n:positive)(A:Set)(f:A->A)(x:A) - (iter_pos n A f x) = (iter_nat (convert n) A f x). +Theorem iter_nat_of_P : + forall (p:positive) (A:Set) (f:A -> A) (x:A), + iter_pos p A f x = iter_nat (nat_of_P p) A f x. Proof. -Intro n; NewInduction n as [p H|p H|]; -[ Intros; Simpl; Rewrite -> (H A f x); - Rewrite -> (H A f (iter_nat (convert p) A f x)); - Rewrite -> (ZL6 p); Symmetry; Apply f_equal with f:=f; - Apply iter_nat_plus -| Intros; Unfold convert; Simpl; Rewrite -> (H A f x); - Rewrite -> (H A f (iter_nat (convert p) A f x)); - Rewrite -> (ZL6 p); Symmetry; - Apply iter_nat_plus -| Simpl; Auto with arith -]. +intro n; induction n as [p H| p H| ]; + [ intros; simpl in |- *; rewrite (H A f x); + rewrite (H A f (iter_nat (nat_of_P p) A f x)); + rewrite (ZL6 p); symmetry in |- *; apply f_equal with (f := f); + apply iter_nat_plus + | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x); + rewrite (H A f (iter_nat (nat_of_P p) A f x)); + rewrite (ZL6 p); symmetry in |- *; apply iter_nat_plus + | simpl in |- *; auto with arith ]. Qed. -Theorem iter_pos_add : - (n,m:positive)(A:Set)(f:A->A)(x:A) - (iter_pos (add n m) A f x)=(iter_pos n A f (iter_pos m A f x)). +Theorem iter_pos_plus : + forall (p q:positive) (A:Set) (f:A -> A) (x:A), + iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x). Proof. -Intros n m; Intros. -Rewrite -> (iter_convert m A f x). -Rewrite -> (iter_convert n A f (iter_nat (convert m) A f x)). -Rewrite -> (iter_convert (add n m) A f x). -Rewrite -> (convert_add n m). -Apply iter_nat_plus. +intros n m; intros. +rewrite (iter_nat_of_P m A f x). +rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)). +rewrite (iter_nat_of_P (n + m) A f x). +rewrite (nat_of_P_plus_morphism n m). +apply iter_nat_plus. Qed. (** Preservation of invariants : if [f : A->A] preserves the invariant [Inv], then the iterates of [f] also preserve it. *) Theorem iter_nat_invariant : - (n:nat)(A:Set)(f:A->A)(Inv:A->Prop) - ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_nat n A f x)). + forall (n:nat) (A:Set) (f:A -> A) (Inv:A -> Prop), + (forall x:A, Inv x -> Inv (f x)) -> + forall x:A, Inv x -> Inv (iter_nat n A f x). Proof. -Induction n; Intros; -[ Trivial with arith -| Simpl; Apply H0 with x:=(iter_nat n0 A f x); Apply H; Trivial with arith]. +simple induction n; intros; + [ trivial with arith + | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H; + trivial with arith ]. Qed. Theorem iter_pos_invariant : - (n:positive)(A:Set)(f:A->A)(Inv:A->Prop) - ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_pos n A f x)). + forall (p:positive) (A:Set) (f:A -> A) (Inv:A -> Prop), + (forall x:A, Inv x -> Inv (f x)) -> + forall x:A, Inv x -> Inv (iter_pos p A f x). Proof. -Intros; Rewrite iter_convert; Apply iter_nat_invariant; Trivial with arith. +intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith. Qed. - -V7only [ -(* Compatibility *) -Require Zbool. -Require Zeven. -Require Zabs. -Require Zmin. -Notation rename := rename. -Notation POS_xI := POS_xI. -Notation POS_xO := POS_xO. -Notation NEG_xI := NEG_xI. -Notation NEG_xO := NEG_xO. -Notation POS_add := POS_add. -Notation NEG_add := NEG_add. -Notation Zle_cases := Zle_cases. -Notation Zlt_cases := Zlt_cases. -Notation Zge_cases := Zge_cases. -Notation Zgt_cases := Zgt_cases. -Notation POS_gt_ZERO := POS_gt_ZERO. -Notation ZERO_le_POS := ZERO_le_POS. -Notation Zlt_ZERO_pred_le_ZERO := Zlt_ZERO_pred_le_ZERO. -Notation NEG_lt_ZERO := NEG_lt_ZERO. -Notation Zeven_not_Zodd := Zeven_not_Zodd. -Notation Zodd_not_Zeven := Zodd_not_Zeven. -Notation Zeven_Sn := Zeven_Sn. -Notation Zodd_Sn := Zodd_Sn. -Notation Zeven_pred := Zeven_pred. -Notation Zodd_pred := Zodd_pred. -Notation Zeven_div2 := Zeven_div2. -Notation Zodd_div2 := Zodd_div2. -Notation Zodd_div2_neg := Zodd_div2_neg. -Notation Z_modulo_2 := Z_modulo_2. -Notation Zsplit2 := Zsplit2. -Notation Zminus_Zplus_compatible := Zminus_Zplus_compatible. -Notation Zcompare_egal_dec := Zcompare_egal_dec. -Notation Zcompare_elim := Zcompare_elim. -Notation Zcompare_x_x := Zcompare_x_x. -Notation Zlt_not_eq := Zlt_not_eq. -Notation Zcompare_eq_case := Zcompare_eq_case. -Notation Zle_Zcompare := Zle_Zcompare. -Notation Zlt_Zcompare := Zlt_Zcompare. -Notation Zge_Zcompare := Zge_Zcompare. -Notation Zgt_Zcompare := Zgt_Zcompare. -Notation Zmin_plus := Zmin_plus. -Notation absolu_lt := absolu_lt. -Notation Zle_bool_imp_le := Zle_bool_imp_le. -Notation Zle_imp_le_bool := Zle_imp_le_bool. -Notation Zle_bool_refl := Zle_bool_refl. -Notation Zle_bool_antisym := Zle_bool_antisym. -Notation Zle_bool_trans := Zle_bool_trans. -Notation Zle_bool_plus_mono := Zle_bool_plus_mono. -Notation Zone_pos := Zone_pos. -Notation Zone_min_pos := Zone_min_pos. -Notation Zle_is_le_bool := Zle_is_le_bool. -Notation Zge_is_le_bool := Zge_is_le_bool. -Notation Zlt_is_le_bool := Zlt_is_le_bool. -Notation Zgt_is_le_bool := Zgt_is_le_bool. -Notation Zle_plus_swap := Zle_plus_swap. -Notation Zge_iff_le := Zge_iff_le. -Notation Zlt_plus_swap := Zlt_plus_swap. -Notation Zgt_iff_lt := Zgt_iff_lt. -Notation Zeq_plus_swap := Zeq_plus_swap. -(* Definitions *) -Notation entier_of_Z := entier_of_Z. -Notation Z_of_entier := Z_of_entier. -Notation Zle_bool := Zle_bool. -Notation Zge_bool := Zge_bool. -Notation Zlt_bool := Zlt_bool. -Notation Zgt_bool := Zgt_bool. -Notation Zeq_bool := Zeq_bool. -Notation Zneq_bool := Zneq_bool. -Notation Zeven := Zeven. -Notation Zodd := Zodd. -Notation Zeven_bool := Zeven_bool. -Notation Zodd_bool := Zodd_bool. -Notation Zeven_odd_dec := Zeven_odd_dec. -Notation Zeven_dec := Zeven_dec. -Notation Zodd_dec := Zodd_dec. -Notation Zdiv2_pos := Zdiv2_pos. -Notation Zdiv2 := Zdiv2. -Notation Zle_bool_total := Zle_bool_total. -Export Zbool. -Export Zeven. -Export Zabs. -Export Zmin. -Export Zorder. -Export Zcompare. -]. diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index fe53fce90..d9bc4d1b2 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -11,128 +11,128 @@ (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) Require Export Arith. -Require BinPos. -Require BinInt. -Require Zcompare. -Require Zorder. -Require Decidable. -Require Peano_dec. +Require Import BinPos. +Require Import BinInt. +Require Import Zcompare. +Require Import Zorder. +Require Import Decidable. +Require Import Peano_dec. Require Export Compare_dec. Open Local Scope Z_scope. -Definition neq := [x,y:nat] ~(x=y). +Definition neq (x y:nat) := x <> y. (**********************************************************************) (** Properties of the injection from nat into Z *) -Theorem inj_S : (y:nat) (inject_nat (S y)) = (Zs (inject_nat y)). +Theorem inj_S : forall n:nat, Z_of_nat (S n) = Zsucc (Z_of_nat n). Proof. -Intro y; NewInduction y as [|n H]; [ - Unfold Zs ; Simpl; Trivial with arith -| Change (POS (add_un (anti_convert n)))=(Zs (inject_nat (S n))); - Rewrite add_un_Zs; Trivial with arith]. +intro y; induction y as [| n H]; + [ unfold Zsucc in |- *; simpl in |- *; trivial with arith + | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *; + rewrite Zpos_succ_morphism; trivial with arith ]. Qed. -Theorem inj_plus : - (x,y:nat) (inject_nat (plus x y)) = (Zplus (inject_nat x) (inject_nat y)). +Theorem inj_plus : forall n m:nat, Z_of_nat (n + m) = Z_of_nat n + Z_of_nat m. Proof. -Intro x; NewInduction x as [|n H]; Intro y; NewDestruct y as [|m]; [ - Simpl; Trivial with arith -| Simpl; Trivial with arith -| Simpl; Rewrite <- plus_n_O; Trivial with arith -| Change (inject_nat (S (plus n (S m))))= - (Zplus (inject_nat (S n)) (inject_nat (S m))); - Rewrite inj_S; Rewrite H; Do 2 Rewrite inj_S; Rewrite Zplus_S_n; Trivial with arith]. +intro x; induction x as [| n H]; intro y; destruct y as [| m]; + [ simpl in |- *; trivial with arith + | simpl in |- *; trivial with arith + | simpl in |- *; rewrite <- plus_n_O; trivial with arith + | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *; + rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l; + trivial with arith ]. Qed. -Theorem inj_mult : - (x,y:nat) (inject_nat (mult x y)) = (Zmult (inject_nat x) (inject_nat y)). +Theorem inj_mult : forall n m:nat, Z_of_nat (n * m) = Z_of_nat n * Z_of_nat m. Proof. -Intro x; NewInduction x as [|n H]; [ - Simpl; Trivial with arith -| Intro y; Rewrite -> inj_S; Rewrite <- Zmult_Sm_n; - Rewrite <- H;Rewrite <- inj_plus; Simpl; Rewrite plus_sym; Trivial with arith]. +intro x; induction x as [| n H]; + [ simpl in |- *; trivial with arith + | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H; + rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; + trivial with arith ]. Qed. -Theorem inj_neq: - (x,y:nat) (neq x y) -> (Zne (inject_nat x) (inject_nat y)). +Theorem inj_neq : forall n m:nat, neq n m -> Zne (Z_of_nat n) (Z_of_nat m). Proof. -Unfold neq Zne not ; Intros x y H1 H2; Apply H1; Generalize H2; -Case x; Case y; Intros; [ - Auto with arith -| Discriminate H0 -| Discriminate H0 -| Simpl in H0; Injection H0; Do 2 Rewrite <- bij1; Intros E; Rewrite E; Auto with arith]. +unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2; + case x; case y; intros; + [ auto with arith + | discriminate H0 + | discriminate H0 + | simpl in H0; injection H0; + do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; + intros E; rewrite E; auto with arith ]. Qed. -Theorem inj_le: - (x,y:nat) (le x y) -> (Zle (inject_nat x) (inject_nat y)). +Theorem inj_le : forall n m:nat, (n <= m)%nat -> Z_of_nat n <= Z_of_nat m. Proof. -Intros x y; Intros H; Elim H; [ - Unfold Zle ; Elim (Zcompare_EGAL (inject_nat x) (inject_nat x)); - Intros H1 H2; Rewrite H2; [ Discriminate | Trivial with arith] -| Intros m H1 H2; Apply Zle_trans with (inject_nat m); - [Assumption | Rewrite inj_S; Apply Zle_n_Sn]]. +intros x y; intros H; elim H; + [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x)); + intros H1 H2; rewrite H2; [ discriminate | trivial with arith ] + | intros m H1 H2; apply Zle_trans with (Z_of_nat m); + [ assumption | rewrite inj_S; apply Zle_succ ] ]. Qed. -Theorem inj_lt: (x,y:nat) (lt x y) -> (Zlt (inject_nat x) (inject_nat y)). +Theorem inj_lt : forall n m:nat, (n < m)%nat -> Z_of_nat n < Z_of_nat m. Proof. -Intros x y H; Apply Zgt_lt; Apply Zle_S_gt; Rewrite <- inj_S; Apply inj_le; -Exact H. +intros x y H; apply Zgt_lt; apply Zlt_succ_gt; rewrite <- inj_S; apply inj_le; + exact H. Qed. -Theorem inj_gt: (x,y:nat) (gt x y) -> (Zgt (inject_nat x) (inject_nat y)). +Theorem inj_gt : forall n m:nat, (n > m)%nat -> Z_of_nat n > Z_of_nat m. Proof. -Intros x y H; Apply Zlt_gt; Apply inj_lt; Exact H. +intros x y H; apply Zlt_gt; apply inj_lt; exact H. Qed. -Theorem inj_ge: (x,y:nat) (ge x y) -> (Zge (inject_nat x) (inject_nat y)). +Theorem inj_ge : forall n m:nat, (n >= m)%nat -> Z_of_nat n >= Z_of_nat m. Proof. -Intros x y H; Apply Zle_ge; Apply inj_le; Apply H. +intros x y H; apply Zle_ge; apply inj_le; apply H. Qed. -Theorem inj_eq: (x,y:nat) x=y -> (inject_nat x) = (inject_nat y). +Theorem inj_eq : forall n m:nat, n = m -> Z_of_nat n = Z_of_nat m. Proof. -Intros x y H; Rewrite H; Trivial with arith. +intros x y H; rewrite H; trivial with arith. Qed. -Theorem intro_Z : - (x:nat) (EX y:Z | (inject_nat x)=y /\ - (Zle ZERO (Zplus (Zmult y (POS xH)) ZERO))). +Theorem intro_Z : + forall n:nat, exists y : Z | Z_of_nat n = y /\ 0 <= y * 1 + 0. Proof. -Intros x; Exists (inject_nat x); Split; [ - Trivial with arith -| Rewrite Zmult_sym; Rewrite Zmult_one; Rewrite Zero_right; - Unfold Zle ; Elim x; Intros;Simpl; Discriminate ]. +intros x; exists (Z_of_nat x); split; + [ trivial with arith + | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r; + unfold Zle in |- *; elim x; intros; simpl in |- *; + discriminate ]. Qed. Theorem inj_minus1 : - (x,y:nat) (le y x) -> - (inject_nat (minus x y)) = (Zminus (inject_nat x) (inject_nat y)). + forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m. Proof. -Intros x y H; Apply (Zsimpl_plus_l (inject_nat y)); Unfold Zminus ; -Rewrite Zplus_permute; Rewrite Zplus_inverse_r; Rewrite <- inj_plus; -Rewrite <- (le_plus_minus y x H);Rewrite Zero_right; Trivial with arith. +intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *; + rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus; + rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; + trivial with arith. Qed. -Theorem inj_minus2: (x,y:nat) (gt y x) -> (inject_nat (minus x y)) = ZERO. +Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0. Proof. -Intros x y H; Rewrite inj_minus_aux; [ Trivial with arith | Apply gt_not_le; Assumption]. +intros x y H; rewrite not_le_minus_0; + [ trivial with arith | apply gt_not_le; assumption ]. Qed. -V7only [ (* From Zdivides *) ]. -Theorem POS_inject: (x : positive) (POS x) = (inject_nat (convert x)). +Theorem Zpos_eq_Z_of_nat_o_nat_of_P : + forall p:positive, Zpos p = Z_of_nat (nat_of_P p). Proof. -Intros x; Elim x; Simpl; Auto. -Intros p H; Rewrite ZL6. -Apply f_equal with f := POS. -Apply convert_intro. -Rewrite bij1; Unfold convert; Simpl. -Rewrite ZL6; Auto. -Intros p H; Unfold convert; Simpl. -Rewrite ZL6; Simpl. -Rewrite inj_plus; Repeat Rewrite <- H. -Rewrite POS_xO; Simpl; Rewrite add_x_x; Reflexivity. +intros x; elim x; simpl in |- *; auto. +intros p H; rewrite ZL6. +apply f_equal with (f := Zpos). +apply nat_of_P_inj. +rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *; + simpl in |- *. +rewrite ZL6; auto. +intros p H; unfold nat_of_P in |- *; simpl in |- *. +rewrite ZL6; simpl in |- *. +rewrite inj_plus; repeat rewrite <- H. +rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity. Qed. - diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index dfe1c31fd..ed6272c44 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -8,11 +8,10 @@ (*i $Id$ i*) -Require ZArith_base. -Require ZArithRing. -Require Zcomplements. -Require Zdiv. -V7only [Import Z_scope.]. +Require Import ZArith_base. +Require Import ZArithRing. +Require Import Zcomplements. +Require Import Zdiv. Open Local Scope Z_scope. (** This file contains some notions of number theory upon Z numbers: @@ -26,176 +25,173 @@ Open Local Scope Z_scope. (** * Divisibility *) -Inductive Zdivide [a,b:Z] : Prop := - Zdivide_intro : (q:Z) `b = q * a` -> (Zdivide a b). +Inductive Zdivide (a b:Z) : Prop := + Zdivide_intro : forall q:Z, b = q * a -> Zdivide a b. (** Syntax for divisibility *) -Notation "( a | b )" := (Zdivide a b) - (at level 0, a,b at level 10) : Z_scope - V8only (at level 0, a,b at level 250). +Notation "( a | b )" := (Zdivide a b) (at level 0, a, b at level 250) : + Z_scope. (** Results concerning divisibility*) -Lemma Zdivide_refl : (a:Z) (a|a). +Lemma Zdivide_refl : forall a:Z, (a | a). Proof. -Intros; Apply Zdivide_intro with `1`; Ring. -Save. +intros; apply Zdivide_intro with 1; ring. +Qed. -Lemma Zone_divide : (a:Z) (1|a). +Lemma Zone_divide : forall a:Z, (1 | a). Proof. -Intros; Apply Zdivide_intro with `a`; Ring. -Save. +intros; apply Zdivide_intro with a; ring. +Qed. -Lemma Zdivide_0 : (a:Z) (a|0). +Lemma Zdivide_0 : forall a:Z, (a | 0). Proof. -Intros; Apply Zdivide_intro with `0`; Ring. -Save. +intros; apply Zdivide_intro with 0; ring. +Qed. -Hints Resolve Zdivide_refl Zone_divide Zdivide_0 : zarith. +Hint Resolve Zdivide_refl Zone_divide Zdivide_0: zarith. -Lemma Zdivide_mult_left : (a,b,c:Z) (a|b) -> (`c*a`|`c*b`). +Lemma Zmult_divide_compat_l : forall a b c:Z, (a | b) -> (c * a | c * b). Proof. -Induction 1; Intros; Apply Zdivide_intro with q. -Rewrite H0; Ring. -Save. +simple induction 1; intros; apply Zdivide_intro with q. +rewrite H0; ring. +Qed. -Lemma Zdivide_mult_right : (a,b,c:Z) (a|b) -> (`a*c`|`b*c`). +Lemma Zmult_divide_compat_r : forall a b c:Z, (a | b) -> (a * c | b * c). Proof. -Intros a b c; Rewrite (Zmult_sym a c); Rewrite (Zmult_sym b c). -Apply Zdivide_mult_left; Trivial. -Save. +intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c). +apply Zmult_divide_compat_l; trivial. +Qed. -Hints Resolve Zdivide_mult_left Zdivide_mult_right : zarith. +Hint Resolve Zmult_divide_compat_l Zmult_divide_compat_r: zarith. -Lemma Zdivide_plus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b+c`). +Lemma Zdivide_plus_r : forall a b c:Z, (a | b) -> (a | c) -> (a | b + c). Proof. -Induction 1; Intros q Hq; Induction 1; Intros q' Hq'. -Apply Zdivide_intro with `q+q'`. -Rewrite Hq; Rewrite Hq'; Ring. -Save. +simple induction 1; intros q Hq; simple induction 1; intros q' Hq'. +apply Zdivide_intro with (q + q'). +rewrite Hq; rewrite Hq'; ring. +Qed. -Lemma Zdivide_opp : (a,b:Z) (a|b) -> (a|`-b`). +Lemma Zdivide_opp_r : forall a b:Z, (a | b) -> (a | - b). Proof. -Induction 1; Intros; Apply Zdivide_intro with `-q`. -Rewrite H0; Ring. -Save. +simple induction 1; intros; apply Zdivide_intro with (- q). +rewrite H0; ring. +Qed. -Lemma Zdivide_opp_rev : (a,b:Z) (a|`-b`) -> (a| b). +Lemma Zdivide_opp_r_rev : forall a b:Z, (a | - b) -> (a | b). Proof. -Intros; Replace b with `-(-b)`. Apply Zdivide_opp; Trivial. Ring. -Save. +intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring. +Qed. -Lemma Zdivide_opp_left : (a,b:Z) (a|b) -> (`-a`|b). +Lemma Zdivide_opp_l : forall a b:Z, (a | b) -> (- a | b). Proof. -Induction 1; Intros; Apply Zdivide_intro with `-q`. -Rewrite H0; Ring. -Save. +simple induction 1; intros; apply Zdivide_intro with (- q). +rewrite H0; ring. +Qed. -Lemma Zdivide_opp_left_rev : (a,b:Z) (`-a`|b) -> (a|b). +Lemma Zdivide_opp_l_rev : forall a b:Z, (- a | b) -> (a | b). Proof. -Intros; Replace a with `-(-a)`. Apply Zdivide_opp_left; Trivial. Ring. -Save. +intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring. +Qed. -Lemma Zdivide_minus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b-c`). +Lemma Zdivide_minus_l : forall a b c:Z, (a | b) -> (a | c) -> (a | b - c). Proof. -Induction 1; Intros q Hq; Induction 1; Intros q' Hq'. -Apply Zdivide_intro with `q-q'`. -Rewrite Hq; Rewrite Hq'; Ring. -Save. +simple induction 1; intros q Hq; simple induction 1; intros q' Hq'. +apply Zdivide_intro with (q - q'). +rewrite Hq; rewrite Hq'; ring. +Qed. -Lemma Zdivide_left : (a,b,c:Z) (a|b) -> (a|`b*c`). +Lemma Zdivide_mult_l : forall a b c:Z, (a | b) -> (a | b * c). Proof. -Induction 1; Intros q Hq; Apply Zdivide_intro with `q*c`. -Rewrite Hq; Ring. -Save. +simple induction 1; intros q Hq; apply Zdivide_intro with (q * c). +rewrite Hq; ring. +Qed. -Lemma Zdivide_right : (a,b,c:Z) (a|c) -> (a|`b*c`). +Lemma Zdivide_mult_r : forall a b c:Z, (a | c) -> (a | b * c). Proof. -Induction 1; Intros q Hq; Apply Zdivide_intro with `q*b`. -Rewrite Hq; Ring. -Save. +simple induction 1; intros q Hq; apply Zdivide_intro with (q * b). +rewrite Hq; ring. +Qed. -Lemma Zdivide_a_ab : (a,b:Z) (a|`a*b`). +Lemma Zdivide_factor_r : forall a b:Z, (a | a * b). Proof. -Intros; Apply Zdivide_intro with b; Ring. -Save. +intros; apply Zdivide_intro with b; ring. +Qed. -Lemma Zdivide_a_ba : (a,b:Z) (a|`b*a`). +Lemma Zdivide_factor_l : forall a b:Z, (a | b * a). Proof. -Intros; Apply Zdivide_intro with b; Ring. -Save. +intros; apply Zdivide_intro with b; ring. +Qed. -Hints Resolve Zdivide_plus Zdivide_opp Zdivide_opp_rev - Zdivide_opp_left Zdivide_opp_left_rev - Zdivide_minus Zdivide_left Zdivide_right - Zdivide_a_ab Zdivide_a_ba : 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. (** Auxiliary result. *) -Lemma Zmult_one : - (x,y:Z) `x>=0` -> `x*y=1` -> `x=1`. +Lemma Zmult_one : forall x y:Z, x >= 0 -> x * y = 1 -> x = 1. Proof. -Intros x y H H0; NewDestruct (Zmult_1_inversion_l ? ? H0) as [Hpos|Hneg]. - Assumption. - Rewrite Hneg in H; Simpl in H. - Contradiction (Zle_not_lt `0` `-1`). - Apply Zge_le; Assumption. - Apply NEG_lt_ZERO. -Save. +intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg]. + assumption. + rewrite Hneg in H; simpl in H. + contradiction (Zle_not_lt 0 (-1)). + apply Zge_le; assumption. + apply Zorder.Zlt_neg_0. +Qed. (** Only [1] and [-1] divide [1]. *) -Lemma Zdivide_1 : (x:Z) (x|1) -> `x=1` \/ `x=-1`. +Lemma Zdivide_1 : forall x:Z, (x | 1) -> x = 1 \/ x = -1. Proof. -Induction 1; Intros. -Elim (Z_lt_ge_dec `0` x); [Left|Right]. -Apply Zmult_one with q; Auto with zarith; Rewrite H0; Ring. -Assert `(-x) = 1`; Auto with zarith. -Apply Zmult_one with (-q); Auto with zarith; Rewrite H0; Ring. -Save. +simple induction 1; intros. +elim (Z_lt_ge_dec 0 x); [ left | right ]. +apply Zmult_one with q; auto with zarith; rewrite H0; ring. +assert (- x = 1); auto with zarith. +apply Zmult_one with (- q); auto with zarith; rewrite H0; ring. +Qed. (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *) -Lemma Zdivide_antisym : (a,b:Z) (a|b) -> (b|a) -> `a=b` \/ `a=-b`. -Proof. -Induction 1; Intros. -Inversion H1. -Rewrite H0 in H2; Clear H H1. -Case (Z_zerop a); Intro. -Left; Rewrite H0; Rewrite e; Ring. -Assert Hqq0: `q0*q = 1`. -Apply Zmult_reg_left with a. -Assumption. -Ring. -Pattern 2 a; Rewrite H2; Ring. -Assert (q|1). -Rewrite <- Hqq0; Auto with zarith. -Elim (Zdivide_1 q H); Intros. -Rewrite H1 in H0; Left; Omega. -Rewrite H1 in H0; Right; Omega. -Save. +Lemma Zdivide_antisym : forall a b:Z, (a | b) -> (b | a) -> a = b \/ a = - b. +Proof. +simple induction 1; intros. +inversion H1. +rewrite H0 in H2; clear H H1. +case (Z_zerop a); intro. +left; rewrite H0; rewrite e; ring. +assert (Hqq0 : q0 * q = 1). +apply Zmult_reg_l with a. +assumption. +ring. +pattern a at 2 in |- *; rewrite H2; ring. +assert (q | 1). +rewrite <- Hqq0; auto with zarith. +elim (Zdivide_1 q H); intros. +rewrite H1 in H0; left; omega. +rewrite H1 in H0; right; omega. +Qed. (** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *) -Lemma Zdivide_bounds : (a,b:Z) (a|b) -> `b<>0` -> `|a| <= |b|`. -Proof. -Induction 1; Intros. -Assert `|b|=|q|*|a|`. - Subst; Apply Zabs_Zmult. -Rewrite H2. -Assert H3 := (Zabs_pos q). -Assert H4 := (Zabs_pos a). -Assert `|q|*|a|>=1*|a|`; Auto with zarith. -Apply Zge_Zmult_pos_compat; Auto with zarith. -Elim (Z_lt_ge_dec `|q|` `1`); [ Intros | Auto with zarith ]. -Assert `|q|=0`. - Omega. -Assert `q=0`. - Rewrite <- (Zabs_Zsgn q). -Rewrite H5; Auto with zarith. -Subst q; Omega. -Save. +Lemma Zdivide_bounds : forall a b:Z, (a | b) -> b <> 0 -> Zabs a <= Zabs b. +Proof. +simple induction 1; intros. +assert (Zabs b = Zabs q * Zabs a). + subst; apply Zabs_Zmult. +rewrite H2. +assert (H3 := Zabs_pos q). +assert (H4 := Zabs_pos a). +assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith. +apply Zmult_ge_compat; auto with zarith. +elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ]. +assert (Zabs q = 0). + omega. +assert (q = 0). + rewrite <- (Zabs_Zsgn q). +rewrite H5; auto with zarith. +subst q; omega. +Qed. (** * Greatest common divisor (gcd). *) @@ -203,53 +199,54 @@ Save. expressing that [d] is a gcd of [a] and [b]. (We show later that the [gcd] is actually unique if we discard its sign.) *) -Inductive gcd [a,b,d:Z] : Prop := - gcd_intro : - (d|a) -> (d|b) -> ((x:Z) (x|a) -> (x|b) -> (x|d)) -> (gcd a b d). +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. (** Trivial properties of [gcd] *) -Lemma gcd_sym : (a,b,d:Z)(gcd a b d) -> (gcd b a d). +Lemma Zis_gcd_sym : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a d. Proof. -Induction 1; Constructor; Intuition. -Save. +simple induction 1; constructor; intuition. +Qed. -Lemma gcd_0 : (a:Z)(gcd a `0` a). +Lemma Zis_gcd_0 : forall a:Z, Zis_gcd a 0 a. Proof. -Constructor; Auto with zarith. -Save. +constructor; auto with zarith. +Qed. -Lemma gcd_minus :(a,b,d:Z)(gcd a `-b` d) -> (gcd b a d). +Lemma Zis_gcd_minus : forall a b d:Z, Zis_gcd a (- b) d -> Zis_gcd b a d. Proof. -Induction 1; Constructor; Intuition. -Save. +simple induction 1; constructor; intuition. +Qed. -Lemma gcd_opp :(a,b,d:Z)(gcd a b d) -> (gcd b a `-d`). +Lemma Zis_gcd_opp : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a (- d). Proof. -Induction 1; Constructor; Intuition. -Save. +simple induction 1; constructor; intuition. +Qed. -Hints Resolve gcd_sym gcd_0 gcd_minus gcd_opp : zarith. +Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith. (** * Extended Euclid algorithm. *) (** Euclid's algorithm to compute the [gcd] mainly relies on the following property. *) -Lemma gcd_for_euclid : - (a,b,d,q:Z) (gcd b `a-q*b` d) -> (gcd a b d). +Lemma Zis_gcd_for_euclid : + forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d. Proof. -Induction 1; Constructor; Intuition. -Replace a with `a-q*b+q*b`. Auto with zarith. Ring. -Save. +simple induction 1; constructor; intuition. +replace a with (a - q * b + q * b). auto with zarith. ring. +Qed. -Lemma gcd_for_euclid2 : - (b,d,q,r:Z) (gcd r b d) -> (gcd b `b*q+r` d). +Lemma Zis_gcd_for_euclid2 : + forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d. Proof. -Induction 1; Constructor; Intuition. -Apply H2; Auto. -Replace r with `b*q+r-b*q`. Auto with zarith. Ring. -Save. +simple induction 1; constructor; intuition. +apply H2; auto. +replace r with (b * q + r - b * q). auto with zarith. ring. +Qed. (** We implement the extended version of Euclid's algorithm, i.e. the one computing Bezout's coefficients as it computes @@ -258,14 +255,14 @@ Save. Section extended_euclid_algorithm. -Variable a,b : Z. +Variables a b : Z. (** The specification of Euclid's algorithm is the existence of [u], [v] and [d] such that [ua+vb=d] and [(gcd a b d)]. *) Inductive Euclid : Set := - Euclid_intro : - (u,v,d:Z) `u*a+v*b=d` -> (gcd a b d) -> Euclid. + Euclid_intro : + forall u v d:Z, u * a + v * b = d -> Zis_gcd a b d -> Euclid. (** The recursive part of Euclid's algorithm uses well-founded recursion of non-negative integers. It maintains 6 integers @@ -274,356 +271,371 @@ Inductive Euclid : Set := *) Lemma euclid_rec : - (v3:Z) `0 <= v3` -> (u1,u2,u3,v1,v2:Z) `u1*a+u2*b=u3` -> `v1*a+v2*b=v3` -> - ((d:Z)(gcd u3 v3 d) -> (gcd a b d)) -> Euclid. -Proof. -Intros v3 Hv3; Generalize Hv3; Pattern v3. -Apply Z_lt_rec. -Clear v3 Hv3; Intros. -Elim (Z_zerop x); Intro. -Apply Euclid_intro with u:=u1 v:=u2 d:=u3. -Assumption. -Apply H2. -Rewrite a0; Auto with zarith. -LetTac q := (Zdiv u3 x). -Assert Hq: `0 <= u3-q*x < x`. -Replace `u3-q*x` with `u3%x`. -Apply Z_mod_lt; Omega. -Assert xpos : `x > 0`. Omega. -Generalize (Z_div_mod_eq u3 x xpos). -Unfold q. -Intro eq; Pattern 2 u3; Rewrite eq; Ring. -Apply (H `u3-q*x` Hq (proj1 ? ? Hq) v1 v2 x `u1-q*v1` `u2-q*v2`). -Tauto. -Replace `(u1-q*v1)*a+(u2-q*v2)*b` with `(u1*a+u2*b)-q*(v1*a+v2*b)`. -Rewrite H0; Rewrite H1; Trivial. -Ring. -Intros; Apply H2. -Apply gcd_for_euclid with q; Assumption. -Assumption. -Save. + forall v3:Z, + 0 <= v3 -> + forall u1 u2 u3 v1 v2:Z, + u1 * a + u2 * b = u3 -> + v1 * a + v2 * b = v3 -> + (forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid. +Proof. +intros v3 Hv3; generalize Hv3; pattern v3 in |- *. +apply Z_lt_rec. +clear v3 Hv3; intros. +elim (Z_zerop x); intro. +apply Euclid_intro with (u := u1) (v := u2) (d := u3). +assumption. +apply H2. +rewrite a0; auto with zarith. +set (q := u3 / x) in *. +assert (Hq : 0 <= u3 - q * x < x). +replace (u3 - q * x) with (u3 mod x). +apply Z_mod_lt; omega. +assert (xpos : x > 0). omega. +generalize (Z_div_mod_eq u3 x xpos). +unfold q in |- *. +intro eq; pattern u3 at 2 in |- *; rewrite eq; ring. +apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)). +tauto. +replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with + (u1 * a + u2 * b - q * (v1 * a + v2 * b)). +rewrite H0; rewrite H1; trivial. +ring. +intros; apply H2. +apply Zis_gcd_for_euclid with q; assumption. +assumption. +Qed. (** We get Euclid's algorithm by applying [euclid_rec] on [1,0,a,0,1,b] when [b>=0] and [1,0,a,0,-1,-b] when [b<0]. *) Lemma euclid : Euclid. Proof. -Case (Z_le_gt_dec `0` b); Intro. -Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a - v1:=`0` v2:=`1` v3:=b; -Auto with zarith; Ring. -Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a - v1:=`0` v2:=`-1` v3:=`-b`; -Auto with zarith; Try Ring. -Save. +case (Z_le_gt_dec 0 b); intro. +intros; + apply euclid_rec with + (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := 1) (v3 := b); + auto with zarith; ring. +intros; + apply euclid_rec with + (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := -1) (v3 := - b); + auto with zarith; try ring. +Qed. End extended_euclid_algorithm. -Theorem gcd_uniqueness_apart_sign : - (a,b,d,d':Z) (gcd a b d) -> (gcd a b d') -> `d = d'` \/ `d = -d'`. +Theorem Zis_gcd_uniqueness_apart_sign : + forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'. Proof. -Induction 1. -Intros H1 H2 H3; 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). -Save. +simple induction 1. +intros H1 H2 H3; simple induction 1; intros. +generalize (H3 d' H4 H5); intro Hd'd. +generalize (H6 d H1 H2); intro Hdd'. +exact (Zdivide_antisym d d' Hdd' Hd'd). +Qed. (** * Bezout's coefficients *) -Inductive Bezout [a,b,d:Z] : Prop := - Bezout_intro : (u,v:Z) `u*a + v*b = d` -> (Bezout a b d). +Inductive Bezout (a b d:Z) : Prop := + Bezout_intro : forall u v:Z, u * a + v * b = d -> Bezout a b d. (** Existence of Bezout's coefficients for the [gcd] of [a] and [b] *) -Lemma gcd_bezout : (a,b,d:Z) (gcd a b d) -> (Bezout a b d). +Lemma Zis_gcd_bezout : forall a b d:Z, Zis_gcd a b d -> Bezout a b d. Proof. -Intros a b d Hgcd. -Elim (euclid a b); Intros u v d0 e g. -Generalize (gcd_uniqueness_apart_sign a b d d0 Hgcd g). -Intro H; Elim H; Clear H; Intros. -Apply Bezout_intro with u v. -Rewrite H; Assumption. -Apply Bezout_intro with `-u` `-v`. -Rewrite H; Rewrite <- e; Ring. -Save. +intros a b d Hgcd. +elim (euclid a b); intros u v d0 e g. +generalize (Zis_gcd_uniqueness_apart_sign a b d d0 Hgcd g). +intro H; elim H; clear H; intros. +apply Bezout_intro with u v. +rewrite H; assumption. +apply Bezout_intro with (- u) (- v). +rewrite H; rewrite <- e; ring. +Qed. (** gcd of [ca] and [cb] is [c gcd(a,b)]. *) -Lemma gcd_mult : (a,b,c,d:Z) (gcd a b d) -> (gcd `c*a` `c*b` `c*d`). -Proof. -Intros a b c d; Induction 1; Constructor; Intuition. -Elim (gcd_bezout a b d H); Intros. -Elim H3; Intros. -Elim H4; Intros. -Apply Zdivide_intro with `u*q+v*q0`. -Rewrite <- H5. -Replace `c*(u*a+v*b)` with `u*(c*a)+v*(c*b)`. -Rewrite H6; Rewrite H7; Ring. -Ring. -Save. +Lemma Zis_gcd_mult : + forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d). +Proof. +intros a b c d; simple induction 1; constructor; intuition. +elim (Zis_gcd_bezout a b d H); intros. +elim H3; intros. +elim H4; intros. +apply Zdivide_intro with (u * q + v * q0). +rewrite <- H5. +replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)). +rewrite H6; rewrite H7; ring. +ring. +Qed. (** We could obtain a [Zgcd] function via [euclid]. But we propose here a more direct version of a [Zgcd], with better extraction (no bezout coeffs). *) -Definition Zgcd_pos : (a:Z)`0<=a` -> (b:Z) - { g:Z | `0<=a` -> (gcd a b g) /\ `g>=0` }. -Proof. -Intros a Ha. -Apply (Z_lt_rec [a:Z](b:Z) { g:Z | `0<=a` -> (gcd a b g) /\`g>=0` }); Try Assumption. -Intro x; Case x. -Intros _ b; Exists (Zabs b). - Elim (Z_le_lt_eq_dec ? ? (Zabs_pos b)). - Intros H0; Split. - Apply Zabs_ind. - Intros; Apply gcd_sym; Apply gcd_0; Auto. - Intros; Apply gcd_opp; Apply gcd_0; Auto. - Auto with zarith. +Definition Zgcd_pos : + forall a:Z, + 0 <= a -> forall b:Z, {g : Z | 0 <= a -> Zis_gcd a b g /\ g >= 0}. +Proof. +intros a Ha. +apply + (Z_lt_rec + (fun a:Z => forall b:Z, {g : Z | 0 <= a -> Zis_gcd a b g /\ g >= 0})); + try assumption. +intro x; case x. +intros _ b; exists (Zabs b). + elim (Z_le_lt_eq_dec _ _ (Zabs_pos b)). + intros H0; split. + apply Zabs_ind. + intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto. + intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto. + auto with zarith. - Intros H0; Rewrite <- H0. - Rewrite <- (Zabs_Zsgn b); Rewrite <- H0; Simpl. - Split; [Apply gcd_0|Idtac];Auto with zarith. + intros H0; rewrite <- H0. + rewrite <- (Zabs_Zsgn b); rewrite <- H0; simpl in |- *. + split; [ apply Zis_gcd_0 | idtac ]; auto with zarith. -Intros p Hrec b. -Generalize (Z_div_mod b (POS p)). -Case (Zdiv_eucl b (POS p)); Intros q r Hqr. -Elim Hqr; Clear Hqr; Intros; Auto with zarith. -Elim (Hrec r H0 (POS p)); Intros g Hgkl. -Inversion_clear H0. -Elim (Hgkl H1); Clear Hgkl; Intros H3 H4. -Exists g; Intros. -Split; Auto. -Rewrite H. -Apply gcd_for_euclid2; Auto. - -Intros p Hrec b. -Exists `0`; Intros. -Elim H; Auto. +intros p Hrec b. +generalize (Z_div_mod b (Zpos p)). +case (Zdiv_eucl b (Zpos p)); intros q r Hqr. +elim Hqr; clear Hqr; intros; auto with zarith. +elim (Hrec r H0 (Zpos p)); intros g Hgkl. +inversion_clear H0. +elim (Hgkl H1); clear Hgkl; intros H3 H4. +exists g; intros. +split; auto. +rewrite H. +apply Zis_gcd_for_euclid2; auto. + +intros p Hrec b. +exists 0; intros. +elim H; auto. Defined. -Definition Zgcd_spec : (a,b:Z){ g : Z | (gcd a b g) /\ `g>=0` }. +Definition Zgcd_spec : forall a b:Z, {g : Z | Zis_gcd a b g /\ g >= 0}. Proof. -Intros a; Case (Z_gt_le_dec `0` a). -Intros; Assert `0 <= -a`. -Omega. -Elim (Zgcd_pos `-a` H b); Intros g Hgkl. -Exists g. -Intuition. -Intros Ha b; Elim (Zgcd_pos a Ha b); Intros g; Exists g; Intuition. +intros a; case (Z_gt_le_dec 0 a). +intros; assert (0 <= - a). +omega. +elim (Zgcd_pos (- a) H b); intros g Hgkl. +exists g. +intuition. +intros Ha b; elim (Zgcd_pos a Ha b); intros g; exists g; intuition. Defined. -Definition Zgcd := [a,b:Z](let (g,_) = (Zgcd_spec a b) in g). +Definition Zgcd (a b:Z) := let (g, _) := Zgcd_spec a b in g. -Lemma Zgcd_is_pos : (a,b:Z)`(Zgcd a b) >=0`. -Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto. +Lemma Zgcd_is_pos : forall a b:Z, Zgcd a b >= 0. +intros a b; unfold Zgcd in |- *; case (Zgcd_spec a b); tauto. Qed. -Lemma Zgcd_is_gcd : (a,b:Z)(gcd a b (Zgcd a b)). -Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto. +Lemma Zgcd_is_gcd : forall a b:Z, Zis_gcd a b (Zgcd a b). +intros a b; unfold Zgcd in |- *; case (Zgcd_spec a b); tauto. Qed. (** * Relative primality *) -Definition rel_prime [a,b:Z] : Prop := (gcd a b `1`). +Definition rel_prime (a b:Z) : Prop := Zis_gcd a b 1. (** Bezout's theorem: [a] and [b] are relatively prime if and only if there exist [u] and [v] such that [ua+vb = 1]. *) -Lemma rel_prime_bezout : - (a,b:Z) (rel_prime a b) -> (Bezout a b `1`). +Lemma rel_prime_bezout : forall a b:Z, rel_prime a b -> Bezout a b 1. Proof. -Intros a b; Exact (gcd_bezout a b `1`). -Save. +intros a b; exact (Zis_gcd_bezout a b 1). +Qed. -Lemma bezout_rel_prime : - (a,b:Z) (Bezout a b `1`) -> (rel_prime a b). +Lemma bezout_rel_prime : forall a b:Z, Bezout a b 1 -> rel_prime a b. Proof. -Induction 1; Constructor; Auto with zarith. -Intros. Rewrite <- H0; Auto with zarith. -Save. +simple induction 1; constructor; auto with zarith. +intros. rewrite <- H0; auto with zarith. +Qed. (** Gauss's theorem: if [a] divides [bc] and if [a] and [b] are relatively prime, then [a] divides [c]. *) -Theorem Gauss : (a,b,c:Z) (a |`b*c`) -> (rel_prime a b) -> (a | c). +Theorem Gauss : forall a b c:Z, (a | b * c) -> rel_prime a b -> (a | c). Proof. -Intros. Elim (rel_prime_bezout a b H0); Intros. -Replace c with `c*1`; [ Idtac | Ring ]. -Rewrite <- H1. -Replace `c*(u*a+v*b)` with `(c*u)*a + v*(b*c)`; [ EAuto with zarith | Ring ]. -Save. +intros. elim (rel_prime_bezout a b H0); intros. +replace c with (c * 1); [ idtac | ring ]. +rewrite <- H1. +replace (c * (u * a + v * b)) with (c * u * a + v * (b * c)); + [ eauto with zarith | ring ]. +Qed. (** If [a] is relatively prime to [b] and [c], then it is to [bc] *) -Lemma rel_prime_mult : - (a,b,c:Z) (rel_prime a b) -> (rel_prime a c) -> (rel_prime a `b*c`). -Proof. -Intros a b c Hb Hc. -Elim (rel_prime_bezout a b Hb); Intros. -Elim (rel_prime_bezout a c Hc); Intros. -Apply bezout_rel_prime. -Apply Bezout_intro with u:=`u*u0*a+v0*c*u+u0*v*b` v:=`v*v0`. -Rewrite <- H. -Replace `u*a+v*b` with `(u*a+v*b) * 1`; [ Idtac | Ring ]. -Rewrite <- H0. -Ring. -Save. +Lemma rel_prime_mult : + forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c). +Proof. +intros a b c Hb Hc. +elim (rel_prime_bezout a b Hb); intros. +elim (rel_prime_bezout a c Hc); intros. +apply bezout_rel_prime. +apply Bezout_intro with + (u := u * u0 * a + v0 * c * u + u0 * v * b) (v := v * v0). +rewrite <- H. +replace (u * a + v * b) with ((u * a + v * b) * 1); [ idtac | ring ]. +rewrite <- H0. +ring. +Qed. Lemma rel_prime_cross_prod : - (a,b,c,d:Z) (rel_prime a b) -> (rel_prime c d) -> `b>0` -> `d>0` -> - `a*d = b*c` -> (a=c /\ b=d). -Proof. -Intros a b c d; Intros. -Elim (Zdivide_antisym b d). -Split; Auto with zarith. -Rewrite H4 in H3. -Rewrite Zmult_sym in H3. -Apply Zmult_reg_left with d; Auto with zarith. -Intros; Omega. -Apply Gauss with a. -Rewrite H3. -Auto with zarith. -Red; Auto with zarith. -Apply Gauss with c. -Rewrite Zmult_sym. -Rewrite <- H3. -Auto with zarith. -Red; Auto with zarith. -Save. + forall a b c d:Z, + rel_prime a b -> + rel_prime c d -> b > 0 -> d > 0 -> a * d = b * c -> a = c /\ b = d. +Proof. +intros a b c d; intros. +elim (Zdivide_antisym b d). +split; auto with zarith. +rewrite H4 in H3. +rewrite Zmult_comm in H3. +apply Zmult_reg_l with d; auto with zarith. +intros; omega. +apply Gauss with a. +rewrite H3. +auto with zarith. +red in |- *; auto with zarith. +apply Gauss with c. +rewrite Zmult_comm. +rewrite <- H3. +auto with zarith. +red in |- *; auto with zarith. +Qed. (** After factorization by a gcd, the original numbers are relatively prime. *) -Lemma gcd_rel_prime : - (a,b,g:Z)`b>0` -> `g>=0`-> (gcd a b g) -> (rel_prime `a/g` `b/g`). -Intros a b g; Intros. -Assert `g <> 0`. - Intro. - Elim H1; Intros. - Elim H4; Intros. - Rewrite H2 in H6; Subst b; Omega. -Unfold rel_prime. -Elim (Zgcd_spec `a/g` `b/g`); Intros g' (H3,H4). -Assert H5 := (gcd_mult ? ? g ? H3). -Rewrite <- Z_div_exact_2 in H5; Auto with zarith. -Rewrite <- Z_div_exact_2 in H5; Auto with zarith. -Elim (gcd_uniqueness_apart_sign ? ? ? ? H1 H5). -Intros; Rewrite (!Zmult_reg_left `1` g' g); Auto with zarith. -Intros; Rewrite (!Zmult_reg_left `1` `-g'` g); Auto with zarith. -Pattern 1 g; Rewrite H6; Ring. - -Elim H1; Intros. -Elim H7; Intros. -Rewrite H9. -Replace `q*g` with `0+q*g`. -Rewrite Z_mod_plus. -Compute; Auto. -Omega. -Ring. - -Elim H1; Intros. -Elim H6; Intros. -Rewrite H9. -Replace `q*g` with `0+q*g`. -Rewrite Z_mod_plus. -Compute; Auto. -Omega. -Ring. -Save. +Lemma Zis_gcd_rel_prime : + forall a b g:Z, + b > 0 -> g >= 0 -> Zis_gcd a b g -> rel_prime (a / g) (b / g). +intros a b g; intros. +assert (g <> 0). + intro. + elim H1; intros. + elim H4; intros. + rewrite H2 in H6; subst b; omega. +unfold rel_prime in |- *. +elim (Zgcd_spec (a / g) (b / g)); intros g' [H3 H4]. +assert (H5 := Zis_gcd_mult _ _ g _ H3). +rewrite <- Z_div_exact_2 in H5; auto with zarith. +rewrite <- Z_div_exact_2 in H5; auto with zarith. +elim (Zis_gcd_uniqueness_apart_sign _ _ _ _ H1 H5). +intros; rewrite (Zmult_reg_l 1 g' g); auto with zarith. +intros; rewrite (Zmult_reg_l 1 (- g') g); auto with zarith. +pattern g at 1 in |- *; rewrite H6; ring. + +elim H1; intros. +elim H7; intros. +rewrite H9. +replace (q * g) with (0 + q * g). +rewrite Z_mod_plus. +compute in |- *; auto. +omega. +ring. + +elim H1; intros. +elim H6; intros. +rewrite H9. +replace (q * g) with (0 + q * g). +rewrite Z_mod_plus. +compute in |- *; auto. +omega. +ring. +Qed. (** * Primality *) -Inductive prime [p:Z] : Prop := - prime_intro : - `1 < p` -> ((n:Z) `1 <= n < p` -> (rel_prime n p)) -> (prime p). +Inductive prime (p:Z) : Prop := + prime_intro : + 1 < p -> (forall n:Z, 1 <= n < p -> rel_prime n p) -> prime p. (** The sole divisors of a prime number [p] are [-1], [1], [p] and [-p]. *) -Lemma prime_divisors : - (p:Z) (prime p) -> - (a:Z) (a|p) -> `a = -1` \/ `a = 1` \/ a = p \/ `a = -p`. -Proof. -Induction 1; Intros. -Assert `a = (-p)`\/`-p<a< -1`\/`a = -1`\/`a=0`\/`a = 1`\/`1<a<p`\/`a = p`. -Assert `|a| <= |p|`. Apply Zdivide_bounds; [ Assumption | Omega ]. -Generalize H3. -Pattern `|a|`; Apply Zabs_ind; Pattern `|p|`; Apply Zabs_ind; Intros; Omega. -Intuition Idtac. +Lemma prime_divisors : + forall p:Z, + prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p. +Proof. +simple induction 1; intros. +assert + (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p). +assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ]. +generalize H3. +pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *; + apply Zabs_ind; intros; omega. +intuition idtac. (* -p < a < -1 *) -Absurd (rel_prime `-a` p); Intuition. -Inversion H3. -Assert (`-a` | `-a`); Auto with zarith. -Assert (`-a` | p); Auto with zarith. -Generalize (H8 `-a` H9 H10); Intuition Idtac. -Generalize (Zdivide_1 `-a` H11); Intuition. +absurd (rel_prime (- a) p); intuition. +inversion H3. +assert (- a | - a); auto with zarith. +assert (- a | p); auto with zarith. +generalize (H8 (- a) H9 H10); intuition idtac. +generalize (Zdivide_1 (- a) H11); intuition. (* a = 0 *) -Inversion H2. Subst a; Omega. +inversion H2. subst a; omega. (* 1 < a < p *) -Absurd (rel_prime a p); Intuition. -Inversion H3. -Assert (a | a); Auto with zarith. -Assert (a | p); Auto with zarith. -Generalize (H8 a H9 H10); Intuition Idtac. -Generalize (Zdivide_1 a H11); Intuition. -Save. +absurd (rel_prime a p); intuition. +inversion H3. +assert (a | a); auto with zarith. +assert (a | p); auto with zarith. +generalize (H8 a H9 H10); intuition idtac. +generalize (Zdivide_1 a H11); intuition. +Qed. (** A prime number is relatively prime with any number it does not divide *) -Lemma prime_rel_prime : - (p:Z) (prime p) -> (a:Z) ~ (p|a) -> (rel_prime p a). +Lemma prime_rel_prime : + forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a. Proof. -Induction 1; Intros. -Constructor; Intuition. -Elim (prime_divisors p H x H3); Intuition; Subst; Auto with zarith. -Absurd (p | a); Auto with zarith. -Absurd (p | a); Intuition. -Save. +simple induction 1; intros. +constructor; intuition. +elim (prime_divisors p H x H3); intuition; subst; auto with zarith. +absurd (p | a); auto with zarith. +absurd (p | a); intuition. +Qed. -Hints Resolve prime_rel_prime : zarith. +Hint Resolve prime_rel_prime: zarith. (** [Zdivide] can be expressed using [Zmod]. *) -Lemma Zmod_Zdivide : (a,b:Z) `b>0` -> `a%b = 0` -> (b|a). -Intros a b H H0. -Apply Zdivide_intro with `(a/b)`. -Pattern 1 a; Rewrite (Z_div_mod_eq a b H). -Rewrite H0; Ring. -Save. +Lemma Zmod_divide : forall a b:Z, b > 0 -> a mod b = 0 -> (b | a). +intros a b H H0. +apply Zdivide_intro with (a / b). +pattern a at 1 in |- *; rewrite (Z_div_mod_eq a b H). +rewrite H0; ring. +Qed. -Lemma Zdivide_Zmod : (a,b:Z) `b>0` -> (b|a) -> `a%b = 0`. -Intros a b; Destruct 2; Intros; Subst. -Change `q*b` with `0+q*b`. -Rewrite Z_mod_plus; Auto. -Save. +Lemma Zdivide_mod : forall a b:Z, b > 0 -> (b | a) -> a mod b = 0. +intros a b; simple destruct 2; intros; subst. +change (q * b) with (0 + q * b) in |- *. +rewrite Z_mod_plus; auto. +Qed. (** [Zdivide] is hence decidable *) -Lemma Zdivide_dec : (a,b:Z) { (a|b) } + { ~ (a|b) }. +Lemma Zdivide_dec : forall a b:Z, {(a | b)} + {~ (a | b)}. Proof. -Intros a b; Elim (Ztrichotomy_inf a `0`). +intros a b; elim (Ztrichotomy_inf a 0). (* a<0 *) -Intros H; Elim H; Intros. -Case (Z_eq_dec `b%(-a)` `0`). -Left; Apply Zdivide_opp_left_rev; Apply Zmod_Zdivide; Auto with zarith. -Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith. +intros H; elim H; intros. +case (Z_eq_dec (b mod - a) 0). +left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith. +intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. (* a=0 *) -Case (Z_eq_dec b `0`); Intro. -Left; Subst; Auto with zarith. -Right; Subst; Intro H0; Inversion H0; Omega. +case (Z_eq_dec b 0); intro. +left; subst; auto with zarith. +right; subst; intro H0; inversion H0; omega. (* a>0 *) -Intro H; Case (Z_eq_dec `b%a` `0`). -Left; Apply Zmod_Zdivide; Auto with zarith. -Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith. -Save. +intro H; case (Z_eq_dec (b mod a) 0). +left; apply Zmod_divide; auto with zarith. +intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. +Qed. (** If a prime [p] divides [ab] then it divides either [a] or [b] *) -Lemma prime_mult : - (p:Z) (prime p) -> (a,b:Z) (p | `a*b`) -> (p | a) \/ (p | b). +Lemma prime_mult : + forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b). Proof. -Intro p; Induction 1; Intros. -Case (Zdivide_dec p a); Intuition. -Right; Apply Gauss with a; Auto with zarith. -Save. - +intro p; simple induction 1; intros. +case (Zdivide_dec p a); intuition. +right; apply Gauss with a; auto with zarith. +Qed. diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index bfe56b82e..eeb9f681b 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -9,961 +9,957 @@ (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *) -Require BinPos. -Require BinInt. -Require Arith. -Require Decidable. -Require Zsyntax. -Require Zcompare. - -V7only [Import nat_scope.]. +Require Import BinPos. +Require Import BinInt. +Require Import Arith. +Require Import Decidable. +Require Import Zcompare. + Open Local Scope Z_scope. -Implicit Variable Type x,y,z:Z. +Implicit Types x y z : Z. (**********************************************************************) (** Properties of the order relations on binary integers *) (** Trichotomy *) -Theorem Ztrichotomy_inf : (m,n:Z) {`m<n`} + {m=n} + {`m>n`}. +Theorem Ztrichotomy_inf : forall n m:Z, {n < m} + {n = m} + {n > m}. Proof. -Unfold Zgt Zlt; Intros m n; Assert H:=(refl_equal ? (Zcompare m n)). - LetTac x := (Zcompare m n) in 2 H Goal. - NewDestruct x; - [Left; Right;Rewrite Zcompare_EGAL_eq with 1:=H - | Left; Left - | Right ]; Reflexivity. +unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)). + set (x := m ?= n) in H at 2 |- *. + destruct x; + [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ]; + reflexivity. Qed. -Theorem Ztrichotomy : (m,n:Z) `m<n` \/ m=n \/ `m>n`. +Theorem Ztrichotomy : forall n m:Z, n < m \/ n = m \/ n > m. Proof. - Intros m n; NewDestruct (Ztrichotomy_inf m n) as [[Hlt|Heq]|Hgt]; - [Left | Right; Left |Right; Right]; Assumption. + intros m n; destruct (Ztrichotomy_inf m n) as [[Hlt| Heq]| Hgt]; + [ left | right; left | right; right ]; assumption. Qed. (**********************************************************************) (** Decidability of equality and order on Z *) -Theorem dec_eq: (x,y:Z) (decidable (x=y)). +Theorem dec_eq : forall n m:Z, decidable (n = m). Proof. -Intros x y; Unfold decidable ; Elim (Zcompare_EGAL x y); -Intros H1 H2; Elim (Dcompare (Zcompare x y)); [ - Tauto - | Intros H3; Right; Unfold not ; Intros H4; - Elim H3; Rewrite (H2 H4); Intros H5; Discriminate H5]. +intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y); + intros H1 H2; elim (Dcompare (x ?= y)); + [ tauto + | intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4); + intros H5; discriminate H5 ]. Qed. -Theorem dec_Zne: (x,y:Z) (decidable (Zne x y)). +Theorem dec_Zne : forall n m:Z, decidable (Zne n m). Proof. -Intros x y; Unfold decidable Zne ; Elim (Zcompare_EGAL x y). -Intros H1 H2; Elim (Dcompare (Zcompare x y)); - [ Right; Rewrite H1; Auto - | Left; Unfold not; Intro; Absurd (Zcompare x y)=EGAL; - [ Elim H; Intros HR; Rewrite HR; Discriminate - | Auto]]. +intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y). +intros H1 H2; elim (Dcompare (x ?= y)); + [ right; rewrite H1; auto + | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq); + [ elim H; intros HR; rewrite HR; discriminate | auto ] ]. Qed. -Theorem dec_Zle: (x,y:Z) (decidable `x<=y`). +Theorem dec_Zle : forall n m:Z, decidable (n <= m). Proof. -Intros x y; Unfold decidable Zle ; Elim (Zcompare x y); [ - Left; Discriminate - | Left; Discriminate - | Right; Unfold not ; Intros H; Apply H; Trivial with arith]. +intros x y; unfold decidable, Zle in |- *; elim (x ?= y); + [ left; discriminate + | left; discriminate + | right; unfold not in |- *; intros H; apply H; trivial with arith ]. Qed. -Theorem dec_Zgt: (x,y:Z) (decidable `x>y`). +Theorem dec_Zgt : forall n m:Z, decidable (n > m). Proof. -Intros x y; Unfold decidable Zgt ; Elim (Zcompare x y); - [ Right; Discriminate | Right; Discriminate | Auto with arith]. +intros x y; unfold decidable, Zgt in |- *; elim (x ?= y); + [ right; discriminate | right; discriminate | auto with arith ]. Qed. -Theorem dec_Zge: (x,y:Z) (decidable `x>=y`). +Theorem dec_Zge : forall n m:Z, decidable (n >= m). Proof. -Intros x y; Unfold decidable Zge ; Elim (Zcompare x y); [ - Left; Discriminate -| Right; Unfold not ; Intros H; Apply H; Trivial with arith -| Left; Discriminate]. +intros x y; unfold decidable, Zge in |- *; elim (x ?= y); + [ left; discriminate + | right; unfold not in |- *; intros H; apply H; trivial with arith + | left; discriminate ]. Qed. -Theorem dec_Zlt: (x,y:Z) (decidable `x<y`). +Theorem dec_Zlt : forall n m:Z, decidable (n < m). Proof. -Intros x y; Unfold decidable Zlt ; Elim (Zcompare x y); - [ Right; Discriminate | Auto with arith | Right; Discriminate]. +intros x y; unfold decidable, Zlt in |- *; elim (x ?= y); + [ right; discriminate | auto with arith | right; discriminate ]. Qed. -Theorem not_Zeq : (x,y:Z) ~ x=y -> `x<y` \/ `y<x`. +Theorem not_Zeq : forall n m:Z, n <> m -> n < m \/ m < n. Proof. -Intros x y; Elim (Dcompare (Zcompare x y)); [ - Intros H1 H2; Absurd x=y; [ Assumption | Elim (Zcompare_EGAL x y); Auto with arith] -| Unfold Zlt ; Intros H; Elim H; Intros H1; - [Auto with arith | Right; Elim (Zcompare_ANTISYM x y); Auto with arith]]. +intros x y; elim (Dcompare (x ?= y)); + [ intros H1 H2; absurd (x = y); + [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ] + | unfold Zlt in |- *; intros H; elim H; intros H1; + [ auto with arith + | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ]. Qed. (** Relating strict and large orders *) -Lemma Zgt_lt : (m,n:Z) `m>n` -> `n<m`. +Lemma Zgt_lt : forall n m:Z, n > m -> m < n. Proof. -Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM m n); Auto with arith. +unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n); + auto with arith. Qed. -Lemma Zlt_gt : (m,n:Z) `m<n` -> `n>m`. +Lemma Zlt_gt : forall n m:Z, n < m -> m > n. Proof. -Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM n m); Auto with arith. +unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m); + auto with arith. Qed. -Lemma Zge_le : (m,n:Z) `m>=n` -> `n<=m`. +Lemma Zge_le : forall n m:Z, n >= m -> m <= n. Proof. -Intros m n; Change ~`m<n`-> ~`n>m`; -Unfold not; Intros H1 H2; Apply H1; Apply Zgt_lt; Assumption. +intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *; + intros H1 H2; apply H1; apply Zgt_lt; assumption. Qed. -Lemma Zle_ge : (m,n:Z) `m<=n` -> `n>=m`. +Lemma Zle_ge : forall n m:Z, n <= m -> m >= n. Proof. -Intros m n; Change ~`m>n`-> ~`n<m`; -Unfold not; Intros H1 H2; Apply H1; Apply Zlt_gt; Assumption. +intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *; + intros H1 H2; apply H1; apply Zlt_gt; assumption. Qed. -Lemma Zle_not_gt : (n,m:Z)`n<=m` -> ~`n>m`. +Lemma Zle_not_gt : forall n m:Z, n <= m -> ~ n > m. Proof. -Trivial. +trivial. Qed. -Lemma Zgt_not_le : (n,m:Z)`n>m` -> ~`n<=m`. +Lemma Zgt_not_le : forall n m:Z, n > m -> ~ n <= m. Proof. -Intros n m H1 H2; Apply H2; Assumption. +intros n m H1 H2; apply H2; assumption. Qed. -Lemma Zle_not_lt : (n,m:Z)`n<=m` -> ~`m<n`. +Lemma Zle_not_lt : forall n m:Z, n <= m -> ~ m < n. Proof. -Intros n m H1 H2. -Assert H3:=(Zlt_gt ? ? H2). -Apply Zle_not_gt with n m; Assumption. +intros n m H1 H2. +assert (H3 := Zlt_gt _ _ H2). +apply Zle_not_gt with n m; assumption. Qed. -Lemma Zlt_not_le : (n,m:Z)`n<m` -> ~`m<=n`. +Lemma Zlt_not_le : forall n m:Z, n < m -> ~ m <= n. Proof. -Intros n m H1 H2. -Apply Zle_not_lt with m n; Assumption. +intros n m H1 H2. +apply Zle_not_lt with m n; assumption. Qed. -Lemma not_Zge : (x,y:Z) ~`x>=y` -> `x<y`. +Lemma Znot_ge_lt : forall n m:Z, ~ n >= m -> n < m. Proof. -Unfold Zge Zlt ; Intros x y H; Apply dec_not_not; - [ Exact (dec_Zlt x y) | Assumption]. +unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not; + [ exact (dec_Zlt x y) | assumption ]. Qed. -Lemma not_Zlt : (x,y:Z) ~`x<y` -> `x>=y`. +Lemma Znot_lt_ge : forall n m:Z, ~ n < m -> n >= m. Proof. -Unfold Zlt Zge; Auto with arith. +unfold Zlt, Zge in |- *; auto with arith. Qed. -Lemma not_Zgt : (x,y:Z)~`x>y` -> `x<=y`. +Lemma Znot_gt_le : forall n m:Z, ~ n > m -> n <= m. Proof. -Trivial. +trivial. Qed. -Lemma not_Zle : (x,y:Z) ~`x<=y` -> `x>y`. +Lemma Znot_le_gt : forall n m:Z, ~ n <= m -> n > m. Proof. -Unfold Zle Zgt ; Intros x y H; Apply dec_not_not; - [ Exact (dec_Zgt x y) | Assumption]. +unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not; + [ exact (dec_Zgt x y) | assumption ]. Qed. -Lemma Zge_iff_le : (x,y:Z) `x>=y` <-> `y<=x`. +Lemma Zge_iff_le : forall n m:Z, n >= m <-> m <= n. Proof. - Intros x y; Intros. Split. Intro. Apply Zge_le. Assumption. - Intro. Apply Zle_ge. Assumption. + intros x y; intros. split. intro. apply Zge_le. assumption. + intro. apply Zle_ge. assumption. Qed. -Lemma Zgt_iff_lt : (x,y:Z) `x>y` <-> `y<x`. +Lemma Zgt_iff_lt : forall n m:Z, n > m <-> m < n. Proof. - Intros x y. Split. Intro. Apply Zgt_lt. Assumption. - Intro. Apply Zlt_gt. Assumption. + intros x y. split. intro. apply Zgt_lt. assumption. + intro. apply Zlt_gt. assumption. Qed. (** Reflexivity *) -Lemma Zle_n : (n:Z) (Zle n n). +Lemma Zle_refl : forall n:Z, n <= n. Proof. -Intros n; Unfold Zle; Rewrite (Zcompare_x_x n); Discriminate. +intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate. Qed. -Lemma Zle_refl : (n,m:Z) n=m -> `n<=m`. +Lemma Zeq_le : forall n m:Z, n = m -> n <= m. Proof. -Intros; Rewrite H; Apply Zle_n. +intros; rewrite H; apply Zle_refl. Qed. -Hints Resolve Zle_n : zarith. +Hint Resolve Zle_refl: zarith. (** Antisymmetry *) -Lemma Zle_antisym : (n,m:Z)`n<=m`->`m<=n`->n=m. +Lemma Zle_antisym : forall n m:Z, n <= m -> m <= n -> n = m. Proof. -Intros n m H1 H2; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]. - Absurd `m>n`; [ Apply Zle_not_gt | Apply Zlt_gt]; Assumption. - Assumption. - Absurd `n>m`; [ Apply Zle_not_gt | Idtac]; Assumption. +intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. + absurd (m > n); [ apply Zle_not_gt | apply Zlt_gt ]; assumption. + assumption. + absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption. Qed. (** Asymmetry *) -Lemma Zgt_not_sym : (n,m:Z)`n>m` -> ~`m>n`. +Lemma Zgt_asym : forall n m:Z, n > m -> ~ m > n. Proof. -Unfold Zgt ;Intros n m H; Elim (Zcompare_ANTISYM n m); Intros H1 H2; -Rewrite -> H1; [ Discriminate | Assumption ]. +unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m); + intros H1 H2; rewrite H1; [ discriminate | assumption ]. Qed. -Lemma Zlt_not_sym : (n,m:Z)`n<m` -> ~`m<n`. +Lemma Zlt_asym : forall n m:Z, n < m -> ~ m < n. Proof. -Intros n m H H1; -Assert H2:`m>n`. Apply Zlt_gt; Assumption. -Assert H3: `n>m`. Apply Zlt_gt; Assumption. -Apply Zgt_not_sym with m n; Assumption. +intros n m H H1; assert (H2 : m > n). apply Zlt_gt; assumption. +assert (H3 : n > m). apply Zlt_gt; assumption. +apply Zgt_asym with m n; assumption. Qed. (** Irreflexivity *) -Lemma Zgt_antirefl : (n:Z)~`n>n`. +Lemma Zgt_irrefl : forall n:Z, ~ n > n. Proof. -Intros n H; Apply (Zgt_not_sym n n H H). +intros n H; apply (Zgt_asym n n H H). Qed. -Lemma Zlt_n_n : (n:Z)~`n<n`. +Lemma Zlt_irrefl : forall n:Z, ~ n < n. Proof. -Intros n H; Apply (Zlt_not_sym n n H H). +intros n H; apply (Zlt_asym n n H H). Qed. -Lemma Zlt_not_eq : (x,y:Z)`x<y` -> ~x=y. +Lemma Zlt_not_eq : forall n m:Z, n < m -> n <> m. Proof. -Unfold not; Intros x y H H0. -Rewrite H0 in H. -Apply (Zlt_n_n ? H). +unfold not in |- *; intros x y H H0. +rewrite H0 in H. +apply (Zlt_irrefl _ H). Qed. (** Large = strict or equal *) -Lemma Zlt_le_weak : (n,m:Z)`n<m`->`n<=m`. +Lemma Zlt_le_weak : forall n m:Z, n < m -> n <= m. Proof. -Intros n m Hlt; Apply not_Zgt; Apply Zgt_not_sym; Apply Zlt_gt; Assumption. +intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption. Qed. -Lemma Zle_lt_or_eq : (n,m:Z)`n<=m`->(`n<m` \/ n=m). +Lemma Zle_lt_or_eq : forall n m:Z, n <= m -> n < m \/ n = m. Proof. -Intros n m H; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [ - Left; Assumption -| Right; Assumption -| Absurd `n>m`; [Apply Zle_not_gt|Idtac]; Assumption ]. +intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]; + [ left; assumption + | right; assumption + | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ]. Qed. (** Dichotomy *) -Lemma Zle_or_lt : (n,m:Z)`n<=m`\/`m<n`. +Lemma Zle_or_lt : forall n m:Z, n <= m \/ m < n. Proof. -Intros n m; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [ - Left; Apply not_Zgt; Intro Hgt; Assert Hgt':=(Zlt_gt ? ? Hlt); - Apply Zgt_not_sym with m n; Assumption -| Left; Rewrite Heq; Apply Zle_n -| Right; Apply Zgt_lt; Assumption ]. +intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]; + [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt); + apply Zgt_asym with m n; assumption + | left; rewrite Heq; apply Zle_refl + | right; apply Zgt_lt; assumption ]. Qed. (** Transitivity of strict orders *) -Lemma Zgt_trans : (n,m,p:Z)`n>m`->`m>p`->`n>p`. +Lemma Zgt_trans : forall n m p:Z, n > m -> m > p -> n > p. Proof. -Exact Zcompare_trans_SUPERIEUR. +exact Zcompare_Gt_trans. Qed. -Lemma Zlt_trans : (n,m,p:Z)`n<m`->`m<p`->`n<p`. +Lemma Zlt_trans : forall n m p:Z, n < m -> m < p -> n < p. Proof. -Intros n m p H1 H2; Apply Zgt_lt; Apply Zgt_trans with m:= m; -Apply Zlt_gt; Assumption. +intros n m p H1 H2; apply Zgt_lt; apply Zgt_trans with (m := m); apply Zlt_gt; + assumption. Qed. (** Mixed transitivity *) -Lemma Zle_gt_trans : (n,m,p:Z)`m<=n`->`m>p`->`n>p`. +Lemma Zle_gt_trans : forall n m p:Z, m <= n -> m > p -> n > p. Proof. -Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq m n H1) as [Hlt|Heq]; [ - Apply Zgt_trans with m; [Apply Zlt_gt; Assumption | Assumption ] -| Rewrite <- Heq; Assumption ]. +intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq]; + [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ] + | rewrite <- Heq; assumption ]. Qed. -Lemma Zgt_le_trans : (n,m,p:Z)`n>m`->`p<=m`->`n>p`. +Lemma Zgt_le_trans : forall n m p:Z, n > m -> p <= m -> n > p. Proof. -Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq p m H2) as [Hlt|Heq]; [ - Apply Zgt_trans with m; [Assumption|Apply Zlt_gt; Assumption] -| Rewrite Heq; Assumption ]. +intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq]; + [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ] + | rewrite Heq; assumption ]. Qed. -Lemma Zlt_le_trans : (n,m,p:Z)`n<m`->`m<=p`->`n<p`. -Intros n m p H1 H2;Apply Zgt_lt;Apply Zle_gt_trans with m:=m; - [ Assumption | Apply Zlt_gt;Assumption ]. +Lemma Zlt_le_trans : forall n m p:Z, n < m -> m <= p -> n < p. +intros n m p H1 H2; apply Zgt_lt; apply Zle_gt_trans with (m := m); + [ assumption | apply Zlt_gt; assumption ]. Qed. -Lemma Zle_lt_trans : (n,m,p:Z)`n<=m`->`m<p`->`n<p`. +Lemma Zle_lt_trans : forall n m p:Z, n <= m -> m < p -> n < p. Proof. -Intros n m p H1 H2;Apply Zgt_lt;Apply Zgt_le_trans with m:=m; - [ Apply Zlt_gt;Assumption | Assumption ]. +intros n m p H1 H2; apply Zgt_lt; apply Zgt_le_trans with (m := m); + [ apply Zlt_gt; assumption | assumption ]. Qed. (** Transitivity of large orders *) -Lemma Zle_trans : (n,m,p:Z)`n<=m`->`m<=p`->`n<=p`. +Lemma Zle_trans : forall n m p:Z, n <= m -> m <= p -> n <= p. Proof. -Intros n m p H1 H2; Apply not_Zgt. -Intro Hgt; Apply Zle_not_gt with n m. Assumption. -Exact (Zgt_le_trans n p m Hgt H2). +intros n m p H1 H2; apply Znot_gt_le. +intro Hgt; apply Zle_not_gt with n m. assumption. +exact (Zgt_le_trans n p m Hgt H2). Qed. -Lemma Zge_trans : (n, m, p : Z) `n>=m` -> `m>=p` -> `n>=p`. +Lemma Zge_trans : forall n m p:Z, n >= m -> m >= p -> n >= p. Proof. -Intros n m p H1 H2. -Apply Zle_ge. -Apply Zle_trans with m; Apply Zge_le; Trivial. +intros n m p H1 H2. +apply Zle_ge. +apply Zle_trans with m; apply Zge_le; trivial. Qed. -Hints Resolve Zle_trans : zarith. +Hint Resolve Zle_trans: zarith. (** Compatibility of successor wrt to order *) -Lemma Zle_n_S : (n,m:Z) `m<=n` -> `(Zs m)<=(Zs n)`. +Lemma Zsucc_le_compat : forall n m:Z, m <= n -> Zsucc m <= Zsucc n. Proof. -Unfold Zle not ;Intros m n H1 H2; Apply H1; -Rewrite <- (Zcompare_Zplus_compatible n m (POS xH)); -Do 2 Rewrite (Zplus_sym (POS xH)); Exact H2. +unfold Zle, not in |- *; intros m n H1 H2; apply H1; + rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1); + exact H2. Qed. -Lemma Zgt_n_S : (n,m:Z)`m>n` -> `(Zs m)>(Zs n)`. +Lemma Zsucc_gt_compat : forall n m:Z, m > n -> Zsucc m > Zsucc n. Proof. -Unfold Zgt; Intros n m H; Rewrite Zcompare_n_S; Auto with arith. +unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat; + auto with arith. Qed. -Lemma Zlt_n_S : (n,m:Z)`n<m`->`(Zs n)<(Zs m)`. +Lemma Zsucc_lt_compat : forall n m:Z, n < m -> Zsucc n < Zsucc m. Proof. -Intros n m H;Apply Zgt_lt;Apply Zgt_n_S;Apply Zlt_gt; Assumption. +intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption. Qed. -Hints Resolve Zle_n_S : zarith. +Hint Resolve Zsucc_le_compat: zarith. (** Simplification of successor wrt to order *) -Lemma Zgt_S_n : (n,p:Z)`(Zs p)>(Zs n)`->`p>n`. +Lemma Zsucc_gt_reg : forall n m:Z, Zsucc m > Zsucc n -> m > n. Proof. -Unfold Zs Zgt;Intros n p;Do 2 Rewrite -> [m:Z](Zplus_sym m (POS xH)); -Rewrite -> (Zcompare_Zplus_compatible p n (POS xH));Trivial with arith. +unfold Zsucc, Zgt in |- *; intros n p; + do 2 rewrite (fun m:Z => Zplus_comm m 1); + rewrite (Zcompare_plus_compat p n 1); trivial with arith. Qed. -Lemma Zle_S_n : (n,m:Z) `(Zs m)<=(Zs n)` -> `m<=n`. +Lemma Zsucc_le_reg : forall n m:Z, Zsucc m <= Zsucc n -> m <= n. Proof. -Unfold Zle not ;Intros m n H1 H2;Apply H1; -Unfold Zs ;Do 2 Rewrite <- (Zplus_sym (POS xH)); -Rewrite -> (Zcompare_Zplus_compatible n m (POS xH));Assumption. +unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *; + do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1); + assumption. Qed. -Lemma Zlt_S_n : (n,m:Z)`(Zs n)<(Zs m)`->`n<m`. +Lemma Zsucc_lt_reg : forall n m:Z, Zsucc n < Zsucc m -> n < m. Proof. -Intros n m H;Apply Zgt_lt;Apply Zgt_S_n;Apply Zlt_gt; Assumption. +intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption. Qed. (** Compatibility of addition wrt to order *) -Lemma Zgt_reg_l : (n,m,p:Z)`n>m`->`p+n>p+m`. +Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m. Proof. -Unfold Zgt; Intros n m p H; Rewrite (Zcompare_Zplus_compatible n m p); -Assumption. +unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p); + assumption. Qed. -Lemma Zgt_reg_r : (n,m,p:Z)`n>m`->`n+p>m+p`. +Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p. Proof. -Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zgt_reg_l; Trivial. +intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p); + apply Zplus_gt_compat_l; trivial. Qed. -Lemma Zle_reg_l : (n,m,p:Z)`n<=m`->`p+n<=p+m`. +Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m. Proof. -Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1; -Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption. +intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1; + rewrite <- (Zcompare_plus_compat n m p); assumption. Qed. -Lemma Zle_reg_r : (n,m,p:Z) `n<=m`->`n+p<=m+p`. +Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p. Proof. -Intros a b c;Do 2 Rewrite [n:Z](Zplus_sym n c); Exact (Zle_reg_l a b c). +intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c); + exact (Zplus_le_compat_l a b c). Qed. -Lemma Zlt_reg_l : (n,m,p:Z)`n<m`->`p+n<p+m`. +Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m. Proof. -Unfold Zlt ;Intros n m p; Rewrite Zcompare_Zplus_compatible;Trivial with arith. +unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat; + trivial with arith. Qed. -Lemma Zlt_reg_r : (n,m,p:Z)`n<m`->`n+p<m+p`. +Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p. Proof. -Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zlt_reg_l; Trivial. +intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p); + apply Zplus_lt_compat_l; trivial. Qed. -Lemma Zlt_le_reg : (a,b,c,d:Z) `a<b`->`c<=d`->`a+c<b+d`. +Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q. Proof. -Intros a b c d H0 H1. -Apply Zlt_le_trans with (Zplus b c). -Apply Zlt_reg_r; Trivial. -Apply Zle_reg_l; Trivial. +intros a b c d H0 H1. +apply Zlt_le_trans with (b + c). +apply Zplus_lt_compat_r; trivial. +apply Zplus_le_compat_l; trivial. Qed. -Lemma Zle_lt_reg : (a,b,c,d:Z) `a<=b`->`c<d`->`a+c<b+d`. +Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q. Proof. -Intros a b c d H0 H1. -Apply Zle_lt_trans with (Zplus b c). -Apply Zle_reg_r; Trivial. -Apply Zlt_reg_l; Trivial. +intros a b c d H0 H1. +apply Zle_lt_trans with (b + c). +apply Zplus_le_compat_r; trivial. +apply Zplus_lt_compat_l; trivial. Qed. -Lemma Zle_plus_plus : (n,m,p,q:Z) `n<=m`->(Zle p q)->`n+p<=m+q`. +Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q. Proof. -Intros n m p q; Intros H1 H2;Apply Zle_trans with m:=(Zplus n q); [ - Apply Zle_reg_l;Assumption | Apply Zle_reg_r;Assumption ]. +intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q); + [ apply Zplus_le_compat_l; assumption + | apply Zplus_le_compat_r; assumption ]. Qed. -V7only [Set Implicit Arguments.]. -Lemma Zlt_Zplus : (x1,x2,y1,y2:Z)`x1 < x2` -> `y1 < y2` -> `x1 + y1 < x2 + y2`. -Intros; Apply Zle_lt_reg. Apply Zlt_le_weak; Assumption. Assumption. +Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q. +intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption. Qed. -V7only [Unset Implicit Arguments.]. (** Compatibility of addition wrt to being positive *) -Lemma Zle_0_plus : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x+y`. +Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m. Proof. -Intros x y H1 H2;Rewrite <- (Zero_left ZERO); Apply Zle_plus_plus; Assumption. +intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption. Qed. (** Simplification of addition wrt to order *) -Lemma Zsimpl_gt_plus_l : (n,m,p:Z)`p+n>p+m`->`n>m`. +Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m. Proof. -Unfold Zgt; Intros n m p H; - Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption. +unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p); + assumption. Qed. -Lemma Zsimpl_gt_plus_r : (n,m,p:Z)`n+p>m+p`->`n>m`. +Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m. Proof. -Intros n m p H; Apply Zsimpl_gt_plus_l with p. -Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial. +intros n m p H; apply Zplus_gt_reg_l with p. +rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. Qed. -Lemma Zsimpl_le_plus_l : (n,m,p:Z)`p+n<=p+m`->`n<=m`. +Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m. Proof. -Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1; -Rewrite (Zcompare_Zplus_compatible n m p); Assumption. +intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1; + rewrite (Zcompare_plus_compat n m p); assumption. Qed. -Lemma Zsimpl_le_plus_r : (n,m,p:Z)`n+p<=m+p`->`n<=m`. +Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m. Proof. -Intros n m p H; Apply Zsimpl_le_plus_l with p. -Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial. +intros n m p H; apply Zplus_le_reg_l with p. +rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. Qed. -Lemma Zsimpl_lt_plus_l : (n,m,p:Z)`p+n<p+m`->`n<m`. +Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m. Proof. -Unfold Zlt ;Intros n m p; - Rewrite Zcompare_Zplus_compatible;Trivial with arith. +unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat; + trivial with arith. Qed. -Lemma Zsimpl_lt_plus_r : (n,m,p:Z)`n+p<m+p`->`n<m`. +Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m. Proof. -Intros n m p H; Apply Zsimpl_lt_plus_l with p. -Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial. +intros n m p H; apply Zplus_lt_reg_l with p. +rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. Qed. (** Special base instances of order *) -Lemma Zgt_Sn_n : (n:Z)`(Zs n)>n`. +Lemma Zgt_succ : forall n:Z, Zsucc n > n. Proof. -Exact Zcompare_Zs_SUPERIEUR. +exact Zcompare_succ_Gt. Qed. -Lemma Zle_Sn_n : (n:Z)~`(Zs n)<=n`. +Lemma Znot_le_succ : forall n:Z, ~ Zsucc n <= n. Proof. -Intros n; Apply Zgt_not_le; Apply Zgt_Sn_n. +intros n; apply Zgt_not_le; apply Zgt_succ. Qed. -Lemma Zlt_n_Sn : (n:Z)`n<(Zs n)`. +Lemma Zlt_succ : forall n:Z, n < Zsucc n. Proof. -Intro n; Apply Zgt_lt; Apply Zgt_Sn_n. +intro n; apply Zgt_lt; apply Zgt_succ. Qed. -Lemma Zlt_pred_n_n : (n:Z)`(Zpred n)<n`. +Lemma Zlt_pred : forall n:Z, Zpred n < n. Proof. -Intros n; Apply Zlt_S_n; Rewrite <- Zs_pred; Apply Zlt_n_Sn. +intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ. Qed. (** Relating strict and large order using successor or predecessor *) -Lemma Zgt_le_S : (n,p:Z)`p>n`->`(Zs n)<=p`. +Lemma Zgt_le_succ : forall n m:Z, m > n -> Zsucc n <= m. Proof. -Unfold Zgt Zle; Intros n p H; Elim (Zcompare_et_un p n); Intros H1 H2; -Unfold not ;Intros H3; Unfold not in H1; Apply H1; [ - Assumption -| Elim (Zcompare_ANTISYM (Zplus n (POS xH)) p);Intros H4 H5;Apply H4;Exact H3]. +unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n); + intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; + apply H1; + [ assumption + | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ]. Qed. -Lemma Zle_gt_S : (n,p:Z)`n<=p`->`(Zs p)>n`. +Lemma Zlt_gt_succ : forall n m:Z, n <= m -> Zsucc m > n. Proof. -Intros n p H; Apply Zgt_le_trans with p. - Apply Zgt_Sn_n. - Assumption. +intros n p H; apply Zgt_le_trans with p. + apply Zgt_succ. + assumption. Qed. -Lemma Zle_lt_n_Sm : (n,m:Z)`n<=m`->`n<(Zs m)`. +Lemma Zle_lt_succ : forall n m:Z, n <= m -> n < Zsucc m. Proof. -Intros n m H; Apply Zgt_lt; Apply Zle_gt_S; Assumption. +intros n m H; apply Zgt_lt; apply Zlt_gt_succ; assumption. Qed. -Lemma Zlt_le_S : (n,p:Z)`n<p`->`(Zs n)<=p`. +Lemma Zlt_le_succ : forall n m:Z, n < m -> Zsucc n <= m. Proof. -Intros n p H; Apply Zgt_le_S; Apply Zlt_gt; Assumption. +intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption. Qed. -Lemma Zgt_S_le : (n,p:Z)`(Zs p)>n`->`n<=p`. +Lemma Zgt_succ_le : forall n m:Z, Zsucc m > n -> n <= m. Proof. -Intros n p H;Apply Zle_S_n; Apply Zgt_le_S; Assumption. +intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption. Qed. -Lemma Zlt_n_Sm_le : (n,m:Z)`n<(Zs m)`->`n<=m`. +Lemma Zlt_succ_le : forall n m:Z, n < Zsucc m -> n <= m. Proof. -Intros n m H; Apply Zgt_S_le; Apply Zlt_gt; Assumption. +intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption. Qed. -Lemma Zle_S_gt : (n,m:Z) `(Zs n)<=m` -> `m>n`. +Lemma Zlt_succ_gt : forall n m:Z, Zsucc n <= m -> m > n. Proof. -Intros n m H;Apply Zle_gt_trans with m:=(Zs n); - [ Assumption | Apply Zgt_Sn_n ]. +intros n m H; apply Zle_gt_trans with (m := Zsucc n); + [ assumption | apply Zgt_succ ]. Qed. (** Weakening order *) -Lemma Zle_n_Sn : (n:Z)`n<=(Zs n)`. +Lemma Zle_succ : forall n:Z, n <= Zsucc n. Proof. -Intros n; Apply Zgt_S_le;Apply Zgt_trans with m:=(Zs n) ;Apply Zgt_Sn_n. +intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n); + apply Zgt_succ. Qed. -Hints Resolve Zle_n_Sn : zarith. +Hint Resolve Zle_succ: zarith. -Lemma Zle_pred_n : (n:Z)`(Zpred n)<=n`. +Lemma Zle_pred : forall n:Z, Zpred n <= n. Proof. -Intros n;Pattern 2 n ;Rewrite Zs_pred; Apply Zle_n_Sn. +intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ. Qed. -Lemma Zlt_S : (n,m:Z)`n<m`->`n<(Zs m)`. -Intros n m H;Apply Zgt_lt; Apply Zgt_trans with m:=m; [ - Apply Zgt_Sn_n -| Apply Zlt_gt; Assumption ]. +Lemma Zlt_lt_succ : forall n m:Z, n < m -> n < Zsucc m. +intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m); + [ apply Zgt_succ | apply Zlt_gt; assumption ]. Qed. -Lemma Zle_le_S : (x,y:Z)`x<=y`->`x<=(Zs y)`. +Lemma Zle_le_succ : forall n m:Z, n <= m -> n <= Zsucc m. Proof. -Intros x y H. -Apply Zle_trans with y; Trivial with zarith. +intros x y H. +apply Zle_trans with y; trivial with zarith. Qed. -Lemma Zle_trans_S : (n,m:Z)`(Zs n)<=m`->`n<=m`. +Lemma Zle_succ_le : forall n m:Z, Zsucc n <= m -> n <= m. Proof. -Intros n m H;Apply Zle_trans with m:=(Zs n); [ Apply Zle_n_Sn | Assumption ]. +intros n m H; apply Zle_trans with (m := Zsucc n); + [ apply Zle_succ | assumption ]. Qed. -Hints Resolve Zle_le_S : zarith. +Hint Resolve Zle_le_succ: zarith. (** Relating order wrt successor and order wrt predecessor *) -Lemma Zgt_pred : (n,p:Z)`p>(Zs n)`->`(Zpred p)>n`. +Lemma Zgt_succ_pred : forall n m:Z, m > Zsucc n -> Zpred m > n. Proof. -Unfold Zgt Zs Zpred ;Intros n p H; -Rewrite <- [x,y:Z](Zcompare_Zplus_compatible x y (POS xH)); -Rewrite (Zplus_sym p); Rewrite Zplus_assoc; Rewrite [x:Z](Zplus_sym x n); -Simpl; Assumption. +unfold Zgt, Zsucc, Zpred in |- *; intros n p H; + rewrite <- (fun x y => Zcompare_plus_compat x y 1); + rewrite (Zplus_comm p); rewrite Zplus_assoc; + rewrite (fun x => Zplus_comm x n); simpl in |- *; + assumption. Qed. -Lemma Zlt_pred : (n,p:Z)`(Zs n)<p`->`n<(Zpred p)`. +Lemma Zlt_succ_pred : forall n m:Z, Zsucc n < m -> n < Zpred m. Proof. -Intros n p H;Apply Zlt_S_n; Rewrite <- Zs_pred; Assumption. +intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption. Qed. (** Relating strict order and large order on positive *) -Lemma Zlt_ZERO_pred_le_ZERO : (n:Z) `0<n` -> `0<=(Zpred n)`. -Intros x H. -Rewrite (Zs_pred x) in H. -Apply Zgt_S_le. -Apply Zlt_gt. -Assumption. +Lemma Zlt_0_le_0_pred : forall n:Z, 0 < n -> 0 <= Zpred n. +intros x H. +rewrite (Zsucc_pred x) in H. +apply Zgt_succ_le. +apply Zlt_gt. +assumption. Qed. -V7only [Set Implicit Arguments.]. -Lemma Zgt0_le_pred : (y:Z) `y > 0` -> `0 <= (Zpred y)`. -Intros; Apply Zlt_ZERO_pred_le_ZERO; Apply Zgt_lt. Assumption. +Lemma Zgt_0_le_0_pred : forall n:Z, n > 0 -> 0 <= Zpred n. +intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption. Qed. -V7only [Unset Implicit Arguments.]. (** Special cases of ordered integers *) -V7only [ (* Relevance confirmed from Zdivides *) ]. -Lemma Z_O_1: `0<1`. +Lemma Zlt_0_1 : 0 < 1. Proof. -Change `0<(Zs 0)`. Apply Zlt_n_Sn. +change (0 < Zsucc 0) in |- *. apply Zlt_succ. Qed. -Lemma Zle_0_1: `0<=1`. +Lemma Zle_0_1 : 0 <= 1. Proof. -Change `0<=(Zs 0)`. Apply Zle_n_Sn. +change (0 <= Zsucc 0) in |- *. apply Zle_succ. Qed. -V7only [ (* Relevance confirmed from Zdivides *) ]. -Lemma Zle_NEG_POS: (p,q:positive) `(NEG p)<=(POS q)`. +Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q. Proof. -Intros p; Red; Simpl; Red; Intros H; Discriminate. +intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate. Qed. -Lemma POS_gt_ZERO : (p:positive) `(POS p)>0`. -Unfold Zgt; Trivial. +Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0. +unfold Zgt in |- *; trivial. Qed. (* weaker but useful (in [Zpower] for instance) *) -Lemma ZERO_le_POS : (p:positive) `0<=(POS p)`. -Intro; Unfold Zle; Discriminate. +Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p. +intro; unfold Zle in |- *; discriminate. Qed. -Lemma NEG_lt_ZERO : (p:positive)`(NEG p)<0`. -Unfold Zlt; Trivial. +Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0. +unfold Zlt in |- *; trivial. Qed. -Lemma ZERO_le_inj : - (n:nat) `0 <= (inject_nat n)`. -Induction n; Simpl; Intros; -[ Apply Zle_n -| Unfold Zle; Simpl; Discriminate]. +Lemma Zle_0_nat : forall n:nat, 0 <= Z_of_nat n. +simple induction n; simpl in |- *; intros; + [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ]. Qed. -Hints Immediate Zle_refl : zarith. +Hint Immediate Zeq_le: zarith. (** Transitivity using successor *) -Lemma Zgt_trans_S : (n,m,p:Z)`(Zs n)>m`->`m>p`->`n>p`. +Lemma Zge_trans_succ : forall n m p:Z, Zsucc n > m -> m > p -> n > p. Proof. -Intros n m p H1 H2;Apply Zle_gt_trans with m:=m; - [ Apply Zgt_S_le; Assumption | Assumption ]. +intros n m p H1 H2; apply Zle_gt_trans with (m := m); + [ apply Zgt_succ_le; assumption | assumption ]. Qed. (** Derived lemma *) -Lemma Zgt_S : (n,m:Z)`(Zs n)>m`->(`n>m`\/(m=n)). +Lemma Zgt_succ_gt_or_eq : forall n m:Z, Zsucc n > m -> n > m \/ m = n. Proof. -Intros n m H. -Assert Hle : `m<=n`. - Apply Zgt_S_le; Assumption. -NewDestruct (Zle_lt_or_eq ? ? Hle) as [Hlt|Heq]. - Left; Apply Zlt_gt; Assumption. - Right; Assumption. +intros n m H. +assert (Hle : m <= n). + apply Zgt_succ_le; assumption. +destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq]. + left; apply Zlt_gt; assumption. + right; assumption. Qed. (** Compatibility of multiplication by a positive wrt to order *) -V7only [Set Implicit Arguments.]. -Lemma Zle_Zmult_pos_right : (a,b,c : Z) `a<=b` -> `0<=c` -> `a*c<=b*c`. +Lemma Zmult_le_compat_r : forall n m p:Z, n <= m -> 0 <= p -> n * p <= m * p. Proof. -Intros a b c H H0; NewDestruct c. - Do 2 Rewrite Zero_mult_right; Assumption. - Rewrite (Zmult_sym a); Rewrite (Zmult_sym b). - Unfold Zle; Rewrite Zcompare_Zmult_compatible; Assumption. - Unfold Zle in H0; Contradiction H0; Reflexivity. +intros a b c H H0; destruct c. + do 2 rewrite Zmult_0_r; assumption. + rewrite (Zmult_comm a); rewrite (Zmult_comm b). + unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption. + unfold Zle in H0; contradiction H0; reflexivity. Qed. -Lemma Zle_Zmult_pos_left : (a,b,c : Z) `a<=b` -> `0<=c` -> `c*a<=c*b`. +Lemma Zmult_le_compat_l : forall n m p:Z, n <= m -> 0 <= p -> p * n <= p * m. Proof. -Intros a b c H1 H2; Rewrite (Zmult_sym c a);Rewrite (Zmult_sym c b). -Apply Zle_Zmult_pos_right; Trivial. +intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b). +apply Zmult_le_compat_r; trivial. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_compat_r : (x,y,z:Z)`0<z` -> `x < y` -> `x*z < y*z`. +Lemma Zmult_lt_compat_r : forall n m p:Z, 0 < p -> n < m -> n * p < m * p. Proof. -Intros x y z H H0; NewDestruct z. - Contradiction (Zlt_n_n `0`). - Rewrite (Zmult_sym x); Rewrite (Zmult_sym y). - Unfold Zlt; Rewrite Zcompare_Zmult_compatible; Assumption. - Discriminate H. -Save. +intros x y z H H0; destruct z. + contradiction (Zlt_irrefl 0). + rewrite (Zmult_comm x); rewrite (Zmult_comm y). + unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption. + discriminate H. +Qed. -Lemma Zgt_Zmult_right : (x,y,z:Z)`z>0` -> `x > y` -> `x*z > y*z`. +Lemma Zmult_gt_compat_r : forall n m p:Z, p > 0 -> n > m -> n * p > m * p. Proof. -Intros x y z; Intros; Apply Zlt_gt; Apply Zmult_lt_compat_r; - Apply Zgt_lt; Assumption. +intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt; + assumption. Qed. -Lemma Zlt_Zmult_right : (x,y,z:Z)`z>0` -> `x < y` -> `x*z < y*z`. +Lemma Zmult_gt_0_lt_compat_r : + forall n m p:Z, p > 0 -> n < m -> n * p < m * p. Proof. -Intros x y z; Intros; Apply Zmult_lt_compat_r; - [Apply Zgt_lt; Assumption | Assumption]. +intros x y z; intros; apply Zmult_lt_compat_r; + [ apply Zgt_lt; assumption | assumption ]. Qed. -Lemma Zle_Zmult_right : (x,y,z:Z)`z>0` -> `x <= y` -> `x*z <= y*z`. +Lemma Zmult_gt_0_le_compat_r : + forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p. Proof. -Intros x y z Hz Hxy. -Elim (Zle_lt_or_eq x y Hxy). -Intros; Apply Zlt_le_weak. -Apply Zlt_Zmult_right; Trivial. -Intros; Apply Zle_refl. -Rewrite H; Trivial. +intros x y z Hz Hxy. +elim (Zle_lt_or_eq x y Hxy). +intros; apply Zlt_le_weak. +apply Zmult_gt_0_lt_compat_r; trivial. +intros; apply Zeq_le. +rewrite H; trivial. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_0_le_compat_r : (x,y,z:Z)`0 < z`->`x <= y`->`x*z <= y*z`. +Lemma Zmult_lt_0_le_compat_r : + forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p. Proof. -Intros x y z; Intros; Apply Zle_Zmult_right; Try Apply Zlt_gt; Assumption. +intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt; + assumption. Qed. -Lemma Zlt_Zmult_left : (x,y,z:Z)`z>0` -> `x < y` -> `z*x < z*y`. +Lemma Zmult_gt_0_lt_compat_l : + forall n m p:Z, p > 0 -> n < m -> p * n < p * m. Proof. -Intros x y z; Intros. -Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y); -Apply Zlt_Zmult_right; Assumption. +intros x y z; intros. +rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); + apply Zmult_gt_0_lt_compat_r; assumption. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_compat_l : (x,y,z:Z)`0<z` -> `x < y` -> `z*x < z*y`. +Lemma Zmult_lt_compat_l : forall n m p:Z, 0 < p -> n < m -> p * n < p * m. Proof. -Intros x y z; Intros. -Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y); -Apply Zlt_Zmult_right; Try Apply Zlt_gt; Assumption. -Save. +intros x y z; intros. +rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); + apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption. +Qed. -Lemma Zgt_Zmult_left : (x,y,z:Z)`z>0` -> `x > y` -> `z*x > z*y`. +Lemma Zmult_gt_compat_l : forall n m p:Z, p > 0 -> n > m -> p * n > p * m. Proof. -Intros x y z; Intros; -Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y); -Apply Zgt_Zmult_right; Assumption. +intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); + apply Zmult_gt_compat_r; assumption. Qed. -Lemma Zge_Zmult_pos_right : (a,b,c : Z) `a>=b` -> `c>=0` -> `a*c>=b*c`. +Lemma Zmult_ge_compat_r : forall n m p:Z, n >= m -> p >= 0 -> n * p >= m * p. Proof. -Intros a b c H1 H2; Apply Zle_ge. -Apply Zle_Zmult_pos_right; Apply Zge_le; Trivial. +intros a b c H1 H2; apply Zle_ge. +apply Zmult_le_compat_r; apply Zge_le; trivial. Qed. -Lemma Zge_Zmult_pos_left : (a,b,c : Z) `a>=b` -> `c>=0` -> `c*a>=c*b`. +Lemma Zmult_ge_compat_l : forall n m p:Z, n >= m -> p >= 0 -> p * n >= p * m. Proof. -Intros a b c H1 H2; Apply Zle_ge. -Apply Zle_Zmult_pos_left; Apply Zge_le; Trivial. +intros a b c H1 H2; apply Zle_ge. +apply Zmult_le_compat_l; apply Zge_le; trivial. Qed. -Lemma Zge_Zmult_pos_compat : - (a,b,c,d : Z) `a>=c` -> `b>=d` -> `c>=0` -> `d>=0` -> `a*b>=c*d`. +Lemma Zmult_ge_compat : + forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q. Proof. -Intros a b c d H0 H1 H2 H3. -Apply Zge_trans with (Zmult a d). -Apply Zge_Zmult_pos_left; Trivial. -Apply Zge_trans with c; Trivial. -Apply Zge_Zmult_pos_right; Trivial. +intros a b c d H0 H1 H2 H3. +apply Zge_trans with (a * d). +apply Zmult_ge_compat_l; trivial. +apply Zge_trans with c; trivial. +apply Zmult_ge_compat_r; trivial. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_le_compat: (a, b, c, d : Z) - `a<=c` -> `b<=d` -> `0<=a` -> `0<=b` -> `a*b<=c*d`. +Lemma Zmult_le_compat : + forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q. Proof. -Intros a b c d H0 H1 H2 H3. -Apply Zle_trans with (Zmult c b). -Apply Zle_Zmult_pos_right; Assumption. -Apply Zle_Zmult_pos_left. -Assumption. -Apply Zle_trans with a; Assumption. +intros a b c d H0 H1 H2 H3. +apply Zle_trans with (c * b). +apply Zmult_le_compat_r; assumption. +apply Zmult_le_compat_l. +assumption. +apply Zle_trans with a; assumption. Qed. (** Simplification of multiplication by a positive wrt to being positive *) -Lemma Zlt_Zmult_right2 : (x,y,z:Z)`z>0` -> `x*z < y*z` -> `x < y`. +Lemma Zmult_gt_0_lt_reg_r : forall n m p:Z, p > 0 -> n * p < m * p -> n < m. Proof. -Intros x y z; Intros; NewDestruct z. - Contradiction (Zgt_antirefl `0`). - Rewrite (Zmult_sym x) in H0; Rewrite (Zmult_sym y) in H0. - Unfold Zlt in H0; Rewrite Zcompare_Zmult_compatible in H0; Assumption. - Discriminate H. +intros x y z; intros; destruct z. + contradiction (Zgt_irrefl 0). + rewrite (Zmult_comm x) in H0; rewrite (Zmult_comm y) in H0. + unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption. + discriminate H. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_reg_r : (a, b, c : Z) `0<c` -> `a*c<b*c` -> `a<b`. +Lemma Zmult_lt_reg_r : forall n m p:Z, 0 < p -> n * p < m * p -> n < m. Proof. -Intros a b c H0 H1. -Apply Zlt_Zmult_right2 with c; Try Apply Zlt_gt; Assumption. +intros a b c H0 H1. +apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption. Qed. -Lemma Zle_mult_simpl : (a,b,c:Z)`c>0`->`a*c<=b*c`->`a<=b`. +Lemma Zmult_le_reg_r : forall n m p:Z, p > 0 -> n * p <= m * p -> n <= m. Proof. -Intros x y z Hz Hxy. -Elim (Zle_lt_or_eq `x*z` `y*z` Hxy). -Intros; Apply Zlt_le_weak. -Apply Zlt_Zmult_right2 with z; Trivial. -Intros; Apply Zle_refl. -Apply Zmult_reg_right with z. - Intro. Rewrite H0 in Hz. Contradiction (Zgt_antirefl `0`). -Assumption. +intros x y z Hz Hxy. +elim (Zle_lt_or_eq (x * z) (y * z) Hxy). +intros; apply Zlt_le_weak. +apply Zmult_gt_0_lt_reg_r with z; trivial. +intros; apply Zeq_le. +apply Zmult_reg_r with z. + intro. rewrite H0 in Hz. contradiction (Zgt_irrefl 0). +assumption. Qed. -V7only [Notation Zle_Zmult_right2 := Zle_mult_simpl. -(* Zle_Zmult_right2 : (x,y,z:Z)`z>0` -> `x*z <= y*z` -> `x <= y`. *) -]. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_0_le_reg_r: (x,y,z:Z)`0 <z`->`x*z <= y*z`->`x <= y`. -Intros x y z; Intros ; Apply Zle_mult_simpl with z. -Try Apply Zlt_gt; Assumption. -Assumption. +Lemma Zmult_lt_0_le_reg_r : forall n m p:Z, 0 < p -> n * p <= m * p -> n <= m. +intros x y z; intros; apply Zmult_le_reg_r with z. +try apply Zlt_gt; assumption. +assumption. Qed. -V7only [Unset Implicit Arguments.]. -Lemma Zge_mult_simpl : (a,b,c:Z) `c>0`->`a*c>=b*c`->`a>=b`. -Intros a b c H1 H2; Apply Zle_ge; Apply Zle_mult_simpl with c; Trivial. -Apply Zge_le; Trivial. +Lemma Zmult_ge_reg_r : forall n m p:Z, p > 0 -> n * p >= m * p -> n >= m. +intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial. +apply Zge_le; trivial. Qed. -Lemma Zgt_mult_simpl : (a,b,c:Z) `c>0`->`a*c>b*c`->`a>b`. -Intros a b c H1 H2; Apply Zlt_gt; Apply Zlt_Zmult_right2 with c; Trivial. -Apply Zgt_lt; Trivial. +Lemma Zmult_gt_reg_r : forall n m p:Z, p > 0 -> n * p > m * p -> n > m. +intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial. +apply Zgt_lt; trivial. Qed. (** Compatibility of multiplication by a positive wrt to being positive *) -Lemma Zle_ZERO_mult : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x*y`. +Lemma Zmult_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n * m. Proof. -Intros x y; Case x. -Intros; Rewrite Zero_mult_left; Trivial. -Intros p H1; Unfold Zle. - Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)). - Rewrite Zcompare_Zmult_compatible; Trivial. -Intros p H1 H2; Absurd (Zgt ZERO (NEG p)); Trivial. -Unfold Zgt; Simpl; Auto with zarith. +intros x y; case x. +intros; rewrite Zmult_0_l; trivial. +intros p H1; unfold Zle in |- *. + pattern 0 at 2 in |- *; rewrite <- (Zmult_0_r (Zpos p)). + rewrite Zcompare_mult_compat; trivial. +intros p H1 H2; absurd (0 > Zneg p); trivial. +unfold Zgt in |- *; simpl in |- *; auto with zarith. Qed. -Lemma Zgt_ZERO_mult: (a,b:Z) `a>0`->`b>0`->`a*b>0`. +Lemma Zmult_gt_0_compat : forall n m:Z, n > 0 -> m > 0 -> n * m > 0. Proof. -Intros x y; Case x. -Intros H; Discriminate H. -Intros p H1; Unfold Zgt; -Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)). - Rewrite Zcompare_Zmult_compatible; Trivial. -Intros p H; Discriminate H. +intros x y; case x. +intros H; discriminate H. +intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *; + rewrite <- (Zmult_0_r (Zpos p)). + rewrite Zcompare_mult_compat; trivial. +intros p H; discriminate H. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_O_compat : (a, b : Z) `0<a` -> `0<b` -> `0<a*b`. -Intros a b apos bpos. -Apply Zgt_lt. -Apply Zgt_ZERO_mult; Try Apply Zlt_gt; Assumption. +Lemma Zmult_lt_O_compat : forall n m:Z, 0 < n -> 0 < m -> 0 < n * m. +intros a b apos bpos. +apply Zgt_lt. +apply Zmult_gt_0_compat; try apply Zlt_gt; assumption. Qed. -Lemma Zle_mult: (x,y:Z) `x>0` -> `0<=y` -> `0<=(Zmult y x)`. +Lemma Zmult_gt_0_le_0_compat : forall n m:Z, n > 0 -> 0 <= m -> 0 <= m * n. Proof. -Intros x y H1 H2; Apply Zle_ZERO_mult; Trivial. -Apply Zlt_le_weak; Apply Zgt_lt; Trivial. +intros x y H1 H2; apply Zmult_le_0_compat; trivial. +apply Zlt_le_weak; apply Zgt_lt; trivial. Qed. (** Simplification of multiplication by a positive wrt to being positive *) -Lemma Zmult_le: (x,y:Z) `x>0` -> `0<=(Zmult y x)` -> `0<=y`. +Lemma Zmult_le_0_reg_r : forall n m:Z, n > 0 -> 0 <= m * n -> 0 <= m. Proof. -Intros x y; Case x; [ - Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H -| Intros p H1; Unfold Zle; Rewrite -> Zmult_sym; - Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p)); - Rewrite Zcompare_Zmult_compatible; Auto with arith -| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H]. +intros x y; case x; + [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H + | intros p H1; unfold Zle in |- *; rewrite Zmult_comm; + pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)); + rewrite Zcompare_mult_compat; auto with arith + | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ]. Qed. -Lemma Zmult_lt: (x,y:Z) `x>0` -> `0<y*x` -> `0<y`. +Lemma Zmult_gt_0_lt_0_reg_r : forall n m:Z, n > 0 -> 0 < m * n -> 0 < m. Proof. -Intros x y; Case x; [ - Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H -| Intros p H1; Unfold Zlt; Rewrite -> Zmult_sym; - Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p)); - Rewrite Zcompare_Zmult_compatible; Auto with arith -| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H]. +intros x y; case x; + [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H + | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm; + pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)); + rewrite Zcompare_mult_compat; auto with arith + | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ]. Qed. -V7only [ (* Relevance confirmed from Zextensions *) ]. -Lemma Zmult_lt_0_reg_r : (x,y:Z)`0 < x`->`0 < y*x`->`0 < y`. +Lemma Zmult_lt_0_reg_r : forall n m:Z, 0 < n -> 0 < m * n -> 0 < m. Proof. -Intros x y; Intros; EApply Zmult_lt with x ; Try Apply Zlt_gt; Assumption. +intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt; + assumption. Qed. -Lemma Zmult_gt: (x,y:Z) `x>0` -> `x*y>0` -> `y>0`. +Lemma Zmult_gt_0_reg_l : forall n m:Z, n > 0 -> n * m > 0 -> m > 0. Proof. -Intros x y; Case x. - Intros H; Discriminate H. - Intros p H1; Unfold Zgt. - Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p)). - Rewrite Zcompare_Zmult_compatible; Trivial. -Intros p H; Discriminate H. +intros x y; case x. + intros H; discriminate H. + intros p H1; unfold Zgt in |- *. + pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)). + rewrite Zcompare_mult_compat; trivial. +intros p H; discriminate H. Qed. (** Simplification of square wrt order *) -Lemma Zgt_square_simpl: (x, y : Z) `x>=0` -> `y>=0` -> `x*x>y*y` -> `x>y`. +Lemma Zgt_square_simpl : + forall n m:Z, n >= 0 -> m >= 0 -> n * n > m * m -> n > m. Proof. -Intros x y H0 H1 H2. -Case (dec_Zlt y x). -Intro; Apply Zlt_gt; Trivial. -Intros H3; Cut (Zge y x). -Intros H. -Elim Zgt_not_le with 1 := H2. -Apply Zge_le. -Apply Zge_Zmult_pos_compat; Auto. -Apply not_Zlt; Trivial. +intros x y H0 H1 H2. +case (dec_Zlt y x). +intro; apply Zlt_gt; trivial. +intros H3; cut (y >= x). +intros H. +elim Zgt_not_le with (1 := H2). +apply Zge_le. +apply Zmult_ge_compat; auto. +apply Znot_lt_ge; trivial. Qed. -Lemma Zlt_square_simpl: (x,y:Z) `0<=x` -> `0<=y` -> `y*y<x*x` -> `y<x`. +Lemma Zlt_square_simpl : + forall n m:Z, 0 <= n -> 0 <= m -> m * m < n * n -> m < n. Proof. -Intros x y H0 H1 H2. -Apply Zgt_lt. -Apply Zgt_square_simpl; Try Apply Zle_ge; Try Apply Zlt_gt; Assumption. +intros x y H0 H1 H2. +apply Zgt_lt. +apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption. Qed. (** Equivalence between inequalities *) -Lemma Zle_plus_swap : (x,y,z:Z) `x+z<=y` <-> `x<=y-z`. +Lemma Zle_plus_swap : forall n m p:Z, n + p <= m <-> n <= m - p. Proof. - Intros x y z; Intros. Split. Intro. Rewrite <- (Zero_right x). Rewrite <- (Zplus_inverse_r z). - Rewrite Zplus_assoc_l. Exact (Zle_reg_r ? ? ? H). - Intro. Rewrite <- (Zero_right y). Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_l. - Apply Zle_reg_r. Assumption. + intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z). + rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H). + intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc. + apply Zplus_le_compat_r. assumption. Qed. -Lemma Zlt_plus_swap : (x,y,z:Z) `x+z<y` <-> `x<y-z`. +Lemma Zlt_plus_swap : forall n m p:Z, n + p < m <-> n < m - p. Proof. - Intros x y z; Intros. Split. Intro. Unfold Zminus. Rewrite Zplus_sym. Rewrite <- (Zero_left x). - Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym. - Assumption. - Intro. Rewrite Zplus_sym. Rewrite <- (Zero_left y). Rewrite <- (Zplus_inverse_r z). - Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym. Assumption. + intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x). + rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. + assumption. + intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z). + rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption. Qed. -Lemma Zeq_plus_swap : (x,y,z:Z)`x+z=y` <-> `x=y-z`. +Lemma Zeq_plus_swap : forall n m p:Z, n + p = m <-> n = m - p. Proof. -Intros x y z; Intros. Split. Intro. Apply Zplus_minus. Symmetry. Rewrite Zplus_sym. - Assumption. -Intro. Rewrite H. Unfold Zminus. Rewrite Zplus_assoc_r. - Rewrite Zplus_inverse_l. Apply Zero_right. +intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry in |- *. rewrite Zplus_comm. + assumption. +intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. + rewrite Zplus_opp_l. apply Zplus_0_r. Qed. -Lemma Zlt_minus : (n,m:Z)`0<m`->`n-m<n`. +Lemma Zlt_minus_simpl_swap : forall n m:Z, 0 < m -> n - m < n. Proof. -Intros n m H; Apply Zsimpl_lt_plus_l with p:=m; Rewrite Zle_plus_minus; -Pattern 1 n ;Rewrite <- (Zero_right n); Rewrite (Zplus_sym m n); -Apply Zlt_reg_l; Assumption. +intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus; + pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); + rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; + assumption. Qed. -Lemma Zlt_O_minus_lt : (n,m:Z)`0<n-m`->`m<n`. +Lemma Zlt_O_minus_lt : forall n m:Z, 0 < n - m -> m < n. Proof. -Intros n m H; Apply Zsimpl_lt_plus_l with p:=(Zopp m); Rewrite Zplus_inverse_l; -Rewrite Zplus_sym;Exact H. -Qed. +intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l; + rewrite Zplus_comm; exact H. +Qed.
\ No newline at end of file diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v index 73e8a08da..c19ef4499 100644 --- a/theories/ZArith/Zpower.v +++ b/theories/ZArith/Zpower.v @@ -8,10 +8,9 @@ (*i $Id$ i*) -Require ZArith_base. -Require Omega. -Require Zcomplements. -V7only [Import Z_scope.]. +Require Import ZArith_base. +Require Import Omega. +Require Import Zcomplements. Open Local Scope Z_scope. Section section1. @@ -19,86 +18,85 @@ Section section1. (** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary integer (type [nat]) and [z] a signed integer (type [Z]) *) -Definition Zpower_nat := - [z:Z][n:nat] (iter_nat n Z ([x:Z]` z * x `) `1`). +Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1. (** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for [plus : nat->nat] and [Zmult : Z->Z] *) -Lemma Zpower_nat_is_exp : - (n,m:nat)(z:Z) - `(Zpower_nat z (plus n m)) = (Zpower_nat z n)*(Zpower_nat z m)`. +Lemma Zpower_nat_is_exp : + forall (n m:nat) (z:Z), + Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m. -Intros; Elim n; -[ Simpl; Elim (Zpower_nat z m); Auto with zarith -| Unfold Zpower_nat; Intros; Simpl; Rewrite H; - Apply Zmult_assoc]. +intros; elim n; + [ simpl in |- *; elim (Zpower_nat z m); auto with zarith + | unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H; + apply Zmult_assoc ]. Qed. (** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary integer (type [positive]) and [z] a signed integer (type [Z]) *) -Definition Zpower_pos := - [z:Z][n:positive] (iter_pos n Z ([x:Z]`z * x`) `1`). +Definition Zpower_pos (z:Z) (n:positive) := iter_pos n Z (fun x:Z => z * x) 1. (** This theorem shows that powers of unary and binary integers are the same thing, modulo the function convert : [positive -> nat] *) -Theorem Zpower_pos_nat : - (z:Z)(p:positive)(Zpower_pos z p) = (Zpower_nat z (convert p)). +Theorem Zpower_pos_nat : + forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p). -Intros; Unfold Zpower_pos; Unfold Zpower_nat; Apply iter_convert. +intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *; + apply iter_nat_of_P. Qed. (** Using the theorem [Zpower_pos_nat] and the lemma [Zpower_nat_is_exp] we deduce that the function [[n:positive](Zpower_pos z n)] is a morphism for [add : positive->positive] and [Zmult : Z->Z] *) -Theorem Zpower_pos_is_exp : - (n,m:positive)(z:Z) - ` (Zpower_pos z (add n m)) = (Zpower_pos z n)*(Zpower_pos z m)`. +Theorem Zpower_pos_is_exp : + forall (n m:positive) (z:Z), + Zpower_pos z (n + m) = Zpower_pos z n * Zpower_pos z m. -Intros. -Rewrite -> (Zpower_pos_nat z n). -Rewrite -> (Zpower_pos_nat z m). -Rewrite -> (Zpower_pos_nat z (add n m)). -Rewrite -> (convert_add n m). -Apply Zpower_nat_is_exp. +intros. +rewrite (Zpower_pos_nat z n). +rewrite (Zpower_pos_nat z m). +rewrite (Zpower_pos_nat z (n + m)). +rewrite (nat_of_P_plus_morphism n m). +apply Zpower_nat_is_exp. Qed. -Definition Zpower := - [x,y:Z]Cases y of - (POS p) => (Zpower_pos x p) - | ZERO => `1` - | (NEG p) => `0` +Definition Zpower (x y:Z) := + match y with + | Zpos p => Zpower_pos x p + | Z0 => 1 + | Zneg p => 0 end. -Infix "^" Zpower (at level 2, left associativity) : Z_scope V8only. +Infix "^" := Zpower : Z_scope. -Hints Immediate Zpower_nat_is_exp : zarith. -Hints Immediate Zpower_pos_is_exp : zarith. -Hints Unfold Zpower_pos : zarith. -Hints Unfold Zpower_nat : zarith. +Hint Immediate Zpower_nat_is_exp: zarith. +Hint Immediate Zpower_pos_is_exp: zarith. +Hint Unfold Zpower_pos: zarith. +Hint Unfold Zpower_nat: zarith. -Lemma Zpower_exp : (x:Z)(n,m:Z) - `n >= 0` -> `m >= 0` -> `(Zpower x (n+m))=(Zpower x n)*(Zpower x m)`. -NewDestruct n; NewDestruct m; Auto with zarith. -Simpl; Intros; Apply Zred_factor0. -Simpl; Auto with zarith. -Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith. -Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith. +Lemma Zpower_exp : + forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m. +destruct n; destruct m; auto with zarith. +simpl in |- *; intros; apply Zred_factor0. +simpl in |- *; auto with zarith. +intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith. +intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith. Qed. End section1. (* Exporting notation "^" *) -Infix "^" Zpower (at level 2, left associativity) : Z_scope V8only. +Infix "^" := Zpower : Z_scope. -Hints Immediate Zpower_nat_is_exp : zarith. -Hints Immediate Zpower_pos_is_exp : zarith. -Hints Unfold Zpower_pos : zarith. -Hints Unfold Zpower_nat : zarith. +Hint Immediate Zpower_nat_is_exp: zarith. +Hint Immediate Zpower_pos_is_exp: zarith. +Hint Unfold Zpower_pos: zarith. +Hint Unfold Zpower_nat: zarith. Section Powers_of_2. @@ -109,100 +107,96 @@ Section Powers_of_2. (** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *) -Definition shift_nat := - [n:nat][z:positive](iter_nat n positive xO z). -Definition shift_pos := - [n:positive][z:positive](iter_pos n positive xO z). -Definition shift := - [n:Z][z:positive] - Cases n of - ZERO => z - | (POS p) => (iter_pos p positive xO z) - | (NEG p) => z +Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z. +Definition shift_pos (n z:positive) := iter_pos n positive xO z. +Definition shift (n:Z) (z:positive) := + match n with + | Z0 => z + | Zpos p => iter_pos p positive xO z + | Zneg p => z end. -Definition two_power_nat := [n:nat] (POS (shift_nat n xH)). -Definition two_power_pos := [x:positive] (POS (shift_pos x xH)). +Definition two_power_nat (n:nat) := Zpos (shift_nat n 1). +Definition two_power_pos (x:positive) := Zpos (shift_pos x 1). -Lemma two_power_nat_S : - (n:nat)` (two_power_nat (S n)) = 2*(two_power_nat n)`. -Intro; Simpl; Apply refl_equal. +Lemma two_power_nat_S : + forall n:nat, two_power_nat (S n) = 2 * two_power_nat n. +intro; simpl in |- *; apply refl_equal. Qed. Lemma shift_nat_plus : - (n,m:nat)(x:positive) - (shift_nat (plus n m) x)=(shift_nat n (shift_nat m x)). + forall (n m:nat) (x:positive), + shift_nat (n + m) x = shift_nat n (shift_nat m x). -Intros; Unfold shift_nat; Apply iter_nat_plus. +intros; unfold shift_nat in |- *; apply iter_nat_plus. Qed. Theorem shift_nat_correct : - (n:nat)(x:positive)(POS (shift_nat n x))=`(Zpower_nat 2 n)*(POS x)`. - -Unfold shift_nat; Induction n; -[ Simpl; Trivial with zarith -| Intros; Replace (Zpower_nat `2` (S n0)) with `2 * (Zpower_nat 2 n0)`; -[ Rewrite <- Zmult_assoc; Rewrite <- (H x); Simpl; Reflexivity -| Auto with zarith ] -]. + forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x. + +unfold shift_nat in |- *; simple induction n; + [ simpl in |- *; trivial with zarith + | intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0); + [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity + | auto with zarith ] ]. Qed. Theorem two_power_nat_correct : - (n:nat)(two_power_nat n)=(Zpower_nat `2` n). + forall n:nat, two_power_nat n = Zpower_nat 2 n. -Intro n. -Unfold two_power_nat. -Rewrite -> (shift_nat_correct n). -Omega. +intro n. +unfold two_power_nat in |- *. +rewrite (shift_nat_correct n). +omega. Qed. (** Second we show that [two_power_pos] and [two_power_nat] are the same *) -Lemma shift_pos_nat : (p:positive)(x:positive) - (shift_pos p x)=(shift_nat (convert p) x). +Lemma shift_pos_nat : + forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x. -Unfold shift_pos. -Unfold shift_nat. -Intros; Apply iter_convert. +unfold shift_pos in |- *. +unfold shift_nat in |- *. +intros; apply iter_nat_of_P. Qed. -Lemma two_power_pos_nat : - (p:positive) (two_power_pos p)=(two_power_nat (convert p)). +Lemma two_power_pos_nat : + forall p:positive, two_power_pos p = two_power_nat (nat_of_P p). -Intro; Unfold two_power_pos; Unfold two_power_nat. -Apply f_equal with f:=POS. -Apply shift_pos_nat. +intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *. +apply f_equal with (f := Zpos). +apply shift_pos_nat. Qed. (** Then we deduce that [two_power_pos] is also correct *) Theorem shift_pos_correct : - (p,x:positive) ` (POS (shift_pos p x)) = (Zpower_pos 2 p) * (POS x)`. + forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x. -Intros. -Rewrite -> (shift_pos_nat p x). -Rewrite -> (Zpower_pos_nat `2` p). -Apply shift_nat_correct. +intros. +rewrite (shift_pos_nat p x). +rewrite (Zpower_pos_nat 2 p). +apply shift_nat_correct. Qed. -Theorem two_power_pos_correct : - (x:positive) (two_power_pos x)=(Zpower_pos `2` x). +Theorem two_power_pos_correct : + forall x:positive, two_power_pos x = Zpower_pos 2 x. -Intro. -Rewrite -> two_power_pos_nat. -Rewrite -> Zpower_pos_nat. -Apply two_power_nat_correct. +intro. +rewrite two_power_pos_nat. +rewrite Zpower_pos_nat. +apply two_power_nat_correct. Qed. (** Some consequences *) Theorem two_power_pos_is_exp : - (x,y:positive) (two_power_pos (add x y)) - =(Zmult (two_power_pos x) (two_power_pos y)). -Intros. -Rewrite -> (two_power_pos_correct (add x y)). -Rewrite -> (two_power_pos_correct x). -Rewrite -> (two_power_pos_correct y). -Apply Zpower_pos_is_exp. + forall x y:positive, + two_power_pos (x + y) = two_power_pos x * two_power_pos y. +intros. +rewrite (two_power_pos_correct (x + y)). +rewrite (two_power_pos_correct x). +rewrite (two_power_pos_correct y). +apply Zpower_pos_is_exp. Qed. (** The exponentiation [z -> 2^z] for [z] a signed integer. @@ -211,80 +205,71 @@ Qed. 3 contructors [ Zero | Pos positive -> | minus_infty] but it's more complexe and not so useful. *) -Definition two_p := - [x:Z]Cases x of - ZERO => `1` - | (POS y) => (two_power_pos y) - | (NEG y) => `0` - end. +Definition two_p (x:Z) := + match x with + | Z0 => 1 + | Zpos y => two_power_pos y + | Zneg y => 0 + end. Theorem two_p_is_exp : - (x,y:Z) ` 0 <= x` -> ` 0 <= y` -> - ` (two_p (x+y)) = (two_p x)*(two_p y)`. -Induction x; -[ Induction y; Simpl; Auto with zarith -| Induction y; - [ Unfold two_p; Rewrite -> (Zmult_sym (two_power_pos p) `1`); - Rewrite -> (Zmult_one (two_power_pos p)); Auto with zarith - | Unfold Zplus; Unfold two_p; - Intros; Apply two_power_pos_is_exp - | Intros; Unfold Zle in H0; Unfold Zcompare in H0; - Absurd SUPERIEUR=SUPERIEUR; Trivial with zarith - ] -| Induction y; - [ Simpl; Auto with zarith - | Intros; Unfold Zle in H; Unfold Zcompare in H; - Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith - | Intros; Unfold Zle in H; Unfold Zcompare in H; - Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith - ] -]. + forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y. +simple induction x; + [ simple induction y; simpl in |- *; auto with zarith + | simple induction y; + [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1); + rewrite (Zmult_1_l (two_power_pos p)); auto with zarith + | unfold Zplus in |- *; unfold two_p in |- *; intros; + apply two_power_pos_is_exp + | intros; unfold Zle in H0; unfold Zcompare in H0; + absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] + | simple induction y; + [ simpl in |- *; auto with zarith + | intros; unfold Zle in H; unfold Zcompare in H; + absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith + | intros; unfold Zle in H; unfold Zcompare in H; + absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ]. Qed. -Lemma two_p_gt_ZERO : (x:Z) ` 0 <= x` -> ` (two_p x) > 0`. -Induction x; Intros; -[ Simpl; Omega -| Simpl; Unfold two_power_pos; Apply POS_gt_ZERO -| Absurd ` 0 <= (NEG p)`; - [ Simpl; Unfold Zle; Unfold Zcompare; - Do 2 Unfold not; Auto with zarith - | Assumption ] -]. +Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0. +simple induction x; intros; + [ simpl in |- *; omega + | simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0 + | absurd (0 <= Zneg p); + [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *; + do 2 unfold not in |- *; auto with zarith + | assumption ] ]. Qed. -Lemma two_p_S : (x:Z) ` 0 <= x` -> - `(two_p (Zs x)) = 2 * (two_p x)`. -Intros; Unfold Zs. -Rewrite (two_p_is_exp x `1` H (ZERO_le_POS xH)). -Apply Zmult_sym. +Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x. +intros; unfold Zsucc in |- *. +rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)). +apply Zmult_comm. Qed. -Lemma two_p_pred : - (x:Z)` 0 <= x` -> ` (two_p (Zpred x)) < (two_p x)`. -Intros; Apply natlike_ind -with P:=[x:Z]` (two_p (Zpred x)) < (two_p x)`; -[ Simpl; Unfold Zlt; Auto with zarith -| Intros; Elim (Zle_lt_or_eq `0` x0 H0); - [ Intros; - Replace (two_p (Zpred (Zs x0))) - with (two_p (Zs (Zpred x0))); - [ Rewrite -> (two_p_S (Zpred x0)); - [ Rewrite -> (two_p_S x0); - [ Omega - | Assumption] - | Apply Zlt_ZERO_pred_le_ZERO; Assumption] - | Rewrite <- (Zs_pred x0); Rewrite <- (Zpred_Sn x0); Trivial with zarith] - | Intro Hx0; Rewrite <- Hx0; Simpl; Unfold Zlt; Auto with zarith] -| Assumption]. +Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x. +intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x); + [ simpl in |- *; unfold Zlt in |- *; auto with zarith + | intros; elim (Zle_lt_or_eq 0 x0 H0); + [ intros; + replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0))); + [ rewrite (two_p_S (Zpred x0)); + [ rewrite (two_p_S x0); [ omega | assumption ] + | apply Zorder.Zlt_0_le_0_pred; assumption ] + | rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0); + trivial with zarith ] + | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *; + auto with zarith ] + | assumption ]. Qed. -Lemma Zlt_lt_double : (x,y:Z) ` 0 <= x < y` -> ` x < 2*y`. -Intros; Omega. Qed. +Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y. +intros; omega. Qed. End Powers_of_2. -Hints Resolve two_p_gt_ZERO : zarith. -Hints Immediate two_p_pred two_p_S : zarith. +Hint Resolve two_p_gt_ZERO: zarith. +Hint Immediate two_p_pred two_p_S: zarith. Section power_div_with_rest. @@ -293,102 +278,95 @@ Section power_div_with_rest. [n = 2^p.q + r] and [0 <= r < 2^p] *) (** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<= r < d /\ 0 <= r' < d'] *) -Definition Zdiv_rest_aux := - [qrd:(Z*Z)*Z] - let (qr,d)=qrd in let (q,r)=qr in - (Cases q of - ZERO => ` (0, r)` - | (POS xH) => ` (0, d + r)` - | (POS (xI n)) => ` ((POS n), d + r)` - | (POS (xO n)) => ` ((POS n), r)` - | (NEG xH) => ` (-1, d + r)` - | (NEG (xI n)) => ` ((NEG n) - 1, d + r)` - | (NEG (xO n)) => ` ((NEG n), r)` - end, ` 2*d`). - -Definition Zdiv_rest := - [x:Z][p:positive]let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in qr. +Definition Zdiv_rest_aux (qrd:Z * Z * Z) := + let (qr, d) := qrd in + let (q, r) := qr in + (match q with + | Z0 => (0, r) + | Zpos xH => (0, d + r) + | Zpos (xI n) => (Zpos n, d + r) + | Zpos (xO n) => (Zpos n, r) + | Zneg xH => (-1, d + r) + | Zneg (xI n) => (Zneg n - 1, d + r) + | Zneg (xO n) => (Zneg n, r) + end, 2 * d). + +Definition Zdiv_rest (x:Z) (p:positive) := + let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr. Lemma Zdiv_rest_correct1 : - (x:Z)(p:positive) - let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in d=(two_power_pos p). - -Intros x p; -Rewrite (iter_convert p ? Zdiv_rest_aux ((x,`0`),`1`)); -Rewrite (two_power_pos_nat p); -Elim (convert p); Simpl; -[ Trivial with zarith -| Intro n; Rewrite (two_power_nat_S n); - Unfold 2 Zdiv_rest_aux; - Elim (iter_nat n (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`)); - NewDestruct a; Intros; Apply f_equal with f:=[z:Z]`2*z`; Assumption ]. + forall (x:Z) (p:positive), + let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p. + +intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1)); + rewrite (two_power_pos_nat p); elim (nat_of_P p); + simpl in |- *; + [ trivial with zarith + | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *; + elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); + destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z); + assumption ]. Qed. Lemma Zdiv_rest_correct2 : - (x:Z)(p:positive) - let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in - let (q,r)=qr in - ` x=q*d + r` /\ ` 0 <= r < d`. - -Intros; Apply iter_pos_invariant with - f:=Zdiv_rest_aux - Inv:=[qrd:(Z*Z)*Z]let (qr,d)=qrd in let (q,r)=qr in - ` x=q*d + r` /\ ` 0 <= r < d`; -[ Intro x0; Elim x0; Intro y0; Elim y0; - Intros q r d; Unfold Zdiv_rest_aux; - Elim q; - [ Omega - | NewDestruct p0; - [ Rewrite POS_xI; Intro; Elim H; Intros; Split; - [ Rewrite H0; Rewrite Zplus_assoc; - Rewrite Zmult_plus_distr_l; - Rewrite Zmult_1_n; Rewrite Zmult_assoc; - Rewrite (Zmult_sym (POS p0) `2`); Apply refl_equal - | Omega ] - | Rewrite POS_xO; Intro; Elim H; Intros; Split; - [ Rewrite H0; - Rewrite Zmult_assoc; Rewrite (Zmult_sym (POS p0) `2`); - Apply refl_equal - | Omega ] - | Omega ] - | NewDestruct p0; - [ Rewrite NEG_xI; Unfold Zminus; Intro; Elim H; Intros; Split; - [ Rewrite H0; Rewrite Zplus_assoc; - Apply f_equal with f:=[z:Z]`z+r`; - Do 2 (Rewrite Zmult_plus_distr_l); - Rewrite Zmult_assoc; - Rewrite (Zmult_sym (NEG p0) `2`); - Rewrite <- Zplus_assoc; - Apply f_equal with f:=[z:Z]`2 * (NEG p0) * d + z`; - Omega - | Omega ] - | Rewrite NEG_xO; Unfold Zminus; Intro; Elim H; Intros; Split; - [ Rewrite H0; - Rewrite Zmult_assoc; Rewrite (Zmult_sym (NEG p0) `2`); - Apply refl_equal - | Omega ] - | Omega ] ] -| Omega]. + forall (x:Z) (p:positive), + let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in + let (q, r) := qr in x = q * d + r /\ 0 <= r < d. + +intros; + apply iter_pos_invariant with + (f := Zdiv_rest_aux) + (Inv := fun qrd:Z * Z * Z => + let (qr, d) := qrd in + let (q, r) := qr in x = q * d + r /\ 0 <= r < d); + [ intro x0; elim x0; intro y0; elim y0; intros q r d; + unfold Zdiv_rest_aux in |- *; elim q; + [ omega + | destruct p0; + [ rewrite BinInt.Zpos_xI; intro; elim H; intros; split; + [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l; + rewrite Zmult_1_l; rewrite Zmult_assoc; + rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal + | omega ] + | rewrite BinInt.Zpos_xO; intro; elim H; intros; split; + [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2); + apply refl_equal + | omega ] + | omega ] + | destruct p0; + [ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros; + split; + [ rewrite H0; rewrite Zplus_assoc; + apply f_equal with (f := fun z:Z => z + r); + do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc; + rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc; + apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); + omega + | omega ] + | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros; + split; + [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2); + apply refl_equal + | omega ] + | omega ] ] + | omega ]. Qed. -Inductive Set Zdiv_rest_proofs[x:Z; p:positive] := - Zdiv_rest_proof : (q:Z)(r:Z) - `x = q * (two_power_pos p) + r` - -> `0 <= r` - -> `r < (two_power_pos p)` - -> (Zdiv_rest_proofs x p). - -Lemma Zdiv_rest_correct : - (x:Z)(p:positive)(Zdiv_rest_proofs x p). -Intros x p. -Generalize (Zdiv_rest_correct1 x p); Generalize (Zdiv_rest_correct2 x p). -Elim (iter_pos p (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`)). -Induction a. -Intros. -Elim H; Intros H1 H2; Clear H. -Rewrite -> H0 in H1; Rewrite -> H0 in H2; -Elim H2; Intros; -Apply Zdiv_rest_proof with q:=a0 r:=b; Assumption. +Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set := + Zdiv_rest_proof : + forall q r:Z, + x = q * two_power_pos p + r -> + 0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p. + +Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p. +intros x p. +generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p). +elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)). +simple induction a. +intros. +elim H; intros H1 H2; clear H. +rewrite H0 in H1; rewrite H0 in H2; elim H2; intros; + apply Zdiv_rest_proof with (q := a0) (r := b); assumption. Qed. -End power_div_with_rest. +End power_div_with_rest.
\ No newline at end of file diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v index b8040335e..f56005080 100644 --- a/theories/ZArith/Zsqrt.v +++ b/theories/ZArith/Zsqrt.v @@ -8,10 +8,9 @@ (* $Id$ *) -Require Omega. +Require Import Omega. Require Export ZArith_base. Require Export ZArithRing. -V7only [Import Z_scope.]. Open Local Scope Z_scope. (**********************************************************************) @@ -19,118 +18,146 @@ Open Local Scope Z_scope. (** The following tactic replaces all instances of (POS (xI ...)) by `2*(POS ...)+1` , but only when ... is not made only with xO, XI, or xH. *) -Tactic Definition compute_POS := - Match Context With - | [|- [(POS (xI ?1))]] -> - (Match ?1 With - | [[xH]] -> Fail - | _ -> Rewrite (POS_xI ?1)) - | [|- [(POS (xO ?1))]] -> - (Match ?1 With - | [[xH]] -> Fail - | _ -> Rewrite (POS_xO ?1)). +Ltac compute_POS := + match goal with + | |- context [(Zpos (xI ?X1))] => + match constr:X1 with + | context [1%positive] => fail + | _ => rewrite (BinInt.Zpos_xI X1) + end + | |- context [(Zpos (xO ?X1))] => + match constr:X1 with + | context [1%positive] => fail + | _ => rewrite (BinInt.Zpos_xO X1) + end + end. -Inductive sqrt_data [n : Z] : Set := - c_sqrt: (s, r :Z)`n=s*s+r`->`0<=r<=2*s`->(sqrt_data n) . +Inductive sqrt_data (n:Z) : Set := + c_sqrt : forall s r:Z, n = s * s + r -> 0 <= r <= 2 * s -> sqrt_data n. -Definition sqrtrempos: (p : positive) (sqrt_data (POS p)). -Refine (Fix sqrtrempos { - sqrtrempos [p : positive] : (sqrt_data (POS p)) := - <[p : ?] (sqrt_data (POS p))> Cases p of - xH => (c_sqrt `1` `1` `0` ? ?) - | (xO xH) => (c_sqrt `2` `1` `1` ? ?) - | (xI xH) => (c_sqrt `3` `1` `2` ? ?) - | (xO (xO p')) => - Cases (sqrtrempos p') of - (c_sqrt s' r' Heq Hint) => - Cases (Z_le_gt_dec `4*s'+1` `4*r'`) of - (left Hle) => - (c_sqrt (POS (xO (xO p'))) `2*s'+1` `4*r'-(4*s'+1)` ? ?) - | (right Hgt) => - (c_sqrt (POS (xO (xO p'))) `2*s'` `4*r'` ? ?) - end - end - | (xO (xI p')) => - Cases (sqrtrempos p') of - (c_sqrt s' r' Heq Hint) => - Cases - (Z_le_gt_dec `4*s'+1` `4*r'+2`) of - (left Hle) => - (c_sqrt - (POS (xO (xI p'))) `2*s'+1` `4*r'+2-(4*s'+1)` ? ?) - | (right Hgt) => - (c_sqrt (POS (xO (xI p'))) `2*s'` `4*r'+2` ? ?) - end - end - | (xI (xO p')) => - Cases (sqrtrempos p') of - (c_sqrt s' r' Heq Hint) => - Cases - (Z_le_gt_dec `4*s'+1` `4*r'+1`) of - (left Hle) => - (c_sqrt - (POS (xI (xO p'))) `2*s'+1` `4*r'+1-(4*s'+1)` ? ?) - | (right Hgt) => - (c_sqrt (POS (xI (xO p'))) `2*s'` `4*r'+1` ? ?) - end - end - | (xI (xI p')) => - Cases (sqrtrempos p') of - (c_sqrt s' r' Heq Hint) => - Cases - (Z_le_gt_dec `4*s'+1` `4*r'+3`) of - (left Hle) => - (c_sqrt - (POS (xI (xI p'))) `2*s'+1` `4*r'+3-(4*s'+1)` ? ?) - | (right Hgt) => - (c_sqrt (POS (xI (xI p'))) `2*s'` `4*r'+3` ? ?) - end - end +Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p). +refine + (fix sqrtrempos (p:positive) : sqrt_data (Zpos p) := + match p return sqrt_data (Zpos p) with + | xH => c_sqrt 1 1 0 _ _ + | xO xH => c_sqrt 2 1 1 _ _ + | xI xH => c_sqrt 3 1 2 _ _ + | xO (xO p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r') with + | left Hle => + c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1) + (4 * r' - (4 * s' + 1)) _ _ + | right Hgt => c_sqrt (Zpos (xO (xO p'))) (2 * s') (4 * r') _ _ end - }); Clear sqrtrempos; Repeat compute_POS; - Try (Try Rewrite Heq; Ring; Fail); Try Omega. + end + | xO (xI p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with + | left Hle => + c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1) + (4 * r' + 2 - (4 * s' + 1)) _ _ + | right Hgt => + c_sqrt (Zpos (xO (xI p'))) (2 * s') (4 * r' + 2) _ _ + end + end + | xI (xO p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with + | left Hle => + c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1) + (4 * r' + 1 - (4 * s' + 1)) _ _ + | right Hgt => + c_sqrt (Zpos (xI (xO p'))) (2 * s') (4 * r' + 1) _ _ + end + end + | xI (xI p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with + | left Hle => + c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1) + (4 * r' + 3 - (4 * s' + 1)) _ _ + | right Hgt => + c_sqrt (Zpos (xI (xI p'))) (2 * s') (4 * r' + 3) _ _ + end + end + end); clear sqrtrempos; repeat compute_POS; + try (try rewrite Heq; ring; fail); try omega. Defined. (** Define with integer input, but with a strong (readable) specification. *) -Definition Zsqrt : (x:Z)`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}. -Refine [x] - <[x:Z]`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}>Cases x of - (POS p) => [h]Cases (sqrtrempos p) of - (c_sqrt s r Heq Hint) => - (existS ? [s:Z]{r:Z | `(POS p)=s*s+r` /\ - `s*s<=(POS p)<(s+1)*(s+1)`} - s - (exist Z [r:Z]((POS p)=`s*s+r` /\ `s*s<=(POS p)<(s+1)*(s+1)`) - r ?)) - end - | (NEG p) => [h](False_rec - {s:Z & {r:Z | - (NEG p)=`s*s+r` /\ `s*s<=(NEG p)<(s+1)*(s+1)`}} - (h (refl_equal ? SUPERIEUR))) - | ZERO => [h](existS ? [s:Z]{r:Z | `0=s*s+r` /\ `s*s<=0<(s+1)*(s+1)`} - `0` (exist Z [r:Z](`0=0*0+r`/\`0*0<=0<(0+1)*(0+1)`) - `0` ?)) - end;Try Omega. -Split;[Omega|Rewrite Heq;Ring `(s+1)*(s+1)`;Omega]. +Definition Zsqrt : + forall x:Z, + 0 <= x -> + {s : Z & {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}}. +refine + (fun x => + match + x + return + 0 <= x -> + {s : Z & {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}} + with + | Zpos p => + fun h => + match sqrtrempos p with + | c_sqrt s r Heq Hint => + existS + (fun s:Z => + {r : Z | + Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)}) + s + (exist + (fun r:Z => + Zpos p = s * s + r /\ + s * s <= Zpos p < (s + 1) * (s + 1)) r _) + end + | Zneg p => + fun h => + False_rec + {s : Z & + {r : Z | + Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}} + (h (refl_equal Datatypes.Gt)) + | Z0 => + fun h => + existS + (fun s:Z => + {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0 + (exist + (fun r:Z => 0 = 0 * 0 + r /\ 0 * 0 <= 0 < (0 + 1) * (0 + 1)) 0 + _) + end); try omega. +split; [ omega | rewrite Heq; ring ((s + 1) * (s + 1)); omega ]. Defined. (** Define a function of type Z->Z that computes the integer square root, but only for positive numbers, and 0 for others. *) -Definition Zsqrt_plain : Z->Z := - [x]Cases x of - (POS p)=>Cases (Zsqrt (POS p) (ZERO_le_POS p)) of (existS s _) => s end - |(NEG p)=>`0` - |ZERO=>`0` - end. +Definition Zsqrt_plain (x:Z) : Z := + match x with + | Zpos p => + match Zsqrt (Zpos p) (Zorder.Zle_0_pos p) with + | existS s _ => s + end + | Zneg p => 0 + | Z0 => 0 + end. (** A basic theorem about Zsqrt_plain *) -Theorem Zsqrt_interval :(x:Z)`0<=x`-> - `(Zsqrt_plain x)*(Zsqrt_plain x)<= x < ((Zsqrt_plain x)+1)*((Zsqrt_plain x)+1)`. -Intros x;Case x. -Unfold Zsqrt_plain;Omega. -Intros p;Unfold Zsqrt_plain;Case (Zsqrt (POS p) (ZERO_le_POS p)). -Intros s (r,(Heq,Hint)) Hle;Assumption. -Intros p Hle;Elim Hle;Auto. +Theorem Zsqrt_interval : + forall n:Z, + 0 <= n -> + Zsqrt_plain n * Zsqrt_plain n <= n < + (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1). +intros x; case x. +unfold Zsqrt_plain in |- *; omega. +intros p; unfold Zsqrt_plain in |- *; + case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)). +intros s [r [Heq Hint]] Hle; assumption. +intros p Hle; elim Hle; auto. Qed. - diff --git a/theories/ZArith/Zsyntax.v b/theories/ZArith/Zsyntax.v deleted file mode 100644 index 5c226b3fc..000000000 --- a/theories/ZArith/Zsyntax.v +++ /dev/null @@ -1,278 +0,0 @@ -(***********************************************************************) -(* 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 *) -(***********************************************************************) - -(*i $Id$ i*) - -Require Export BinInt. - -V7only[ - -Grammar znatural ident := - nat_id [ prim:var($id) ] -> [$id] - -with number := - -with negnumber := - -with formula : constr := - form_expr [ expr($p) ] -> [$p] -(*| form_eq [ expr($p) "=" expr($c) ] -> [ (eq Z $p $c) ]*) -| form_eq [ expr($p) "=" expr($c) ] -> [ (Coq.Init.Logic.eq ? $p $c) ] -| form_le [ expr($p) "<=" expr($c) ] -> [ (Zle $p $c) ] -| form_lt [ expr($p) "<" expr($c) ] -> [ (Zlt $p $c) ] -| form_ge [ expr($p) ">=" expr($c) ] -> [ (Zge $p $c) ] -| form_gt [ expr($p) ">" expr($c) ] -> [ (Zgt $p $c) ] -(*| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ] - -> [ (eq Z $p $c)/\(eq Z $c $c1) ]*) -| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ] - -> [ (Coq.Init.Logic.eq ? $p $c)/\(Coq.Init.Logic.eq ? $c $c1) ] -| form_le_le [ expr($p) "<=" expr($c) "<=" expr($c1) ] - -> [ (Zle $p $c)/\(Zle $c $c1) ] -| form_le_lt [ expr($p) "<=" expr($c) "<" expr($c1) ] - -> [ (Zle $p $c)/\(Zlt $c $c1) ] -| form_lt_le [ expr($p) "<" expr($c) "<=" expr($c1) ] - -> [ (Zlt $p $c)/\(Zle $c $c1) ] -| form_lt_lt [ expr($p) "<" expr($c) "<" expr($c1) ] - -> [ (Zlt $p $c)/\(Zlt $c $c1) ] -(*| form_neq [ expr($p) "<>" expr($c) ] -> [ ~(Coq.Init.Logic.eq Z $p $c) ]*) -| form_neq [ expr($p) "<>" expr($c) ] -> [ ~(Coq.Init.Logic.eq ? $p $c) ] -| form_comp [ expr($p) "?=" expr($c) ] -> [ (Zcompare $p $c) ] - -with expr : constr := - expr_plus [ expr($p) "+" expr($c) ] -> [ (Zplus $p $c) ] -| expr_minus [ expr($p) "-" expr($c) ] -> [ (Zminus $p $c) ] -| expr2 [ expr2($e) ] -> [$e] - -with expr2 : constr := - expr_mult [ expr2($p) "*" expr2($c) ] -> [ (Zmult $p $c) ] -| expr1 [ expr1($e) ] -> [$e] - -with expr1 : constr := - expr_abs [ "|" expr($c) "|" ] -> [ (Zabs $c) ] -| expr0 [ expr0($e) ] -> [$e] - -with expr0 : constr := - expr_id [ constr:global($c) ] -> [ $c ] -| expr_com [ "[" constr:constr($c) "]" ] -> [$c] -| expr_appl [ "(" application($a) ")" ] -> [$a] -| expr_num [ number($s) ] -> [$s ] -| expr_negnum [ "-" negnumber($n) ] -> [ $n ] -| expr_inv [ "-" expr0($c) ] -> [ (Zopp $c) ] -| expr_meta [ zmeta($m) ] -> [ $m ] - -with zmeta := -| rimpl [ "?" ] -> [ ? ] -| rmeta0 [ "?" "0" ] -> [ ?0 ] -| rmeta1 [ "?" "1" ] -> [ ?1 ] -| rmeta2 [ "?" "2" ] -> [ ?2 ] -| rmeta3 [ "?" "3" ] -> [ ?3 ] -| rmeta4 [ "?" "4" ] -> [ ?4 ] -| rmeta5 [ "?" "5" ] -> [ ?5 ] - -with application : constr := - apply [ application($p) expr($c1) ] -> [ ($p $c1) ] -| apply_inject_nat [ "inject_nat" constr:constr($c1) ] -> [ (inject_nat $c1) ] -| pair [ expr($p) "," expr($c) ] -> [ ($p, $c) ] -| appl0 [ expr($a) ] -> [$a] -. - -Grammar constr constr0 := - z_in_com [ "`" znatural:formula($c) "`" ] -> [$c]. - -Grammar constr pattern := - z_in_pattern [ "`" prim:bigint($c) "`" ] -> [ 'Z: $c ' ]. - -(* The symbols "`" "`" must be printed just once at the top of the expressions, - to avoid printings like |``x` + `y`` < `45`| - for |x + y < 45|. - So when a Z-expression is to be printed, its sub-expresssions are - enclosed into an ast (ZEXPR \$subexpr), which is printed like \$subexpr - but without symbols "`" "`" around. - - There is just one problem: NEG and Zopp have the same printing rules. - If Zopp is opaque, we may not be able to solve a goal like - ` -5 = -5 ` by reflexivity. (In fact, this precise Goal is solved - by the Reflexivity tactic, but more complex problems may arise - - SOLUTION : Print (Zopp 5) for constants and -x for variables *) - -Syntax constr - level 0: - Zle [ (Zle $n1 $n2) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2) "`"]] - | Zlt [ (Zlt $n1 $n2) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2) "`" ]] - | Zge [ (Zge $n1 $n2) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] ">= " (ZEXPR $n2) "`" ]] - | Zgt [ (Zgt $n1 $n2) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "> " (ZEXPR $n2) "`" ]] - | Zcompare [<<(Zcompare $n1 $n2)>>] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "?= " (ZEXPR $n2) "`" ]] - | Zeq [ (eq Z $n1 $n2) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "= " (ZEXPR $n2)"`"]] - | Zneq [ ~(eq Z $n1 $n2) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "<> " (ZEXPR $n2) "`"]] - | Zle_Zle [ (Zle $n1 $n2)/\(Zle $n2 $n3) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2) - [1 0] "<= " (ZEXPR $n3) "`"]] - | Zle_Zlt [ (Zle $n1 $n2)/\(Zlt $n2 $n3) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2) - [1 0] "< " (ZEXPR $n3) "`"]] - | Zlt_Zle [ (Zlt $n1 $n2)/\(Zle $n2 $n3) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2) - [1 0] "<= " (ZEXPR $n3) "`"]] - | Zlt_Zlt [ (Zlt $n1 $n2)/\(Zlt $n2 $n3) ] -> - [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2) - [1 0] "< " (ZEXPR $n3) "`"]] - | ZZero_v7 [ ZERO ] -> [ "`0`" ] - | ZPos_v7 [ (POS $r) ] -> [$r:"positive_printer":9] - | ZNeg_v7 [ (NEG $r) ] -> [$r:"negative_printer":9] - ; - - level 7: - Zplus [ (Zplus $n1 $n2) ] - -> [ [<hov 0> "`" (ZEXPR $n1):E "+" [0 0] (ZEXPR $n2):L "`"] ] - | Zminus [ (Zminus $n1 $n2) ] - -> [ [<hov 0> "`" (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L "`"] ] - ; - - level 6: - Zmult [ (Zmult $n1 $n2) ] - -> [ [<hov 0> "`" (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L "`"] ] - ; - - level 8: - Zopp [ (Zopp $n1) ] -> [ [<hov 0> "`" "-" (ZEXPR $n1):E "`"] ] - | Zopp_POS [ (Zopp (POS $r)) ] -> - [ [<hov 0> "`(" "Zopp" [1 0] $r:"positive_printer_inside" ")`"] ] - | Zopp_ZERO [ (Zopp ZERO) ] -> [ [<hov 0> "`(" "Zopp" [1 0] "0" ")`"] ] - | Zopp_NEG [ (Zopp (NEG $r)) ] -> - [ [<hov 0> "`(" "Zopp" [1 0] "(" $r:"negative_printer_inside" "))`"] ] - ; - - level 4: - Zabs [ (Zabs $n1) ] -> [ [<hov 0> "`|" (ZEXPR $n1):E "|`"] ] - ; - - level 0: - escape_inside [ << (ZEXPR $r) >> ] -> [ "[" $r:E "]" ] - ; - - level 4: - Zappl_inside [ << (ZEXPR (APPLIST $h ($LIST $t))) >> ] - -> [ [<hov 0> "("(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E ")"] ] - | Zappl_inject_nat [ << (ZEXPR (APPLIST <<inject_nat>> $n)) >> ] - -> [ [<hov 0> "(inject_nat" [1 1] $n:L ")"] ] - | Zappl_inside_tail [ << (ZAPPLINSIDETAIL $h ($LIST $t)) >> ] - -> [(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E] - | Zappl_inside_one [ << (ZAPPLINSIDETAIL $e) >> ] ->[(ZEXPR $e):E] - | pair_inside [ << (ZEXPR <<(pair $s1 $s2 $z1 $z2)>>) >> ] - -> [ [<hov 0> "("(ZEXPR $z1):E "," [1 0] (ZEXPR $z2):E ")"] ] - ; - - level 3: - var_inside [ << (ZEXPR ($VAR $i)) >> ] -> [$i] - | secvar_inside [ << (ZEXPR (SECVAR $i)) >> ] -> [(SECVAR $i)] - | const_inside [ << (ZEXPR (CONST $c)) >> ] -> [(CONST $c)] - | mutind_inside [ << (ZEXPR (MUTIND $i $n)) >> ] - -> [(MUTIND $i $n)] - | mutconstruct_inside [ << (ZEXPR (MUTCONSTRUCT $c1 $c2 $c3)) >> ] - -> [ (MUTCONSTRUCT $c1 $c2 $c3) ] - - | O_inside [ << (ZEXPR << O >>) >> ] -> [ "O" ] (* To shunt Arith printer *) - - (* Added by JCF, 9/3/98; updated HH, 11/9/01 *) - | implicit_head_inside [ << (ZEXPR (APPLISTEXPL ($LIST $c))) >> ] - -> [ (APPLIST ($LIST $c)) ] - | implicit_arg_inside [ << (ZEXPR (EXPL "!" $n $c)) >> ] -> [ ] - - ; - - level 7: - Zplus_inside - [ << (ZEXPR <<(Zplus $n1 $n2)>>) >> ] - -> [ (ZEXPR $n1):E "+" [0 0] (ZEXPR $n2):L ] - | Zminus_inside - [ << (ZEXPR <<(Zminus $n1 $n2)>>) >> ] - -> [ (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L ] - ; - - level 6: - Zmult_inside - [ << (ZEXPR <<(Zmult $n1 $n2)>>) >> ] - -> [ (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L ] - ; - - level 5: - Zopp_inside [ << (ZEXPR <<(Zopp $n1)>>) >> ] -> [ "(-" (ZEXPR $n1):E ")" ] - ; - - level 10: - Zopp_POS_inside [ << (ZEXPR <<(Zopp (POS $r))>>) >> ] -> - [ [<hov 0> "Zopp" [1 0] $r:"positive_printer_inside" ] ] - | Zopp_ZERO_inside [ << (ZEXPR <<(Zopp ZERO)>>) >> ] -> - [ [<hov 0> "Zopp" [1 0] "0"] ] - | Zopp_NEG_inside [ << (ZEXPR <<(Zopp (NEG $r))>>) >> ] -> - [ [<hov 0> "Zopp" [1 0] $r:"negative_printer_inside" ] ] - ; - - level 4: - Zabs_inside [ << (ZEXPR <<(Zabs $n1)>>) >> ] -> [ "|" (ZEXPR $n1) "|"] - ; - - level 0: - ZZero_inside [ << (ZEXPR <<ZERO>>) >> ] -> ["0"] - | ZPos_inside [ << (ZEXPR <<(POS $p)>>) >>] -> - [$p:"positive_printer_inside":9] - | ZNeg_inside [ << (ZEXPR <<(NEG $p)>>) >>] -> - [$p:"negative_printer_inside":9] -. -]. - -V7only[ -(* For parsing/printing based on scopes *) -Module Z_scope. - -Infix LEFTA 4 "+" Zplus : Z_scope. -Infix LEFTA 4 "-" Zminus : Z_scope. -Infix LEFTA 3 "*" Zmult : Z_scope. -Notation "- x" := (Zopp x) (at level 0): Z_scope V8only. -Infix NONA 5 "<=" Zle : Z_scope. -Infix NONA 5 "<" Zlt : Z_scope. -Infix NONA 5 ">=" Zge : Z_scope. -Infix NONA 5 ">" Zgt : Z_scope. -Infix NONA 5 "?=" Zcompare : Z_scope. -Notation "x <= y <= z" := (Zle x y)/\(Zle y z) - (at level 5, y at level 4):Z_scope - V8only (at level 70, y at next level). -Notation "x <= y < z" := (Zle x y)/\(Zlt y z) - (at level 5, y at level 4):Z_scope - V8only (at level 70, y at next level). -Notation "x < y < z" := (Zlt x y)/\(Zlt y z) - (at level 5, y at level 4):Z_scope - V8only (at level 70, y at next level). -Notation "x < y <= z" := (Zlt x y)/\(Zle y z) - (at level 5, y at level 4):Z_scope - V8only (at level 70, y at next level). -Notation "x = y = z" := x=y/\y=z : Z_scope - V8only (at level 70, y at next level). - -(* Now a polymorphic notation -Notation "x <> y" := ~(eq Z x y) (at level 5, no associativity) : Z_scope. -*) - -(* Notation "| x |" (Zabs x) : Z_scope.(* "|" conflicts with THENS *)*) - -(* Overwrite the printing of "`x = y`" *) -Syntax constr level 0: - Zeq [ (eq Z $n1 $n2) ] -> [[<hov 0> $n1 [1 0] "= " $n2 ]]. - -Open Scope Z_scope. - -End Z_scope. -]. diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v index 5468f82cc..7f91b0f6f 100644 --- a/theories/ZArith/Zwf.v +++ b/theories/ZArith/Zwf.v @@ -8,10 +8,9 @@ (* $Id$ *) -Require ZArith_base. +Require Import ZArith_base. Require Export Wf_nat. -Require Omega. -V7only [Import Z_scope.]. +Require Import Omega. Open Local Scope Z_scope. (** Well-founded relations on Z. *) @@ -21,7 +20,7 @@ Open Local Scope Z_scope. [x (Zwf c) y] iff [x < y & c <= y] *) -Definition Zwf := [c:Z][x,y:Z] `c <= y` /\ `x < y`. +Definition Zwf (c x y:Z) := c <= y /\ x < y. (** and we prove that [(Zwf c)] is well founded *) @@ -32,34 +31,34 @@ Variable c : Z. (** The proof of well-foundness is classic: we do the proof by induction on a measure in nat, which is here [|x-c|] *) -Local f := [z:Z](absolu (Zminus z c)). +Let f (z:Z) := Zabs_nat (z - c). -Lemma Zwf_well_founded : (well_founded Z (Zwf c)). -Red; Intros. -Assert (n:nat)(a:Z)(lt (f a) n)\/(`a<c`) -> (Acc Z (Zwf c) a). -Clear a; Induction n; Intros. +Lemma Zwf_well_founded : well_founded (Zwf c). +red in |- *; intros. +assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a). +clear a; simple induction n; intros. (** n= 0 *) -Case H; Intros. -Case (lt_n_O (f a)); Auto. -Apply Acc_intro; Unfold Zwf; Intros. -Assert False;Omega Orelse Contradiction. +case H; intros. +case (lt_n_O (f a)); auto. +apply Acc_intro; unfold Zwf in |- *; intros. +assert False; omega || contradiction. (** inductive case *) -Case H0; Clear H0; Intro; Auto. -Apply Acc_intro; Intros. -Apply H. -Unfold Zwf in H1. -Case (Zle_or_lt c y); Intro; Auto with zarith. -Left. -Red in H0. -Apply lt_le_trans with (f a); Auto with arith. -Unfold f. -Apply absolu_lt; Omega. -Apply (H (S (f a))); Auto. -Save. +case H0; clear H0; intro; auto. +apply Acc_intro; intros. +apply H. +unfold Zwf in H1. +case (Zle_or_lt c y); intro; auto with zarith. +left. +red in H0. +apply lt_le_trans with (f a); auto with arith. +unfold f in |- *. +apply Zabs.Zabs_nat_lt; omega. +apply (H (S (f a))); auto. +Qed. End wf_proof. -Hints Resolve Zwf_well_founded : datatypes v62. +Hint Resolve Zwf_well_founded: datatypes v62. (** We also define the other family of relations: @@ -67,7 +66,7 @@ Hints Resolve Zwf_well_founded : datatypes v62. [x (Zwf_up c) y] iff [y < x <= c] *) -Definition Zwf_up := [c:Z][x,y:Z] `y < x <= c`. +Definition Zwf_up (c x y:Z) := y < x <= c. (** and we prove that [(Zwf_up c)] is well founded *) @@ -78,19 +77,20 @@ Variable c : Z. (** The proof of well-foundness is classic: we do the proof by induction on a measure in nat, which is here [|c-x|] *) -Local f := [z:Z](absolu (Zminus c z)). +Let f (z:Z) := Zabs_nat (c - z). -Lemma Zwf_up_well_founded : (well_founded Z (Zwf_up c)). +Lemma Zwf_up_well_founded : well_founded (Zwf_up c). Proof. -Apply well_founded_lt_compat with f:=f. -Unfold Zwf_up f. -Intros. -Apply absolu_lt. -Unfold Zminus. Split. -Apply Zle_left; Intuition. -Apply Zlt_reg_l; Unfold Zlt; Rewrite <- Zcompare_Zopp; Intuition. -Save. +apply well_founded_lt_compat with (f := f). +unfold Zwf_up, f in |- *. +intros. +apply Zabs.Zabs_nat_lt. +unfold Zminus in |- *. split. +apply Zle_left; intuition. +apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp; + intuition. +Qed. End wf_proof_up. -Hints Resolve Zwf_up_well_founded : datatypes v62. +Hint Resolve Zwf_up_well_founded: datatypes v62.
\ No newline at end of file diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v index 3f713c5ed..50c22b1b4 100644 --- a/theories/ZArith/auxiliary.v +++ b/theories/ZArith/auxiliary.v @@ -11,10 +11,10 @@ (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) Require Export Arith. -Require BinInt. -Require Zorder. -Require Decidable. -Require Peano_dec. +Require Import BinInt. +Require Import Zorder. +Require Import Decidable. +Require Import Peano_dec. Require Export Compare_dec. Open Local Scope Z_scope. @@ -22,198 +22,129 @@ Open Local Scope Z_scope. (**********************************************************************) (** Moving terms from one side to the other of an inequality *) -Theorem Zne_left : (x,y:Z) (Zne x y) -> (Zne (Zplus x (Zopp y)) ZERO). +Theorem Zne_left : forall n m:Z, Zne n m -> Zne (n + - m) 0. Proof. -Intros x y; Unfold Zne; Unfold not; Intros H1 H2; Apply H1; -Apply Zsimpl_plus_l with (Zopp y); Rewrite Zplus_inverse_l; Rewrite Zplus_sym; -Trivial with arith. +intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1; + apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; + rewrite Zplus_comm; trivial with arith. Qed. -Theorem Zegal_left : (x,y:Z) (x=y) -> (Zplus x (Zopp y)) = ZERO. +Theorem Zegal_left : forall n m:Z, n = m -> n + - m = 0. Proof. -Intros x y H; -Apply (Zsimpl_plus_l y);Rewrite -> Zplus_permute; -Rewrite -> Zplus_inverse_r;Do 2 Rewrite -> Zero_right;Assumption. +intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute; + rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption. Qed. -Theorem Zle_left : (x,y:Z) (Zle x y) -> (Zle ZERO (Zplus y (Zopp x))). +Theorem Zle_left : forall n m:Z, n <= m -> 0 <= m + - n. Proof. -Intros x y H; Replace ZERO with (Zplus x (Zopp x)). -Apply Zle_reg_r; Trivial. -Apply Zplus_inverse_r. +intros x y H; replace 0 with (x + - x). +apply Zplus_le_compat_r; trivial. +apply Zplus_opp_r. Qed. -Theorem Zle_left_rev : (x,y:Z) (Zle ZERO (Zplus y (Zopp x))) - -> (Zle x y). +Theorem Zle_left_rev : forall n m:Z, 0 <= m + - n -> n <= m. Proof. -Intros x y H; Apply Zsimpl_le_plus_r with (Zopp x). -Rewrite Zplus_inverse_r; Trivial. +intros x y H; apply Zplus_le_reg_r with (- x). +rewrite Zplus_opp_r; trivial. Qed. -Theorem Zlt_left_rev : (x,y:Z) (Zlt ZERO (Zplus y (Zopp x))) - -> (Zlt x y). +Theorem Zlt_left_rev : forall n m:Z, 0 < m + - n -> n < m. Proof. -Intros x y H; Apply Zsimpl_lt_plus_r with (Zopp x). -Rewrite Zplus_inverse_r; Trivial. +intros x y H; apply Zplus_lt_reg_r with (- x). +rewrite Zplus_opp_r; trivial. Qed. -Theorem Zlt_left : - (x,y:Z) (Zlt x y) -> (Zle ZERO (Zplus (Zplus y (NEG xH)) (Zopp x))). +Theorem Zlt_left : forall n m:Z, n < m -> 0 <= m + -1 + - n. Proof. -Intros x y H; Apply Zle_left; Apply Zle_S_n; -Change (Zle (Zs x) (Zs (Zpred y))); Rewrite <- Zs_pred; Apply Zlt_le_S; -Assumption. +intros x y H; apply Zle_left; apply Zsucc_le_reg; + change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred; + apply Zlt_le_succ; assumption. Qed. -Theorem Zlt_left_lt : - (x,y:Z) (Zlt x y) -> (Zlt ZERO (Zplus y (Zopp x))). +Theorem Zlt_left_lt : forall n m:Z, n < m -> 0 < m + - n. Proof. -Intros x y H; Replace ZERO with (Zplus x (Zopp x)). -Apply Zlt_reg_r; Trivial. -Apply Zplus_inverse_r. +intros x y H; replace 0 with (x + - x). +apply Zplus_lt_compat_r; trivial. +apply Zplus_opp_r. Qed. -Theorem Zge_left : (x,y:Z) (Zge x y) -> (Zle ZERO (Zplus x (Zopp y))). +Theorem Zge_left : forall n m:Z, n >= m -> 0 <= n + - m. Proof. -Intros x y H; Apply Zle_left; Apply Zge_le; Assumption. +intros x y H; apply Zle_left; apply Zge_le; assumption. Qed. -Theorem Zgt_left : - (x,y:Z) (Zgt x y) -> (Zle ZERO (Zplus (Zplus x (NEG xH)) (Zopp y))). +Theorem Zgt_left : forall n m:Z, n > m -> 0 <= n + -1 + - m. Proof. -Intros x y H; Apply Zlt_left; Apply Zgt_lt; Assumption. +intros x y H; apply Zlt_left; apply Zgt_lt; assumption. Qed. -Theorem Zgt_left_gt : - (x,y:Z) (Zgt x y) -> (Zgt (Zplus x (Zopp y)) ZERO). +Theorem Zgt_left_gt : forall n m:Z, n > m -> n + - m > 0. Proof. -Intros x y H; Replace ZERO with (Zplus y (Zopp y)). -Apply Zgt_reg_r; Trivial. -Apply Zplus_inverse_r. +intros x y H; replace 0 with (y + - y). +apply Zplus_gt_compat_r; trivial. +apply Zplus_opp_r. Qed. -Theorem Zgt_left_rev : (x,y:Z) (Zgt (Zplus x (Zopp y)) ZERO) - -> (Zgt x y). +Theorem Zgt_left_rev : forall n m:Z, n + - m > 0 -> n > m. Proof. -Intros x y H; Apply Zsimpl_gt_plus_r with (Zopp y). -Rewrite Zplus_inverse_r; Trivial. +intros x y H; apply Zplus_gt_reg_r with (- y). +rewrite Zplus_opp_r; trivial. Qed. (**********************************************************************) (** Factorization lemmas *) -Theorem Zred_factor0 : (x:Z) x = (Zmult x (POS xH)). -Intro x; Rewrite (Zmult_n_1 x); Reflexivity. +Theorem Zred_factor0 : forall n:Z, n = n * 1. +intro x; rewrite (Zmult_1_r x); reflexivity. Qed. -Theorem Zred_factor1 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))). +Theorem Zred_factor1 : forall n:Z, n + n = n * 2. Proof. -Exact Zplus_Zmult_2. -Qed. - -Theorem Zred_factor2 : - (x,y:Z) (Zplus x (Zmult x y)) = (Zmult x (Zplus (POS xH) y)). - -Intros x y; Pattern 1 x ; Rewrite <- (Zmult_n_1 x); -Rewrite <- Zmult_plus_distr_r; Trivial with arith. -Qed. - -Theorem Zred_factor3 : - (x,y:Z) (Zplus (Zmult x y) x) = (Zmult x (Zplus (POS xH) y)). - -Intros x y; Pattern 2 x ; Rewrite <- (Zmult_n_1 x); -Rewrite <- Zmult_plus_distr_r; Rewrite Zplus_sym; Trivial with arith. -Qed. -Theorem Zred_factor4 : - (x,y,z:Z) (Zplus (Zmult x y) (Zmult x z)) = (Zmult x (Zplus y z)). -Intros x y z; Symmetry; Apply Zmult_plus_distr_r. -Qed. - -Theorem Zred_factor5 : (x,y:Z) (Zplus (Zmult x ZERO) y) = y. - -Intros x y; Rewrite <- Zmult_n_O;Auto with arith. -Qed. - -Theorem Zred_factor6 : (x:Z) x = (Zplus x ZERO). - -Intro; Rewrite Zero_right; Trivial with arith. -Qed. - -Theorem Zle_mult_approx: - (x,y,z:Z) (Zgt x ZERO) -> (Zgt z ZERO) -> (Zle ZERO y) -> - (Zle ZERO (Zplus (Zmult y x) z)). - -Intros x y z H1 H2 H3; Apply Zle_trans with m:=(Zmult y x) ; [ - Apply Zle_mult; Assumption -| Pattern 1 (Zmult y x) ; Rewrite <- Zero_right; Apply Zle_reg_l; - Apply Zlt_le_weak; Apply Zgt_lt; Assumption]. -Qed. - -Theorem Zmult_le_approx: - (x,y,z:Z) (Zgt x ZERO) -> (Zgt x z) -> - (Zle ZERO (Zplus (Zmult y x) z)) -> (Zle ZERO y). - -Intros x y z H1 H2 H3; Apply Zlt_n_Sm_le; Apply Zmult_lt with x; [ - Assumption - | Apply Zle_lt_trans with 1:=H3 ; Rewrite <- Zmult_Sm_n; - Apply Zlt_reg_l; Apply Zgt_lt; Assumption]. - -Qed. - -V7only [ -(* Compatibility *) -Require Znat. -Require Zcompare. -Notation neq := neq. -Notation Zne := Zne. -Notation OMEGA2 := Zle_0_plus. -Notation add_un_Zs := add_un_Zs. -Notation inj_S := inj_S. -Notation Zplus_S_n := Zplus_S_n. -Notation inj_plus := inj_plus. -Notation inj_mult := inj_mult. -Notation inj_neq := inj_neq. -Notation inj_le := inj_le. -Notation inj_lt := inj_lt. -Notation inj_gt := inj_gt. -Notation inj_ge := inj_ge. -Notation inj_eq := inj_eq. -Notation intro_Z := intro_Z. -Notation inj_minus1 := inj_minus1. -Notation inj_minus2 := inj_minus2. -Notation dec_eq := dec_eq. -Notation dec_Zne := dec_Zne. -Notation dec_Zle := dec_Zle. -Notation dec_Zgt := dec_Zgt. -Notation dec_Zge := dec_Zge. -Notation dec_Zlt := dec_Zlt. -Notation dec_eq_nat := dec_eq_nat. -Notation not_Zge := not_Zge. -Notation not_Zlt := not_Zlt. -Notation not_Zle := not_Zle. -Notation not_Zgt := not_Zgt. -Notation not_Zeq := not_Zeq. -Notation Zopp_one := Zopp_one. -Notation Zopp_Zmult_r := Zopp_Zmult_r. -Notation Zmult_Zopp_left := Zmult_Zopp_left. -Notation Zopp_Zmult_l := Zopp_Zmult_l. -Notation Zcompare_Zplus_compatible2 := Zcompare_Zplus_compatible2. -Notation Zcompare_Zmult_compatible := Zcompare_Zmult_compatible. -Notation Zmult_eq := Zmult_eq. -Notation Z_eq_mult := Z_eq_mult. -Notation Zmult_le := Zmult_le. -Notation Zle_ZERO_mult := Zle_ZERO_mult. -Notation Zgt_ZERO_mult := Zgt_ZERO_mult. -Notation Zle_mult := Zle_mult. -Notation Zmult_lt := Zmult_lt. -Notation Zmult_gt := Zmult_gt. -Notation Zle_Zmult_pos_right := Zle_Zmult_pos_right. -Notation Zle_Zmult_pos_left := Zle_Zmult_pos_left. -Notation Zge_Zmult_pos_right := Zge_Zmult_pos_right. -Notation Zge_Zmult_pos_left := Zge_Zmult_pos_left. -Notation Zge_Zmult_pos_compat := Zge_Zmult_pos_compat. -Notation Zle_mult_simpl := Zle_mult_simpl. -Notation Zge_mult_simpl := Zge_mult_simpl. -Notation Zgt_mult_simpl := Zgt_mult_simpl. -Notation Zgt_square_simpl := Zgt_square_simpl. -]. +exact Zplus_diag_eq_mult_2. +Qed. + +Theorem Zred_factor2 : forall n m:Z, n + n * m = n * (1 + m). + +intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x); + rewrite <- Zmult_plus_distr_r; trivial with arith. +Qed. + +Theorem Zred_factor3 : forall n m:Z, n * m + n = n * (1 + m). + +intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x); + rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm; + trivial with arith. +Qed. +Theorem Zred_factor4 : forall n m p:Z, n * m + n * p = n * (m + p). +intros x y z; symmetry in |- *; apply Zmult_plus_distr_r. +Qed. + +Theorem Zred_factor5 : forall n m:Z, n * 0 + m = m. + +intros x y; rewrite <- Zmult_0_r_reverse; auto with arith. +Qed. + +Theorem Zred_factor6 : forall n:Z, n = n + 0. + +intro; rewrite Zplus_0_r; trivial with arith. +Qed. + +Theorem Zle_mult_approx : + forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p. + +intros x y z H1 H2 H3; apply Zle_trans with (m := y * x); + [ apply Zmult_gt_0_le_0_compat; assumption + | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r; + apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; + assumption ]. +Qed. + +Theorem Zmult_le_approx : + forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m. + +intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x; + [ assumption + | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse; + apply Zplus_lt_compat_l; apply Zgt_lt; assumption ]. + +Qed. diff --git a/theories/ZArith/fast_integer.v b/theories/ZArith/fast_integer.v deleted file mode 100644 index 81b69037f..000000000 --- a/theories/ZArith/fast_integer.v +++ /dev/null @@ -1,191 +0,0 @@ -(***********************************************************************) -(* 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 *) -(***********************************************************************) - -(*i $Id$ i*) - -(***********************************************************) -(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) -(***********************************************************) - -Require BinPos. -Require BinNat. -Require BinInt. -Require Zcompare. -Require Mult. - -V7only [ -(* Defs and ppties on positive, entier and Z, previously in fast_integer *) -(* For v7 compatibility *) -Notation positive := positive. -Notation xO := xO. -Notation xI := xI. -Notation xH := xH. -Notation add_un := add_un. -Notation add := add. -Notation convert := convert. -Notation convert_add_un := convert_add_un. -Notation cvt_carry := cvt_carry. -Notation convert_add := convert_add. -Notation positive_to_nat := positive_to_nat. -Notation anti_convert := anti_convert. -Notation double_moins_un := double_moins_un. -Notation sub_un := sub_un. -Notation positive_mask := positive_mask. -Notation Un_suivi_de_mask := Un_suivi_de_mask. -Notation Zero_suivi_de_mask := Zero_suivi_de_mask. -Notation double_moins_deux := double_moins_deux. -Notation sub_pos := sub_pos. -Notation true_sub := true_sub. -Notation times := times. -Notation relation := relation. -Notation SUPERIEUR := SUPERIEUR. -Notation INFERIEUR := INFERIEUR. -Notation EGAL := EGAL. -Notation Op := Op. -Notation compare := compare. -Notation compare_convert1 := compare_convert1. -Notation compare_convert_EGAL := compare_convert_EGAL. -Notation ZLSI := ZLSI. -Notation ZLIS := ZLIS. -Notation ZLII := ZLII. -Notation ZLSS := ZLSS. -Notation Dcompare := Dcompare. -Notation convert_compare_EGAL := convert_compare_EGAL. -Notation ZL0 := ZL0. -Notation ZL11 := ZL11. -Notation xI_add_un_xO := xI_add_un_xO. -Notation is_double_moins_un := is_double_moins_un. -Notation double_moins_un_add_un_xI := double_moins_un_add_un_xI. -Notation ZL1 := ZL1. -Notation add_un_not_un := add_un_not_un. -Notation sub_add_one := sub_add_one. -Notation add_sub_one := add_sub_one. -Notation add_un_inj := add_un_inj. -Notation ZL12 := ZL12. -Notation ZL12bis := ZL12bis. -Notation ZL13 := ZL13. -Notation add_sym := add_sym. -Notation ZL14 := ZL14. -Notation ZL14bis := ZL14bis. -Notation ZL15 := ZL15. -Notation add_no_neutral := add_no_neutral. -Notation add_carry_not_add_un := add_carry_not_add_un. -Notation add_carry_add := add_carry_add. -Notation simpl_add_r := simpl_add_r. -Notation simpl_add_carry_r := simpl_add_carry_r. -Notation simpl_add_l := simpl_add_l. -Notation simpl_add_carry_l := simpl_add_carry_l. -Notation add_assoc := add_assoc. -Notation add_xI_double_moins_un := add_xI_double_moins_un. -Notation add_x_x := add_x_x. -Notation ZS := ZS. -Notation US := US. -Notation USH := USH. -Notation ZSH := ZSH. -Notation sub_pos_x_x := sub_pos_x_x. -Notation ZL10 := ZL10. -Notation sub_pos_SUPERIEUR := sub_pos_SUPERIEUR. -Notation sub_add := sub_add. -Notation convert_add_carry := convert_add_carry. -Notation add_verif := add_verif. -Notation ZL2 := ZL2. -Notation ZL6 := ZL6. -Notation positive_to_nat_mult := positive_to_nat_mult. -Notation times_convert := times_convert. -Notation compare_positive_to_nat_O := compare_positive_to_nat_O. -Notation compare_convert_O := compare_convert_O. -Notation convert_xH := convert_xH. -Notation convert_xO := convert_xO. -Notation convert_xI := convert_xI. -Notation bij1 := bij1. -Notation ZL3 := ZL3. -Notation ZL4 := ZL4. -Notation ZL5 := ZL5. -Notation bij2 := bij2. -Notation bij3 := bij3. -Notation ZL7 := ZL7. -Notation ZL8 := ZL8. -Notation compare_convert_INFERIEUR := compare_convert_INFERIEUR. -Notation compare_convert_SUPERIEUR := compare_convert_SUPERIEUR. -Notation convert_compare_INFERIEUR := convert_compare_INFERIEUR. -Notation convert_compare_SUPERIEUR := convert_compare_SUPERIEUR. -Notation ZC1 := ZC1. -Notation ZC2 := ZC2. -Notation ZC3 := ZC3. -Notation ZC4 := ZC4. -Notation true_sub_convert := true_sub_convert. -Notation convert_intro := convert_intro. -Notation ZL16 := ZL16. -Notation ZL17 := ZL17. -Notation compare_true_sub_right := compare_true_sub_right. -Notation compare_true_sub_left := compare_true_sub_left. -Notation times_x_ := times_x_1. -Notation times_x_double := times_x_double. -Notation times_x_double_plus_one := times_x_double_plus_one. -Notation times_sym := times_sym. -Notation times_add_distr := times_add_distr. -Notation times_add_distr_l := times_add_distr_l. -Notation times_assoc := times_assoc. -Notation times_true_sub_distr := times_true_sub_distr. -Notation times_discr_xO_xI := times_discr_xO_xI. -Notation times_discr_xO := times_discr_xO. -Notation simpl_times_r := simpl_times_r. -Notation simpl_times_l := simpl_times_l. -Notation iterate_add := iterate_add. -Notation entier := entier. -Notation Nul := Nul. -Notation Pos := Pos. -Notation Un_suivi_de := Un_suivi_de. -Notation Zero_suivi_de := Zero_suivi_de. -Notation times1 := - [x:positive;_:positive->positive;y:positive](times x y). -Notation times1_convert := - [x,y:positive;_:positive->positive](times_convert x y). - -Notation Z := Z. -Notation POS := POS. -Notation NEG := NEG. -Notation ZERO := ZERO. -Notation Zero_left := Zero_left. -Notation Zopp_Zopp := Zopp_Zopp. -Notation Zero_right := Zero_right. -Notation Zplus_inverse_r := Zplus_inverse_r. -Notation Zopp_Zplus := Zopp_Zplus. -Notation Zplus_sym := Zplus_sym. -Notation Zplus_inverse_l := Zplus_inverse_l. -Notation Zopp_intro := Zopp_intro. -Notation Zopp_NEG := Zopp_NEG. -Notation weak_assoc := weak_assoc. -Notation Zplus_assoc := Zplus_assoc. -Notation Zplus_simpl := Zplus_simpl. -Notation Zmult_sym := Zmult_sym. -Notation Zmult_assoc := Zmult_assoc. -Notation Zmult_one := Zmult_one. -Notation lt_mult_left := lt_mult_left. (* Mult*) -Notation Zero_mult_left := Zero_mult_left. -Notation Zero_mult_right := Zero_mult_right. -Notation Zopp_Zmult := Zopp_Zmult. -Notation Zmult_Zopp_Zopp := Zmult_Zopp_Zopp. -Notation weak_Zmult_plus_distr_r := weak_Zmult_plus_distr_r. -Notation Zmult_plus_distr_r := Zmult_plus_distr_r. -Notation Zcompare_EGAL := Zcompare_EGAL. -Notation Zcompare_ANTISYM := Zcompare_ANTISYM. -Notation le_minus := le_minus. -Notation Zcompare_Zopp := Zcompare_Zopp. -Notation weaken_Zcompare_Zplus_compatible := weaken_Zcompare_Zplus_compatible. -Notation weak_Zcompare_Zplus_compatible := weak_Zcompare_Zplus_compatible. -Notation Zcompare_Zplus_compatible := Zcompare_Zplus_compatible. -Notation Zcompare_trans_SUPERIEUR := Zcompare_trans_SUPERIEUR. -Notation SUPERIEUR_POS := SUPERIEUR_POS. -Export Datatypes. -Export BinPos. -Export BinNat. -Export BinInt. -Export Zcompare. -Export Mult. -]. diff --git a/theories/ZArith/zarith_aux.v b/theories/ZArith/zarith_aux.v deleted file mode 100644 index 61a712b92..000000000 --- a/theories/ZArith/zarith_aux.v +++ /dev/null @@ -1,151 +0,0 @@ -(***********************************************************************) -(* 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 *) -(***********************************************************************) -(*i $Id$ i*) - -Require Export BinInt. -Require Export Zcompare. -Require Export Zorder. -Require Export Zmin. -Require Export Zabs. - -V7only [ -Notation Zlt := Zlt. -Notation Zgt := Zgt. -Notation Zle := Zle. -Notation Zge := Zge. -Notation Zsgn := Zsgn. -Notation absolu := absolu. -Notation Zabs := Zabs. -Notation Zabs_eq := Zabs_eq. -Notation Zabs_non_eq := Zabs_non_eq. -Notation Zabs_dec := Zabs_dec. -Notation Zabs_pos := Zabs_pos. -Notation Zsgn_Zabs := Zsgn_Zabs. -Notation Zabs_Zsgn := Zabs_Zsgn. -Notation inject_nat := inject_nat. -Notation Zs := Zs. -Notation Zpred := Zpred. -Notation Zgt_Sn_n := Zgt_Sn_n. -Notation Zle_gt_trans := Zle_gt_trans. -Notation Zgt_le_trans := Zgt_le_trans. -Notation Zle_S_gt := Zle_S_gt. -Notation Zcompare_n_S := Zcompare_n_S. -Notation Zgt_n_S := Zgt_n_S. -Notation Zle_not_gt := Zle_not_gt. -Notation Zgt_antirefl := Zgt_antirefl. -Notation Zgt_not_sym := Zgt_not_sym. -Notation Zgt_not_le := Zgt_not_le. -Notation Zgt_trans := Zgt_trans. -Notation Zle_gt_S := Zle_gt_S. -Notation Zgt_pred := Zgt_pred. -Notation Zsimpl_gt_plus_l := Zsimpl_gt_plus_l. -Notation Zsimpl_gt_plus_r := Zsimpl_gt_plus_r. -Notation Zgt_reg_l := Zgt_reg_l. -Notation Zgt_reg_r := Zgt_reg_r. -Notation Zcompare_et_un := Zcompare_et_un. -Notation Zgt_S_n := Zgt_S_n. -Notation Zle_S_n := Zle_S_n. -Notation Zgt_le_S := Zgt_le_S. -Notation Zgt_S_le := Zgt_S_le. -Notation Zgt_S := Zgt_S. -Notation Zgt_trans_S := Zgt_trans_S. -Notation Zeq_S := Zeq_S. -Notation Zpred_Sn := Zpred_Sn. -Notation Zeq_add_S := Zeq_add_S. -Notation Znot_eq_S := Znot_eq_S. -Notation Zsimpl_plus_l := Zsimpl_plus_l. -Notation Zn_Sn := Zn_Sn. -Notation Zplus_n_O := Zplus_n_O. -Notation Zplus_unit_left := Zplus_unit_left. -Notation Zplus_unit_right := Zplus_unit_right. -Notation Zplus_n_Sm := Zplus_n_Sm. -Notation Zmult_n_O := Zmult_n_O. -Notation Zmult_n_Sm := Zmult_n_Sm. -Notation Zle_n := Zle_n. -Notation Zle_refl := Zle_refl. -Notation Zle_trans := Zle_trans. -Notation Zle_n_Sn := Zle_n_Sn. -Notation Zle_n_S := Zle_n_S. -Notation Zs_pred := Zs_pred. (* BinInt *) -Notation Zle_pred_n := Zle_pred_n. -Notation Zle_trans_S := Zle_trans_S. -Notation Zle_Sn_n := Zle_Sn_n. -Notation Zle_antisym := Zle_antisym. -Notation Zgt_lt := Zgt_lt. -Notation Zlt_gt := Zlt_gt. -Notation Zge_le := Zge_le. -Notation Zle_ge := Zle_ge. -Notation Zge_trans := Zge_trans. -Notation Zlt_n_Sn := Zlt_n_Sn. -Notation Zlt_S := Zlt_S. -Notation Zlt_n_S := Zlt_n_S. -Notation Zlt_S_n := Zlt_S_n. -Notation Zlt_n_n := Zlt_n_n. -Notation Zlt_pred := Zlt_pred. -Notation Zlt_pred_n_n := Zlt_pred_n_n. -Notation Zlt_le_S := Zlt_le_S. -Notation Zlt_n_Sm_le := Zlt_n_Sm_le. -Notation Zle_lt_n_Sm := Zle_lt_n_Sm. -Notation Zlt_le_weak := Zlt_le_weak. -Notation Zlt_trans := Zlt_trans. -Notation Zlt_le_trans := Zlt_le_trans. -Notation Zle_lt_trans := Zle_lt_trans. -Notation Zle_lt_or_eq := Zle_lt_or_eq. -Notation Zle_or_lt := Zle_or_lt. -Notation Zle_not_lt := Zle_not_lt. -Notation Zlt_not_le := Zlt_not_le. -Notation Zlt_not_sym := Zlt_not_sym. -Notation Zle_le_S := Zle_le_S. -Notation Zmin := Zmin. -Notation Zmin_SS := Zmin_SS. -Notation Zle_min_l := Zle_min_l. -Notation Zle_min_r := Zle_min_r. -Notation Zmin_case := Zmin_case. -Notation Zmin_or := Zmin_or. -Notation Zmin_n_n := Zmin_n_n. -Notation Zplus_assoc_l := Zplus_assoc_l. -Notation Zplus_assoc_r := Zplus_assoc_r. -Notation Zplus_permute := Zplus_permute. -Notation Zsimpl_le_plus_l := Zsimpl_le_plus_l. -Notation Zsimpl_le_plus_r := Zsimpl_le_plus_r. -Notation Zle_reg_l := Zle_reg_l. -Notation Zle_reg_r := Zle_reg_r. -Notation Zle_plus_plus := Zle_plus_plus. -Notation Zplus_Snm_nSm := Zplus_Snm_nSm. -Notation Zsimpl_lt_plus_l := Zsimpl_lt_plus_l. -Notation Zsimpl_lt_plus_r := Zsimpl_lt_plus_r. -Notation Zlt_reg_l := Zlt_reg_l. -Notation Zlt_reg_r := Zlt_reg_r. -Notation Zlt_le_reg := Zlt_le_reg. -Notation Zle_lt_reg := Zle_lt_reg. -Notation Zminus := Zminus. -Notation Zminus_plus_simpl := Zminus_plus_simpl. -Notation Zminus_n_O := Zminus_n_O. -Notation Zminus_n_n := Zminus_n_n. -Notation Zplus_minus := Zplus_minus. -Notation Zminus_plus := Zminus_plus. -Notation Zle_plus_minus := Zle_plus_minus. -Notation Zminus_Sn_m := Zminus_Sn_m. -Notation Zlt_minus := Zlt_minus. -Notation Zlt_O_minus_lt := Zlt_O_minus_lt. -Notation Zmult_plus_distr_l := Zmult_plus_distr_l. -Notation Zmult_plus_distr := BinInt.Zmult_plus_distr_l. -Notation Zmult_minus_distr := Zmult_minus_distr. -Notation Zmult_assoc_r := Zmult_assoc_r. -Notation Zmult_assoc_l := Zmult_assoc_l. -Notation Zmult_permute := Zmult_permute. -Notation Zmult_1_n := Zmult_1_n. -Notation Zmult_n_1 := Zmult_n_1. -Notation Zmult_Sm_n := Zmult_Sm_n. -Notation Zmult_Zplus_distr := Zmult_plus_distr_r. -Export BinInt. -Export Zorder. -Export Zmin. -Export Zabs. -Export Zcompare. -]. |