diff --git a/.github/workflows/coq-ci.yml b/.github/workflows/coq-ci.yml deleted file mode 100644 index 6c79aca..0000000 --- a/.github/workflows/coq-ci.yml +++ /dev/null @@ -1,29 +0,0 @@ -name: CI - -on: - push: - branches: - - master - pull_request: - branches: - - '**' - -jobs: - build: - # the OS must be GNU/Linux to be able to use the docker-coq-action - runs-on: ubuntu-latest - strategy: - matrix: - image: - - 'mathcomp/mathcomp:1.10.0-coq-8.11' - fail-fast: false - steps: - - uses: actions/checkout@v2 - - uses: coq-community/docker-coq-action@v1 - with: - opam_file: 'coq-mathcomp-apery.opam' - custom_image: ${{ matrix.image }} - -# See also: -# https://github.com/coq-community/docker-coq-action#readme -# https://github.com/erikmd/docker-coq-github-action-demo diff --git a/.github/workflows/docker-action.yml b/.github/workflows/docker-action.yml new file mode 100644 index 0000000..1aa7f0b --- /dev/null +++ b/.github/workflows/docker-action.yml @@ -0,0 +1,44 @@ +# This file was generated from `meta.yml`, please do not edit manually. +# Follow the instructions on https://github.com/coq-community/templates to regenerate. +name: Docker CI + +on: + push: + branches: + - master + pull_request: + branches: + - '**' + +jobs: + build: + # the OS must be GNU/Linux to be able to use the docker-coq-action + runs-on: ubuntu-latest + strategy: + matrix: + image: + - 'mathcomp/mathcomp:1.12.0-coq-8.11' + - 'mathcomp/mathcomp:1.12.0-coq-8.12' + - 'mathcomp/mathcomp:1.12.0-coq-8.13' + - 'mathcomp/mathcomp:1.12.0-coq-8.14' + - 'mathcomp/mathcomp:1.13.0-coq-8.11' + - 'mathcomp/mathcomp:1.13.0-coq-8.12' + - 'mathcomp/mathcomp:1.13.0-coq-8.13' + - 'mathcomp/mathcomp:1.13.0-coq-8.14' + - 'mathcomp/mathcomp:1.13.0-coq-dev' + - 'mathcomp/mathcomp-dev:coq-8.11' + - 'mathcomp/mathcomp-dev:coq-8.12' + - 'mathcomp/mathcomp-dev:coq-8.13' + - 'mathcomp/mathcomp-dev:coq-8.14' + - 'mathcomp/mathcomp-dev:coq-dev' + fail-fast: false + steps: + - uses: actions/checkout@v2 + - uses: coq-community/docker-coq-action@v1 + with: + opam_file: 'coq-mathcomp-apery.opam' + custom_image: ${{ matrix.image }} + +# See also: +# https://github.com/coq-community/docker-coq-action#readme +# https://github.com/erikmd/docker-coq-github-action-demo diff --git a/README.md b/README.md index ec3032f..8b3914b 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,13 @@ + # Apery -[![CI][action-shield]][action-link] +[![Docker CI][docker-action-shield]][docker-action-link] -[action-shield]: https://github.com/math-comp/apery/workflows/CI/badge.svg?branch=master -[action-link]: https://github.com/math-comp/apery/actions?query=workflow%3ACI +[docker-action-shield]: https://github.com/math-comp/apery/workflows/Docker%20CI/badge.svg?branch=master +[docker-action-link]: https://github.com/math-comp/apery/actions?query=workflow:"Docker%20CI" @@ -23,13 +27,13 @@ remains the sole trusted code base. - Assia Mahboubi (initial) - Thomas Sibut-Pinote (initial) - License: [CeCILL-C](Licence_CeCILL-C_V1-en.txt) -- Compatible Coq versions: 8.11 +- Compatible Coq versions: 8.11 or later - Additional dependencies: - - [MathComp ssreflect 1.10](https://math-comp.github.io) + - [MathComp ssreflect 1.12 or later](https://math-comp.github.io) - [MathComp algebra](https://math-comp.github.io) - [MathComp field](https://math-comp.github.io) - - [CoqEAL 1.0.3 or later](https://github.com/CoqEAL/CoqEAL) - - [MathComp real closed fields 1.0.4 or later](https://github.com/math-comp/real-closed) + - [CoqEAL 1.0.5 or later](https://github.com/CoqEAL/CoqEAL) + - [MathComp real closed fields 1.1.2 or later](https://github.com/math-comp/real-closed) - [MathComp bigenough 1.0.0 or later](https://github.com/math-comp/bigenough) - Coq namespace: `mathcomp.apery` - Related publication(s): diff --git a/coq-mathcomp-apery.opam b/coq-mathcomp-apery.opam index e566dd8..49ee13a 100644 --- a/coq-mathcomp-apery.opam +++ b/coq-mathcomp-apery.opam @@ -1,3 +1,6 @@ +# This file was generated from `meta.yml`, please do not edit manually. +# Follow the instructions on https://github.com/coq-community/templates to regenerate. + opam-version: "2.0" maintainer: "assia.mahboubi@inria.fr" version: "dev" @@ -17,15 +20,15 @@ computer algebra program (in this case in Maple/Algolib). These relations are formally checked a posteriori, so that Coq's kernel remains the sole trusted code base.""" -build: [make "-j%{jobs}%" ] +build: [make "-j%{jobs}%"] install: [make "install"] depends: [ - "coq" {>= "8.11" & < "8.12~"} - "coq-mathcomp-ssreflect" {>= "1.10" & < "1.11~"} + "coq" {(>= "8.11" & < "8.15~") | (= "dev")} + "coq-mathcomp-ssreflect" {(>= "1.12" & < "1.14~") | (= "dev")} "coq-mathcomp-algebra" "coq-mathcomp-field" - "coq-coqeal" {>= "1.0.3"} - "coq-mathcomp-real-closed" {>= "1.0.4"} + "coq-coqeal" {>= "1.0.5"} + "coq-mathcomp-real-closed" {>= "1.1.2"} "coq-mathcomp-bigenough" {>= "1.0.0"} ] diff --git a/include/ops_header.v b/include/ops_header.v index 8d4facb..e04f956 100644 --- a/include/ops_header.v +++ b/include/ops_header.v @@ -1,5 +1,3 @@ -Require Import Psatz. -Require Import Field. Require Import ZArith. From mathcomp Require Import all_ssreflect all_algebra. @@ -15,7 +13,6 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. diff --git a/meta.yml b/meta.yml index 740e3fc..9c37768 100644 --- a/meta.yml +++ b/meta.yml @@ -43,19 +43,45 @@ license: file: Licence_CeCILL-C_V1-en.txt supported_coq_versions: - text: 8.11 - opam: '{>= "8.11" & < "8.12~"}' + text: 8.11 or later + opam: '{(>= "8.11" & < "8.15~") | (= "dev")}' tested_coq_opam_versions: -- version: '1.10.0-coq-8.11' +- version: '1.12.0-coq-8.11' repo: 'mathcomp/mathcomp' +- version: '1.12.0-coq-8.12' + repo: 'mathcomp/mathcomp' +- version: '1.12.0-coq-8.13' + repo: 'mathcomp/mathcomp' +- version: '1.12.0-coq-8.14' + repo: 'mathcomp/mathcomp' +- version: '1.13.0-coq-8.11' + repo: 'mathcomp/mathcomp' +- version: '1.13.0-coq-8.12' + repo: 'mathcomp/mathcomp' +- version: '1.13.0-coq-8.13' + repo: 'mathcomp/mathcomp' +- version: '1.13.0-coq-8.14' + repo: 'mathcomp/mathcomp' +- version: '1.13.0-coq-dev' + repo: 'mathcomp/mathcomp' +- version: 'coq-8.11' + repo: 'mathcomp/mathcomp-dev' +- version: 'coq-8.12' + repo: 'mathcomp/mathcomp-dev' +- version: 'coq-8.13' + repo: 'mathcomp/mathcomp-dev' +- version: 'coq-8.14' + repo: 'mathcomp/mathcomp-dev' +- version: 'coq-dev' + repo: 'mathcomp/mathcomp-dev' dependencies: - opam: name: coq-mathcomp-ssreflect - version: '{>= "1.10" & < "1.11~"}' + version: '{(>= "1.12" & < "1.14~") | (= "dev")}' description: |- - [MathComp ssreflect 1.10](https://math-comp.github.io) + [MathComp ssreflect 1.12 or later](https://math-comp.github.io) - opam: name: coq-mathcomp-algebra description: |- @@ -66,14 +92,14 @@ dependencies: [MathComp field](https://math-comp.github.io) - opam: name: coq-coqeal - version: '{>= "1.0.3"}' + version: '{>= "1.0.5"}' description: |- - [CoqEAL 1.0.3 or later](https://github.com/CoqEAL/CoqEAL) + [CoqEAL 1.0.5 or later](https://github.com/CoqEAL/CoqEAL) - opam: name: coq-mathcomp-real-closed - version: '{>= "1.0.4"}' + version: '{>= "1.1.2"}' description: |- - [MathComp real closed fields 1.0.4 or later](https://github.com/math-comp/real-closed) + [MathComp real closed fields 1.1.2 or later](https://github.com/math-comp/real-closed) - opam: name: coq-mathcomp-bigenough version: '{>= "1.0.0"}' diff --git a/theories/a_props.v b/theories/a_props.v index 4d6f1ab..390ef6e 100644 --- a/theories/a_props.v +++ b/theories/a_props.v @@ -1,22 +1,11 @@ -Require Import BinInt NArith. - -From CoqEAL Require Import hrel param refinements. -From CoqEAL Require Import pos binnat binint rational. -Import Refinements (* AlgOp *). - - +Require Import BinInt. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp Require Import realalg. - - -(* From CoqEAL Require Import hrel param refinements. *) -(* (* From CoqEAL Require Import refinements. *) *) -(* From CoqEAL Require Import pos binnat binint rational. *) -(* Import Refinements (*AlgOp*). *) - -Require Import extra_mathcomp. +From CoqEAL Require Import hrel param refinements. +From CoqEAL Require Import pos binnat binint rational. +Import Refinements (* AlgOp *). Require Import binomialz bigopz. Require Import field_tactics lia_tactics shift. @@ -33,10 +22,9 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (**** Properties the sequence a ****) @@ -48,10 +36,9 @@ Open Scope ring_scope. (* values are all integer. *) Fact Qint_a (i : int) : a i \is a Qint. Proof. -rewrite /a /c big_int_cond /=. +rewrite /a /c big_int_cond /=. apply: rpred_sum=> j; rewrite andbT => /andP [le0j lejSi]. -have le0i : 0 <= i by intlia. -by rewrite rpredM // rpredX //; apply: Qint_binomialz => //; apply: addr_ge0. +by rewrite rpredM // rpredX //; apply: Qint_binomialz; intlia. Qed. (* The values of a are strictly positive at positive indexes. *) @@ -59,38 +46,34 @@ Fact lt_0_a (k : int) : 0 <= k -> 0 < a k. Proof. move=> h0k; rewrite /a big_int_recl /=; last by intlia. rewrite -[X in X < _]addr0; apply: ltr_le_add; first exact: lt_0_c. -rewrite big_int_cond; apply: sumr_ge0 => i; rewrite andbT; case/andP=> *. -by apply: ltrW; apply: lt_0_c; apply/andP; intlia. +rewrite big_int_cond; apply: sumr_ge0 => i; rewrite andbT => /andP [] *. +by apply/ltW/lt_0_c/andP; intlia. Qed. (* The values of a are nonnegative *) Fact le_0_a (k : int) : 0 <= a k. Proof. -case: (lerP 0 k) => [le0k | ltk0]; first by apply: ltrW; exact: lt_0_a. +have [le0k | ltk0] := lerP 0 k; first exact/ltW/lt_0_a. by rewrite /a big_geqz //; intlia. Qed. Fact a_neq0 (k : int) : 0 <= k -> a k != 0. Proof. by move/lt_0_a; rewrite lt0r; case/andP. Qed. - (* a is increasing *) Fact a_incr (n m : int) : n <= m -> a n <= a m. Proof. move=> lenm. -have leSnSm : n + 1 <= m + 1 by rewrite ler_add2r. -case: (ltrP 0 (n + 1)) => [lt0Sn | leSn0]; last first. - by rewrite {1}/a big_geqz; rewrite ?le_0_a. -have le0n : 0 <= n by intlia. +have [le0n | ltn0] := lerP 0 n; last first. + by rewrite {1}/a big_geqz ?le_0_a ?lez_addr1. +have leSnSm : n + 1 <= m + 1 by intlia. rewrite /a (big_cat_int _ _ _ _ leSnSm) //=; apply: ler_paddr=> //; last first. rewrite [X in X <= _]big_int_cond [X in _ <= X]big_int_cond /=. - apply: ler_sum => i; rewrite andbT; case/andP=> hi hin; apply: c_incr => //. - intlia. -rewrite big_int_cond; apply: sumr_ge0 => i; rewrite andbT; case/andP=> hni hmi. -by apply: ltrW; apply: lt_0_c; apply/andP; split; intlia. + apply: ler_sum => i; rewrite andbT => /andP [hi hin]; apply: c_incr; intlia. +rewrite big_int_cond; apply: sumr_ge0 => i; rewrite andbT => /andP [hni hmi]. +by apply/ltW/lt_0_c/andP; intlia. Qed. - (* One of the important properties of a for the proof is the asymptotic *) (* behaviour, namely that a dominates 33 ^ n. We diverge from standard *) (* presentations by formalizing an elementary proof, based on the *) @@ -110,13 +93,13 @@ Definition rho (i : int) : rat := a (i + 1) / a i. Fact ltr_rat_of_positive (p1 p2 : positive) : (p1 < p2)%positive -> rat_of_positive p1 < rat_of_positive p2. Proof. -move=> P12; rewrite !rat_of_positiveE ltr_int; exact/ltP/Pos2Nat.inj_lt. +move=> P12; rewrite !rat_of_positiveE ltr_int; exact/ssrnat.ltP/Pos2Nat.inj_lt. Qed. Fact ler_rat_of_positive (p1 p2 : positive) : (p1 <= p2)%positive -> rat_of_positive p1 <= rat_of_positive p2. Proof. -move=> P12; rewrite !rat_of_positiveE ler_int; exact/leP/Pos2Nat.inj_le. +move=> P12; rewrite !rat_of_positiveE ler_int; exact/ssrnat.leP/Pos2Nat.inj_le. Qed. (* END TODO : FIX/MOVE *) @@ -132,9 +115,7 @@ by rewrite mul1r; apply: a_incr; rewrite ler_paddr. Qed. Fact lt_0_rho (i : int) : 0 <= i -> 0 < rho i. -Proof. -move=> lei0; rewrite /rho; apply: divr_gt0; apply: lt_0_a => //; exact: addr_ge0. -Qed. +Proof. by move=> lei0; apply/divr_gt0/lt_0_a/lei0/lt_0_a/addr_ge0. Qed. (* The monotonicity of rho is a consequence of a being solution of Apéry's *) (* recurrence. We introducte short names for its (fraction) coefficients *) @@ -154,10 +135,10 @@ Definition beta (x : rat) : rat := Fact lt_0_beta (x : rat) : 0 <= x -> 0 < beta x. Proof. -move=> le0i; rewrite /beta exprn_gt0 //; apply: divr_gt0. -rewrite -[rat_of_positive _]opprK subr_gt0; apply: ltr_le_trans le0i. - by rewrite oppr_lt0 lt_0_rat_of_positive. -apply: ltr_paddl => //; exact: lt_0_rat_of_positive. +move=> le0i; rewrite /beta exprn_gt0 //. +apply/divr_gt0/ltr_paddl/lt_0_rat_of_positive => //. +rewrite -[rat_of_positive _]opprK subr_gt0; apply: lt_le_trans le0i. +by rewrite oppr_lt0 lt_0_rat_of_positive. Qed. Fact lt_beta_1 (x : rat) : 0 <= x -> beta x < 1. @@ -167,7 +148,7 @@ have dpos : 0 < x + rat_of_positive 1. apply: ltr_paddl; rewrite ?ler0z //; exact: lt_0_rat_of_positive. have npos : 0 < x + rat_of_positive 2. apply: ltr_paddl; rewrite ?ler0z //; exact: lt_0_rat_of_positive. -rewrite expr_lte1 //; last by apply: divr_ge0; apply: ltrW. +rewrite expr_lte1 //; last by apply: divr_ge0; apply: ltW. rewrite ltr_pdivr_mulr // mul1r ltr_add2l; exact: ltr_rat_of_positive. Qed. @@ -187,17 +168,16 @@ rewrite ltr_pdivl_mulr; last by apply: exprn_gt0. have trans: rat_of_positive 2 * (x + rat_of_positive 2) ^+ 3 <= rat_of_positive 2 * (x + rat_of_positive 2) ^+ 2 * (rat_of_positive 2 * x + rat_of_positive 3). - rewrite [_ ^+ 3]exprS [_ * _ ^+ 2]mulrC mulrA ler_pmul2l; last first. + rewrite [_ ^+ 3]exprSr mulrA ler_pmul2l; last first. by rewrite pmulr_rgt0 ?exprn_gt0 // lt_0_rat_of_positive. - apply: ler_add => //; last exact: ler_rat_of_positive. - apply: ler_pemull => //. - suff -> : 1 = rat_of_positive 1 by exact: ler_rat_of_positive. - by rewrite rat_of_positiveE. -apply: ler_lt_trans trans _. + apply: ler_add (ler_pemull _ _) (ler_rat_of_positive _) => //. + suff -> : 1 = rat_of_positive 1 by apply: ler_rat_of_positive. + by rewrite rat_of_positiveE. +apply: le_lt_trans trans _. suff trans : rat_of_positive 2 * (x + rat_of_positive 2) ^+ 2 < rat_of_positive 17 * x ^ 2 + rat_of_positive 51 * x + rat_of_positive 39. - rewrite ltr_pmul2r //; apply: ltr_paddl; last exact: lt_0_rat_of_positive. + rewrite ltr_pmul2r //; apply/ltr_paddl/lt_0_rat_of_positive. rewrite pmulr_rge0 //; exact: lt_0_rat_of_positive. rewrite -exprnP sqrrD !mulrDr; apply: ler_lt_add; last first. by rewrite [_ < _]refines_eq. @@ -207,8 +187,8 @@ Qed. Fact lt_0_alpha (x : rat) : 0 <= x -> 0 < alpha x. -Proof. -move=> le0i; apply: ltr_trans (lt_2_alphaN le0i); exact: lt_0_rat_of_positive. +Proof. +by move=> le0i; apply/lt_trans/lt_2_alphaN/le0i/lt_0_rat_of_positive. Qed. (* A Maple aided proof that - alpha is increasing. *) @@ -227,16 +207,14 @@ have -> : rhs = (rat_of_positive 51 * x ^+ 4 + rewrite /rhs /alpha !exprnP. rewrite -!rat_of_Z_rat_of_positive in hx2 hx3 *. rat_field. - by split; apply/eqP; rewrite -rat_of_ZEdef lt0r_neq0. apply: divr_ge0; last first. - apply: mulr_ge0; apply: exprn_ge0; exact: ltrW. + by apply: mulr_ge0; exact/exprn_ge0/ltW. have hposM (r : rat) (p : positive) : 0 <= r -> 0 <= rat_of_positive p * r. - move=> le0x; apply: mulr_ge0 => //; apply: ltrW; exact: lt_0_rat_of_positive. + by move=> le0x; exact/mulr_ge0/le0x/ltW/lt_0_rat_of_positive. apply: addr_ge0; last by rewrite [_ <= _]refines_eq. -apply: addr_ge0; last exact: hposM. -do 2! (apply: addr_ge0; last by apply: hposM; apply: exprn_ge0). -by apply: hposM; apply: exprn_ge0. +apply/addr_ge0/hposM/le0i; do 2! (apply: addr_ge0; last exact/hposM/exprn_ge0). +exact/hposM/exprn_ge0. Qed. (* delta is the discriminant *) @@ -246,23 +224,21 @@ Fact lt_0_delta (x : rat) : 0 <= x -> 0 < delta x. Proof. move=> le0x; rewrite /delta. suff trans: 0 <= alpha x ^+ 2 - rat_of_positive 4. - apply: ler_lt_trans trans _; rewrite ltr_add2l -mulNr -[X in X < _]mulr1. + apply: le_lt_trans trans _; rewrite ltr_add2l -mulNr -[X in X < _]mulr1. by rewrite ltr_nmul2l ?lt_beta_1 // [_ <_ ]refines_eq. have -> : rat_of_positive 4 = (rat_of_positive 2) ^+ 2. by apply/eqP; rewrite [_ == _]refines_eq. -rewrite subr_sqr; apply: ltrW; apply: mulr_gt0; last first. - apply: addr_gt0; rewrite ?lt_0_alpha ?lt_0_rat_of_positive //. -rewrite subr_gt0; exact: lt_2_alphaN. +rewrite subr_sqr; apply/ltW/mulr_gt0. + rewrite subr_gt0; exact: lt_2_alphaN. +apply: addr_gt0; rewrite ?lt_0_alpha ?lt_0_rat_of_positive //. Qed. (* Maple aided proof again that delta is increasing *) Lemma delta_incr (x : rat) : 0 <= x -> delta x <= delta (x + 1). Proof. move=> le0x; rewrite -subr_ge0; set rhs := (X in 0 <= X). -have hi3 : 0 < x + rat_of_Z 3. - by apply: ltr_paddl; rewrite ?ler0z //; exact: rat_of_Z_Zpos. -have hi2 : 0 < x + rat_of_Z 2. - by apply: ltr_paddl; rewrite ?ler0z //; exact: rat_of_Z_Zpos. +have hi3 : 0 < x + rat_of_Z 3 by apply/ltr_paddl/rat_of_Z_Zpos. +have hi2 : 0 < x + rat_of_Z 2 by apply/ltr_paddl/rat_of_Z_Zpos. have -> (n := x) : rhs = ( rat_of_Z 3456 * n ^ 10 + rat_of_Z 77550 * n ^ 9 + @@ -280,14 +256,12 @@ have -> (n := x) : rhs = ( rewrite /alpha /beta -!rat_of_Z_rat_of_positive !exprnP. rat_field. by split; apply/eqP; rewrite -rat_of_ZEdef lt0r_neq0. -apply: divr_ge0; last first. - apply: mulr_ge0; apply: exprn_ge0; exact: ltrW. +apply: divr_ge0; last by apply: mulr_ge0; apply/exprn_ge0/ltW. have poslin (r : rat) (p : positive) : 0 <= r -> 0 <= rat_of_Z (Z.pos p) * r. - by move=> le0r; apply: mulr_ge0 => //; apply: ltrW; apply: rat_of_Z_Zpos. -apply: addr_ge0; last by apply: ltrW; apply: rat_of_Z_Zpos. -apply: addr_ge0; last exact: poslin. -do 8! (apply: addr_ge0; last by apply: poslin; apply: exprn_ge0). -by apply: poslin; apply: exprn_ge0. + by move=> le0r; apply/mulr_ge0/le0r/ltW/rat_of_Z_Zpos. +apply/addr_ge0/ltW/rat_of_Z_Zpos/addr_ge0/poslin/le0x. +do 8! (apply/addr_ge0; last exact/poslin/exprn_ge0). +exact/poslin/exprn_ge0. Qed. @@ -298,29 +272,27 @@ Proof. by []. Qed. (* Here the rat_field is used to prove a simple reorganisation of terms. *) (*FIXME : Why a /= after goal_to_lia? *) -Lemma rho_rec (i : int) : Posz 2 <= i -> rho (i + 1) = h i%:~R (rho i). +Lemma rho_rec (i : int) : Posz 2 <= i -> rho (i + 1) = h i%:Q (rho i). Proof. -move=> le2i. rewrite hE -[alpha i%:~R]mulr1. -have rhoi_neq0 : rho i != 0 - by apply: lt0r_neq0; apply: lt_0_rho; apply: ler_trans le2i. -have ai_neq0 : a i != 0 by apply: a_neq0; apply: ler_trans le2i. +move=> le2i. rewrite hE -[alpha i%:Q]mulr1. +have rhoi_neq0 : rho i != 0 by apply/lt0r_neq0/lt_0_rho/le_trans/le2i. +have ai_neq0 : a i != 0 by apply/a_neq0/le_trans/le2i. rewrite -[X in _ * X - _](@mulfV _ (rho i)) // mulrA -mulrBl; apply/eqP. rewrite -(can2_eq (mulfK _) (divfK _)) //. -have -> : rho (i + 1) * rho i = a (i + 2) / a i. - rewrite /rho mulrA mulfVK -?addrA //; apply: a_neq0; apply: addr_ge0=> //. - by apply: ler_trans le2i. +have -> : rho (i + 1) * rho i = a (i + 2) / a i. + by rewrite /rho mulrA mulfVK -?addrA //; apply/a_neq0; intlia. rewrite (can2_eq (divfK _) (mulfK _)) // mulrDl -mulrA mulNr. have -> : rho i * a i = a (i + 1) by rewrite /rho divfK. have c2_neq0 : annotated_recs_c.P_cf2 i != 0. rewrite /annotated_recs_c.P_cf2; apply: lt0r_neq0. rewrite exprn_gt0 //. apply: addr_gt0; last by rewrite rat_of_ZEdef. - by rewrite -[0]/(0%:~R) ltr_int; apply: ltr_le_trans le2i. -have -> : a (i + 2) = - ((annotated_recs_c.P_cf1 i) * a (i + 1) + - (annotated_recs_c.P_cf0 i) * a i) - / (annotated_recs_c.P_cf2 i). + by rewrite -[0]/(0%:Q) ltr_int; apply: lt_le_trans le2i. +have -> : a (i + 2) = - (annotated_recs_c.P_cf1 i * a (i + 1) + + annotated_recs_c.P_cf0 i * a i) + / annotated_recs_c.P_cf2 i. apply/eqP; rewrite -(can2_eq (mulfK _) (divfK _)) //. rewrite [X in X == _]mulrC -subr_eq0 opprK addrA. - have := (a_Sn2 le2i); rewrite /annotated_recs_c.P_horner. + have := a_Sn2 le2i; rewrite /annotated_recs_c.P_horner. rewrite /punk.horner_seqop /annotated_recs_c.P_seq /=. by rewrite !int.shift2Z -[_ + 1 + 1]addrA; move->. rewrite /annotated_recs_c.P_cf2 /annotated_recs_c.P_cf1 /annotated_recs_c.P_cf0. @@ -339,60 +311,58 @@ move=> le0i le0j leij. suff hsucc (k : int) : 2%:~R <= k -> rho k <= rho (k + 1). case: i le0i leij => // i le2i; case: j le0j => // j _. elim: j => [ |j ihj]; first by rewrite lez_nat leqn0; move/eqP->. - rewrite lez_nat leq_eqVlt; case/orP => [/eqP-> // | leij]. - rewrite -addn1 PoszD; apply: ler_trans (hsucc _ _); first exact: ihj. - by apply: ler_trans le2i _; rewrite lez_nat. + rewrite lez_nat leq_eqVlt => /predU1P [-> // | leij]. + rewrite -addn1 PoszD; apply/le_trans/hsucc; first exact: ihj. + by apply: le_trans le2i _; rewrite lez_nat. move=> le2k {i j le0i le0j leij}. pose Ralpha i : realalg := QtoR (alpha i). pose Rbeta i : realalg := QtoR (beta i). -have lt_0_Rbeta (i : int) : 0 <= i -> 0 < Rbeta i%:~R. +have lt_0_Rbeta (i : int) : 0 <= i -> 0 < Rbeta i%:Q. by move=> *; rewrite RealAlg.ltr_to_alg; apply: lt_0_beta; rewrite ler0z. -have lt_Rbeta_1 (i : int) : (0 <= i) -> Rbeta i%:~R < 1. +have lt_Rbeta_1 (i : int) : (0 <= i) -> Rbeta i%:Q < 1. by move=> *; rewrite RealAlg.ltr_to_alg; apply: lt_beta_1; rewrite ler0z. -have lt_Ralpha_0 (i : int) : 0 <= i -> 0 < Ralpha i%:~R. +have lt_Ralpha_0 (i : int) : 0 <= i -> 0 < Ralpha i%:Q. by move=> *; rewrite RealAlg.ltr_to_alg; apply: lt_0_alpha; rewrite ler0z. -pose hr (i : int) (x : realalg) : realalg := Ralpha i%:~R - (Rbeta i%:~R) / x. -have h2hr (j : int) (x : rat) : 0 < x -> QtoR (h j%:~R x) = hr j (QtoR x). - move/unitf_gt0 => ux. rewrite /hr rmorphB /= [QtoR _]lock; congr (_ - _). +pose hr (i : int) (x : realalg) : realalg := Ralpha i%:Q - (Rbeta i%:Q) / x. +have h2hr (j : int) (x : rat) : QtoR (h j%:Q x) = hr j (QtoR x). + rewrite /hr rmorphB /= [QtoR _]lock; congr (_ - _). - by rewrite -lock. - - by rewrite rmorphM /= [QtoR x^-1]rmorphV. -pose p (i : int) (x : realalg) := - (x * x) + Ralpha i%:~R * x - Rbeta i%:~R. + - by rewrite rmorphM /= [QtoR x^-1]fmorphV. +pose p (i : int) (x : realalg) := - (x * x) + Ralpha i%:Q * x - Rbeta i%:Q. have hr_p (i : int) (x : realalg) : x != 0 -> hr i x - x = (p i x) / x. move=> xneq0; rewrite /hr /p !mulrDl -[- (x * x)]mulNr !mulfK // addrC mulNr. by rewrite addrA. -have lt0k : 0 < k by apply: ltr_le_trans le2k. -have le0k : 0 <= k by exact: ltrW. -have rhok_pos : 0 < rho k by apply: lt_0_rho; apply: ltrW. -have aux_rmoprhV i : (0 <= i) -> rho i \is a GRing.unit. - by move=> le0i; apply: unitf_gt0; apply: lt_0_rho. +have lt0k : 0 < k by apply: lt_le_trans le2k. +have le0k : 0 <= k by apply: ltW. +have rhok_pos : 0 < rho k by apply/lt_0_rho/ltW. suff toR : 0 <= p k (QtoR (rho k)). rewrite -RealAlg.ler_to_alg -subr_ge0. - rewrite rho_rec // h2hr // hr_p; last first. + rewrite rho_rec // h2hr hr_p; last first. by apply: lt0r_neq0; rewrite RealAlg.ltr_to_alg. - apply: divr_ge0; rewrite ?toR // RealAlg.ler_to_alg; exact: ltrW. -pose deltap (i : int) := QtoR (delta i%:~R). + apply: divr_ge0; rewrite ?toR // RealAlg.ler_to_alg; exact: ltW. +pose deltap (i : int) := QtoR (delta i%:Q). have deltapE (i : int) : - deltap i = (Ralpha i%:~R) ^+ 2 - QtoR (rat_of_positive 4) * (Rbeta i%:~R). + deltap i = (Ralpha i%:Q) ^+ 2 - QtoR (rat_of_positive 4) * (Rbeta i%:Q). rewrite /deltap /delta rmorphD rmorphN rmorphX /=. - by rewrite [QtoR (_ * beta i%:~R)]rmorphM. + by rewrite [QtoR (_ * beta i%:Q)]rmorphM. have deltap_pos (i : int) : 0 <= i -> 0 < deltap i. move=> ?; rewrite /deltap RealAlg.ltr_to_alg; apply: lt_0_delta. by rewrite ler0z. pose xp (i : int) : realalg := - ((Ralpha i%:~R) + Num.sqrt (deltap i)) / QtoR (rat_of_positive 2). + ((Ralpha i%:Q) + Num.sqrt (deltap i)) / QtoR (rat_of_positive 2). pose yp (i : int) : realalg := - ((Ralpha i%:~R) - Num.sqrt (deltap i)) / QtoR (rat_of_positive 2). -have {deltapE aux_rmoprhV} xyp i : 0 <= i -> (xp i) * (yp i) = Rbeta i%:~R. + ((Ralpha i%:Q) - Num.sqrt (deltap i)) / QtoR (rat_of_positive 2). +have {deltapE} xyp i : 0 <= i -> (xp i) * (yp i) = Rbeta i%:Q. move=> ?; rewrite mulrC /xp /yp mulrAC !mulrA -subr_sqr. - rewrite sqr_sqrtr; last by apply: ltrW; exact: deltap_pos. + rewrite sqr_sqrtr; last exact/ltW/deltap_pos. rewrite deltapE opprD opprK addrA addrN add0r -mulrA mulrC mulrA -invfM. rewrite -rmorphM /=. have -> : rat_of_positive 2 * rat_of_positive 2 = rat_of_positive 4. by apply/eqP; rewrite [_ == _]refines_eq. rewrite mulVf ?mul1r //; apply: lt0r_neq0; rewrite RealAlg.ltr_to_alg. exact: lt_0_rat_of_positive. -have x_plus_yp i : (xp i) + (yp i) = Ralpha i%:~R. - rewrite /xp /yp -mulrDl addrAC addrA addrNK -{-3}[Ralpha i%:~R]mulr1. +have x_plus_yp i : (xp i) + (yp i) = Ralpha i%:Q. + rewrite /xp /yp -mulrDl addrAC addrA addrNK -{-3}[Ralpha i%:Q]mulr1. rewrite -mulrDr -mulrA. suff -> : ((1 + 1) / QtoR (rat_of_positive 2)) = 1 by rewrite mulr1. rewrite -[1]/(QtoR 1) -rmorphD -fmorphV -rmorphM /=; congr QtoR. @@ -408,37 +378,35 @@ have hr_p_pos i t (le0i : 0 <= i) : yp i <= t -> t <= xp i -> 0 <= p i t. suff rho_in_Iyx i (le2i : 2%:~R <= i) : yp i <= QtoR (rho i) <= xp i. by case/andP: (rho_in_Iyx _ le2k) => yr rx; apply: hr_p_pos. have lt_0_xp j : (0 <= j) -> 0 < xp j. - move=> le0j; rewrite /xp; apply: divr_gt0; last first. - rewrite RealAlg.ltr_to_alg; exact: lt_0_rat_of_positive. - apply: ltr_paddr; first by apply: sqrtr_ge0. - by apply: lt_Ralpha_0. + move=> le0j; rewrite /xp; apply: divr_gt0. + exact/ltr_paddr/lt_Ralpha_0/le0j/sqrtr_ge0. + rewrite RealAlg.ltr_to_alg; exact: lt_0_rat_of_positive. have le_1_xp j (le0j : 0 <= j) : 1 <= xp j. rewrite /xp lter_pdivl_mulr ?mul1r; last first. rewrite RealAlg.ltr_to_alg; exact: lt_0_rat_of_positive. - have trans : QtoR (rat_of_positive 2) <= Ralpha j%:~R. - by apply: ltrW; rewrite RealAlg.ltr_to_alg lt_2_alphaN // ler0z. - apply: ler_trans trans _; rewrite ler_addl; exact: sqrtr_ge0. + have trans : QtoR (rat_of_positive 2) <= Ralpha j%:Q. + by apply: ltW; rewrite RealAlg.ltr_to_alg lt_2_alphaN // ler0z. + apply: le_trans trans _; rewrite ler_addl; exact: sqrtr_ge0. have le_yp_1 j : 2%:~R <= j -> yp j <= 1. move=> le2j. - have le0j : 0 <= j by apply: ler_trans le2j; rewrite le0z_nat. - have -> : yp j = (Rbeta j%:~R) / (xp j). - by rewrite -xyp // mulrAC mulfV ?mul1r //; apply: lt0r_neq0; apply: lt_0_xp. + have le0j : 0 <= j by apply: le_trans le2j; rewrite le0z_nat. + have -> : yp j = (Rbeta j%:Q) / (xp j). + by rewrite -xyp // mulrAC mulfV ?mul1r //; apply/lt0r_neq0/lt_0_xp. rewrite -[X in _ <= X]mulr1; apply: ler_pmul. - - apply: ltrW; exact: lt_0_Rbeta. - - rewrite invr_ge0; apply: ltrW; exact: lt_0_xp. - - apply: ltrW; exact: lt_Rbeta_1. + - exact/ltW/lt_0_Rbeta. + - by rewrite invr_ge0; exact/ltW/lt_0_xp. + - exact/ltW/lt_Rbeta_1. - rewrite invf_le1; last exact: lt_0_xp. - - exact: le_1_xp. + exact: le_1_xp. have hr_incr j x y : 0 <= j -> 0 < x -> x <= y -> hr j x <= hr j y. move=> le0j lt0x lexy; rewrite -subr_ge0 /hr addrAC [- (Ralpha _ - _)]opprD. rewrite opprK addrA addrN add0r -mulrBr; apply: mulr_ge0. - by rewrite RealAlg.ler_to_alg; apply: ltrW; apply: lt_0_beta; rewrite ler0z. - by rewrite subr_ge0 lef_pinv // posrE //; apply: ltr_le_trans lexy. + by rewrite RealAlg.ler_to_alg; apply/ltW/lt_0_beta; rewrite ler0z. + by rewrite subr_ge0 lef_pinv // posrE //; apply: lt_le_trans lexy. suff rho_in_I1x : 1 <= QtoR (rho i) <= xp i. - case/andP: rho_in_I1x => h1 ->; rewrite andbT. - by apply: ler_trans h1; apply: le_yp_1. + by case/andP: rho_in_I1x => h1 ->; rewrite andbT; exact/le_trans/h1/le_yp_1. suff lerx : QtoR (rho i) <= xp i. - by rewrite [X in X && _]RealAlg.ler_to_alg le_1_rho //=; apply: ler_trans le2i. + by rewrite [X in X && _]RealAlg.ler_to_alg le_1_rho //=; apply: le_trans le2i. suff im_hr j x (le0j : 0 <= j) (lt0x : 0 < x) : x <= xp j -> hr j x <= xp (j + 1). have base_case : QtoR (rho 2) <= xp 2. @@ -447,8 +415,8 @@ suff im_hr j x (le0j : 0 <= j) (lt0x : 0 < x) : x <= xp j -> rewrite /xp ler_pdivl_mulr; last first. - by rewrite RealAlg.ltr_to_alg lt_0_rat_of_positive. rewrite -ler_subl_addl; set lhs := (X in X <= _). - case: (ler0P lhs) => [le_lhs_0 | lt_0_lhs]. - apply: ler_trans le_lhs_0 _; exact: sqrtr_ge0. + have [le_lhs_0 | lt_0_lhs] := ler0P lhs. + exact/le_trans/sqrtr_ge0/le_lhs_0. rewrite -[lhs]gtr0_norm // -sqrtr_sqr; apply: ler_wsqrtr; rewrite /lhs. rewrite -rmorphM /Ralpha -rmorphB -rmorphX /deltap RealAlg.ler_to_alg. by rewrite -[2%N]/(Pos.to_nat 2) -rat_of_positiveE. @@ -462,20 +430,20 @@ suff im_hr j x (le0j : 0 <= j) (lt0x : 0 < x) : x <= xp j -> have -> : n.+3 = Posz n.+2 + 1 :> int by rewrite -addn1 PoszD. have -> : QtoR (rho (Posz n.+2 + 1)) = hr n.+2 (QtoR (rho n.+2)). rewrite rho_rec // h2hr // ; exact: lt_0_rho. - apply: ler_trans (im_hr _ _ _ _ ler3x) _ => //. + apply: le_trans (im_hr _ _ _ _ ler3x) _ => //. rewrite RealAlg.ltr_to_alg; exact: lt_0_rho. move/(hr_incr j _ _ le0j lt0x) => {i le2i}. have -> : hr j (xp j) = xp j. - apply/eqP; rewrite -subr_eq0 hr_p; last by apply: lt0r_neq0; exact: lt_0_xp. + apply/eqP; rewrite -subr_eq0 hr_p; last exact/lt0r_neq0/lt_0_xp. suff -> : p j (xp j) = 0 by rewrite mul0r. by rewrite fac_p // subrr mul0r oppr0. -move=> h; apply: ler_trans h _. +move=> h; apply: le_trans h _. suff xp_incr : xp j <= xp (j + 1) by []. rewrite /xp ler_pmul2r; last first. by rewrite invr_gt0 RealAlg.ltr_to_alg lt_0_rat_of_positive. apply: ler_add. -- by rewrite RealAlg.ler_to_alg rmorphD /=; apply: alpha_incr; rewrite ler0z. -rewrite ler_sqrt; last by apply: deltap_pos; apply: addr_ge0. + by rewrite RealAlg.ler_to_alg rmorphD /=; apply: alpha_incr; rewrite ler0z. +rewrite ler_sqrt; last exact/deltap_pos/addr_ge0. by rewrite /deltap RealAlg.ler_to_alg rmorphD; apply: delta_incr; rewrite ler0z. Qed. @@ -492,59 +460,56 @@ Proof. by rewrite rho_h_iter // [_ < _]refines_eq; vm_compute. Qed. (* Here I still do not know which cast we should keep so that's the *) (* temporary patch to make the pieces fit together. *) -Fact compat33 : rat_of_positive 33 = 33%:~R. -Proof. by rewrite -rat_of_Z_rat_of_positive rat_of_ZEdef. Qed. +Fact compat33 : rat_of_positive 33 = 33%:Q. +Proof. by rewrite -rat_of_Z_rat_of_positive rat_of_ZEdef. Qed. Notation N_rho := 51. -Lemma rho_maj (n : nat) : (N_rho < n)%N -> 33%:~R < rho n. +Lemma rho_maj (n : nat) : (N_rho < n)%N -> 33%:Q < rho n. Proof. -move=> lt_Nrho_n; rewrite -compat33; apply: ltr_le_trans lt_33_r51 _. +move=> lt_Nrho_n; rewrite -compat33; apply: lt_le_trans lt_33_r51 _. by apply: rho_incr => //; rewrite lez_nat; apply: leq_trans lt_Nrho_n. Qed. Definition Ka := - a 1 * ((\prod_(1 <= i < Posz N_rho + 1 :> int) rho i) / 33%:~R ^+ (N_rho.+1)). + a 1 * ((\prod_(1 <= i < Posz N_rho + 1 :> int) rho i) / 33%:Q ^+ N_rho.+1). Lemma lt_0_Ka : 0 < Ka. Proof. rewrite /Ka; apply: mulr_gt0; first exact: lt_0_a. apply: divr_gt0; last by rewrite exprn_gt0. -rewrite big_int_cond; apply: prodr_gt0 => i; rewrite andbT => /andP [hi _]. -by apply: lt_0_rho; apply: ler_trans hi. +rewrite big_int_cond; apply: prodr_gt0 => i; rewrite andbT => /andP [hi _]. +exact/lt_0_rho/le_trans/hi. Qed. (* FIXME : lack of _const lemma in bigopz *) -Lemma a_maj (i : int) : 1 < i -> Posz N_rho + 1 < i -> Ka * 33%:~R ^ i < a i. +Lemma a_maj (i : int) : 1 < i -> Posz N_rho + 1 < i -> Ka * 33%:Q ^ i < a i. Proof. move=> lt1i ltiNrho. rewrite /Ka; set Ka' := (X in a 1 * X * _ <_). -suff : Ka' * 33%:~R ^ i < a i / a 1. - rewrite [in X in X -> _]ltr_pdivl_mulr; last by apply: lt_0_a. +suff : Ka' * 33%:Q ^ i < a i / a 1. + rewrite [in X in X -> _]ltr_pdivl_mulr; last exact: lt_0_a. by rewrite mulrC [in X in X -> _]mulrA. rewrite -[X in _ < X](@telescope_prod_int _ 1 i (fun i => a i)) //; last first. - by move=> /= k /andP [le1k ltki]; apply: a_neq0; apply: ler_trans le1k. -rewrite (big_cat_int _ _ _ _ (ltrW ltiNrho)) /=; last by rewrite ler_addr. -suff hrho_maj : 33%:~R ^ i / 33%:~R ^+ N_rho.+1 < + by move=> /= k /andP [le1k ltki]; apply/a_neq0/le_trans/le1k. +rewrite (big_cat_int _ _ _ _ (ltW ltiNrho)) /=; last by rewrite ler_addr. +suff hrho_maj : 33%:Q ^ i / 33%:Q ^+ N_rho.+1 < \prod_(Posz N_rho + 1 <= i0 < i :> int) (a (i0 + 1) / a i0). rewrite /Ka' mulrAC -mulrA ltr_pmul2l; first exact: hrho_maj. - rewrite big_int_cond; apply: prodr_gt0 => j; rewrite andbT => /andP [hj _]. - apply: lt_0_rho; exact: ler_trans hj. + rewrite big_int_cond; apply: prodr_gt0 => j; rewrite andbT => /andP [hj _]. + exact/lt_0_rho/le_trans/hj. rewrite -PoszD; case: i lt1i ltiNrho => i //; rewrite !ltz_nat => lt1i. rewrite addn1 => ltiNrho; rewrite eq_big_int_nat /= -expfB //. -have -> : 33%:~R ^+ (i - N_rho.+1) = \prod_(N_rho.+1 <= i0 < i) 33%:~R :> rat. +have -> : 33%:Q ^+ (i - N_rho.+1) = \prod_(N_rho.+1 <= i0 < i) 33%:Q. by rewrite big_const_nat -bigop.Monoid.iteropE //=. by apply: ltr_prod_nat=> [// | j /andP[h51j hji]]; rewrite rho_maj 1?h51j. Qed. -Lemma a_asympt (n : nat) : (N_rho + 1 < n)%N -> - 1 / a (Posz n) < Ka^-1 / (33%:~R ^ n). +Lemma a_asympt (n : nat) : (N_rho + 1 < n)%N -> 1 / a n < Ka^-1 / 33%:Q ^ n. Proof. -move=> hn; rewrite ltr_pdivr_mulr; last by apply: lt_0_a. -rewrite mulrAC ltr_pdivl_mulr; last by apply: exprz_gt0. -rewrite mul1r mulrC ltr_pdivl_mulr; last exact: lt_0_Ka. -rewrite mulrC; apply: a_maj; last by rewrite -PoszD ltz_nat. -by apply: leq_trans hn; rewrite addn1. +move=> hn; rewrite ltr_pdivr_mulr; last exact: lt_0_a. +rewrite -invfM ltr_pdivl_mull; last exact/mulr_gt0/exprz_gt0/isT/lt_0_Ka. +by rewrite mulr1; apply/a_maj/hn/leq_trans/hn. Qed. diff --git a/theories/algo_closures.v b/theories/algo_closures.v index 0ab93c1..939949c 100644 --- a/theories/algo_closures.v +++ b/theories/algo_closures.v @@ -1,36 +1,28 @@ (* In this file, we now propagate the theories in the ops_for_x files to prove results on our concrete sequences defined in seq_defs.v. *) -Require Import Psatz ZArith. +Require Import ZArith. From mathcomp Require Import all_ssreflect all_algebra. -Require Import binomialz bigopz. +Require Import binomialz. Require Import field_tactics lia_tactics shift. Require Import seq_defs. -Require harmonic_numbers. -Require ops_for_a ops_for_b ops_for_s ops_for_u ops_for_v. - -Require annotated_recs_c. -Require annotated_recs_z. -Require annotated_recs_d. +Require ops_for_a ops_for_b ops_for_s ops_for_u ops_for_v. +Require annotated_recs_c annotated_recs_z annotated_recs_d. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Open Scope ring_scope. +Local Open Scope ring_scope. Import GRing.Theory. -Import Num.Theory. (* First, a few lemmas to avoid repeated 'have ...' in the proofs. *) -Lemma middle_1 (a b : int) : a + 1 + b = a + b + 1. -Proof. by rewrite -addrA [1 + _]addrC addrA. Qed. - Lemma alt_sign (a : int) : (-1) ^ (a + 1) = - (-1) ^ a :> rat. -Proof. by rewrite exprzDr // expr1z mulrN1. Qed. +Proof. by rewrite exprzDr // expr1z mulrN1. Qed. (* Then, the propagation of the theories.*) @@ -38,7 +30,7 @@ Lemma c_Sn : annotated_recs_c.Sn c. Proof. rewrite /annotated_recs_c.Sn /annotated_recs_c.precond.Sn => n k ?. rewrite /c. -rewrite middle_1 !binSz; [| intlia..]. +rewrite addrAC !binSz; [| intlia..]. rewrite rmorphD /=. set b1 := binomialz _ _. set b2 := binomialz _ _. @@ -64,27 +56,22 @@ Qed. Definition c_ann := annotated_recs_c.ann c_Sn c_Sk. -Lemma a_Sn2 (n : int) : (2 : int) <= n -> annotated_recs_c.P_horner a n = 0. -Proof. -move=> h. -apply: (ops_for_a.recAperyA c_ann h). -Qed. +Lemma a_Sn2 (n : int) : 2 <= n :> int -> annotated_recs_c.P_horner a n = 0. +Proof. by move=> h; exact: (ops_for_a.recAperyA c_ann h). Qed. Lemma d_Sn : annotated_recs_d.Sn d. - Proof. rewrite /annotated_recs_d.Sn /annotated_recs_d.precond.Sn => n k m ?. rewrite /d. -rewrite middle_1 !binSz; [ | by intlia ..]. +rewrite addrAC !binSz; [ | by intlia ..]. set b1 := binomialz _ _. set b2 := binomialz _ _. rewrite rmorphD /= /annotated_recs_d.Sn_cf0_0_0. -rat_field. -have : exists e1 : int, b1 = e1%:~R /\ e1 > 0 by apply: bin_nonneg_int; intlia. -case=> e1. case=> -> {b1} e1_pos. -have : exists e2 : int, b2 = e2%:~R /\ e2 > 0 by apply: bin_nonneg_int; intlia. -case=> e2. case=> -> {b2} e2_pos. -by goal_to_lia; intlia. +have {b1} [e1 [-> e1_pos]]: exists e1, b1 = e1%:Q /\ e1 > 0. + by apply: bin_nonneg_int; intlia. +have {b2} [e2 [-> e2_pos]]: exists e2, b2 = e2%:Q /\ e2 > 0. + by apply: bin_nonneg_int; intlia. +by rat_field; goal_to_lia; intlia. Qed. (* This is a fake recurrence, because d does not really depend on k *) @@ -98,36 +85,29 @@ Lemma d_Sm : annotated_recs_d.Sm d. Proof. rewrite /annotated_recs_d.Sm /annotated_recs_d.precond.Sm => n k m ?. rewrite /d. -rewrite middle_1 !alt_sign rmorphD /=. +rewrite addrAC !alt_sign rmorphD /=. rewrite addrA. rewrite !(binzS, binSz); [ | intlia ..]. set b1 := binomialz _ _. set b2 := binomialz _ _. rewrite /annotated_recs_d.Sm_cf0_0_0 !rmorphD /=. -rat_field. -have : exists e1 : int, b1 = e1%:~R /\ e1 > 0 by apply: bin_nonneg_int; intlia. -case=> e1. case=> -> {b1} e1_pos. -have : exists e2 : int, b2 = e2%:~R /\ e2 > 0 by apply: bin_nonneg_int; intlia. -case=> e2. case=> -> {b2} e2_pos. -by goal_to_lia; intlia. +have {b1} [e1 [-> e1_pos]]: exists e1 : int, b1 = e1%:Q /\ e1 > 0. + by apply: bin_nonneg_int; intlia. +have {b2} [e2 [-> e2_pos]]: exists e2 : int, b2 = e2%:Q /\ e2 > 0. + by apply: bin_nonneg_int; intlia. +by rat_field; goal_to_lia; intlia. Qed. Definition d_ann := annotated_recs_d.ann d_Sn d_Sk d_Sm. Lemma s_Sn2 : annotated_recs_s.Sn2 s. -Proof. -by apply: (ops_for_s.s_Sn2 d_ann). -Qed. +Proof. exact: ops_for_s.s_Sn2 d_ann. Qed. Lemma s_SnSk : annotated_recs_s.SnSk s. -Proof. -by apply: (ops_for_s.s_SnSk d_ann). -Qed. +Proof. exact: ops_for_s.s_SnSk d_ann. Qed. Lemma s_Sk2 : annotated_recs_s.Sk2 s. -Proof. -by apply: (ops_for_s.s_Sk2 d_ann). -Qed. +Proof. exact: ops_for_s.s_Sk2 d_ann. Qed. Definition s_ann := annotated_recs_s.ann s_Sn2 s_SnSk s_Sk2. @@ -145,42 +125,26 @@ Qed. Definition z_ann := annotated_recs_z.ann z_Sn2. Lemma u_Sn2 : annotated_recs_s.Sn2 u. - -Proof. -by apply: (ops_for_u.u_Sn2 z_ann s_ann). -Qed. +Proof. exact: ops_for_u.u_Sn2 z_ann s_ann. Qed. Lemma u_SnSk : annotated_recs_s.SnSk u. -Proof. -by apply: (ops_for_u.u_SnSk z_ann s_ann). -Qed. +Proof. exact: ops_for_u.u_SnSk z_ann s_ann. Qed. Lemma u_Sk2 : annotated_recs_s.Sk2 u. -Proof. -by apply: (ops_for_u.u_Sk2 z_ann s_ann). -Qed. +Proof. exact: ops_for_u.u_Sk2 z_ann s_ann. Qed. Definition u_ann := annotated_recs_s.ann u_Sn2 u_SnSk u_Sk2. Lemma v_Sn2 : annotated_recs_v.Sn2 v. -Proof. -by apply: (ops_for_v.v_Sn2 c_ann u_ann). -Qed. +Proof. exact: ops_for_v.v_Sn2 c_ann u_ann. Qed. Lemma v_SnSk : annotated_recs_v.SnSk v. -Proof. -by apply: (ops_for_v.v_SnSk c_ann u_ann). -Qed. +Proof. exact: ops_for_v.v_SnSk c_ann u_ann. Qed. Lemma v_Sk2 : annotated_recs_v.Sk2 v. -Proof. -by apply: (ops_for_v.v_Sk2 c_ann u_ann). -Qed. +Proof. exact: ops_for_v.v_Sk2 c_ann u_ann. Qed. Definition v_ann := annotated_recs_v.ann v_Sn2 v_SnSk v_Sk2. Lemma b_Sn4 (n : int) : n >= (2 : int) -> annotated_recs_v.P_horner b n = 0. -Proof. -move=> h. -by apply: (ops_for_b.recAperyB v_ann h). -Qed. +Proof. by move=> h; exact: (ops_for_b.recAperyB v_ann h). Qed. diff --git a/theories/annotated_recs_a.v b/theories/annotated_recs_a.v index ead5d1a..2c87cc3 100644 --- a/theories/annotated_recs_a.v +++ b/theories/annotated_recs_a.v @@ -1,4 +1,3 @@ Load "include/ops_header.v". Load "include/ann_a.v". - diff --git a/theories/annotated_recs_b.v b/theories/annotated_recs_b.v index 3198471..70f4916 100644 --- a/theories/annotated_recs_b.v +++ b/theories/annotated_recs_b.v @@ -2,4 +2,4 @@ Load "include/ops_header.v". Load "include/ann_b.v". -Definition P_horner := annotated_recs_v.P_horner. \ No newline at end of file +Definition P_horner := annotated_recs_v.P_horner. diff --git a/theories/annotated_recs_c.v b/theories/annotated_recs_c.v index 47c6485..307413c 100644 --- a/theories/annotated_recs_c.v +++ b/theories/annotated_recs_c.v @@ -19,4 +19,3 @@ Record Ann c : Type := ann { Sn_ : Sn c; Sk_ : Sk c }. - diff --git a/theories/annotated_recs_d.v b/theories/annotated_recs_d.v index 0592b01..579c32e 100644 --- a/theories/annotated_recs_d.v +++ b/theories/annotated_recs_d.v @@ -1,6 +1,5 @@ Load "include/ops_header.v". - Module precond. Definition Sn (n k m : int) := (n >= 0) /\ (m > 0) /\ (n >= m). @@ -33,4 +32,3 @@ Record Ann d : Type := ann { Sk_ : Sk d; Sm_ : Sm d }. - diff --git a/theories/annotated_recs_s.v b/theories/annotated_recs_s.v index 692001b..9092e3c 100644 --- a/theories/annotated_recs_s.v +++ b/theories/annotated_recs_s.v @@ -10,10 +10,8 @@ End precond. Load "include/ann_s.v". - Record Ann s : Type := ann { Sn2_ : Sn2 s; SnSk_ : SnSk s; Sk2_ : Sk2 s }. - diff --git a/theories/annotated_recs_v.v b/theories/annotated_recs_v.v index d3e25d9..2890451 100644 --- a/theories/annotated_recs_v.v +++ b/theories/annotated_recs_v.v @@ -20,4 +20,3 @@ Record Ann v : Type := ann { SnSk_ : SnSk v; Sk2_ : Sk2 v }. - diff --git a/theories/annotated_recs_z.v b/theories/annotated_recs_z.v index d803504..74d482a 100644 --- a/theories/annotated_recs_z.v +++ b/theories/annotated_recs_z.v @@ -10,8 +10,6 @@ End precond. Load "include/ann_z.v". - Record Ann z : Type := ann { Sn2_ : Sn2 z }. - diff --git a/theories/arithmetics.v b/theories/arithmetics.v index c57c1f6..c07397e 100644 --- a/theories/arithmetics.v +++ b/theories/arithmetics.v @@ -1,13 +1,9 @@ From mathcomp Require Import all_ssreflect all_algebra. - Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. - (******************************************************************************) (* The main purpose of this library is to establish properties of the *) (* sequence lcm(1..n). The proof of irrationality that we formalize *) @@ -22,8 +18,6 @@ Import Num.Theory. Section ExtraBigOp. -Local Open Scope nat_scope. - Lemma logn_prod (I : Type) (r : seq I) F p : (forall i : I, 0 < F i) -> logn p (\prod_(i <- r) F i) = \sum_(i <- r) logn p (F i). Proof. @@ -31,17 +25,14 @@ move => H; elim: r => [|a l Hl]; first by rewrite !big_nil logn1. rewrite !big_cons lognM ?Hl //; exact: prodn_gt0. Qed. - Lemma natsumrB A (P : A -> bool) F1 F2 l : (forall i, (P i -> F1 i >= F2 i)) -> \sum_(i <- l | P i) F1 i - \sum_(i <- l | P i) F2 i = \sum_(i <- l | P i) (F1 i - F2 i). Proof. move => Hge; elim: l => [|a l Hl]; first by rewrite !big_nil. -case HPa : (P a); rewrite !big_cons HPa /=; last exact: Hl. -have H12 : F1 a = F2 a + (F1 a - F2 a) by rewrite subnKC //; exact: (Hge a HPa). -rewrite H12 -addnA subnDl -addnBA; last by apply: leq_sum. -by rewrite Hl -H12. +rewrite !big_cons; case HPa: (P a); rewrite // subnDA -addnBAC ?Hge //. +by rewrite -addnBA ?Hl // leq_sum. Qed. Lemma sum_ord_const_nat n m : \sum_(i < n) m = m * n. @@ -76,7 +67,7 @@ have -> : logn p n.+1 = \sum_(i < n) (p ^ i.+1 %| n.+1). have -> : P = [set i : 'I__ | i.+1 <= logn p n.+1]. apply/setP => i; rewrite !inE /= -{1}(@partnC p n.+1) //. rewrite Gauss_dvdl; first by rewrite p_part dvdn_Pexp2l ?prime_gt1. - by rewrite (@pnat_coprime p) ?part_pnat ?pnat_exp ?pnat_id. + by rewrite (@pnat_coprime p) ?part_pnat ?pnatX ?pnat_id. rewrite -sum1dep_card big_ord_narrow ?sum_nat_const ?muln1 ?card_ord //. rewrite -(@leq_exp2l p) ?prime_gt1 // -p_part. by rewrite (leq_trans (dvdn_leq _ (dvdn_part p _))) // ltn_expl ?prime_gt1. @@ -93,6 +84,7 @@ Qed. (* Same as fact_logp_sum, with a wider range for the sum. *) Lemma fact_logp_sum_widen p m n : prime p -> (m >= n)%N -> logn p n`! = \sum_(i < m) (n %/ p ^ i.+1). +Proof. move => prime_p leq_nm; rewrite logn_fact //; symmetry. (* FIXME : here I would like to simply 'rewrite big_mkord', but I need *) (* to specify both the (dummy) predicate and the summand... *) @@ -134,6 +126,9 @@ Proof. by rewrite /iter_lcmn big_geq. Qed. Lemma iter_lcmnS m : iter_lcmn m.+1 = lcmn (iter_lcmn m) m.+1. Proof. by rewrite /iter_lcmn 2!big_add1 big_nat_recr /=. Qed. +Lemma iter_lcmn1 : iter_lcmn 1 = 1. +Proof. by rewrite iter_lcmnS iter_lcmn0 lcmn1. Qed. + Fact iter_lcmn_gt0 (n : nat) : (l n > 0)%N. Proof. elim: n => [|n ihn]; first by rewrite iter_lcmn0. @@ -164,7 +159,7 @@ Qed. (* (logn p n!) can be expressed as a sum of trunc_log *) Lemma logp_sum_floor p n : prime p -> - logn p (n`!) = \sum_(i < trunc_log p n) (n %/ p ^ i.+1). + logn p (n`!) = \sum_(i < trunc_log p n) n %/ p ^ i.+1. Proof. move=> hp; rewrite -fact_logp_sum_small //; apply: trunc_log_ltn. exact: prime_gt1. @@ -176,8 +171,8 @@ Lemma logn_divz p a b : (0 < a)%N -> b %| a -> Proof. by move=> ? ?; rewrite logn_div // -subzn // dvdn_leq_log. Qed. -Lemma bin_valp m k p : (m > 0) -> prime p -> (m <= k) -> - (logn p (m * 'C(k, m)) <= logn p (l k)). +Lemma bin_valp m k p : + m > 0 -> prime p -> m <= k -> logn p (m * 'C(k, m)) <= logn p (l k). Proof. move => gt_m_0 prime_p leq_mk. have le2p : 2 <= p by exact: prime_gt1. @@ -187,14 +182,14 @@ set tp := trunc_log p. have hvp_bin : vp 'C(k,m) = vp k`! - (vp m`! + vp (k - m)`!). rewrite bin_factd // /vp logn_div ?lognM ?fact_gt0 //. by rewrite -(bin_fact leq_mk) dvdn_mull. -have {hvp_bin} hvp_bin : vp 'C(k, m) = +have {}hvp_bin : vp 'C(k, m) = \sum_(i < tp k) (k %/ p ^ i.+1) - \sum_(i < tp k) (m %/ p ^ i.+1 + (k - m) %/ p ^ i.+1). rewrite -fact_logp_sum_small ?trunc_log_ltn //. rewrite big_split /= -!fact_logp_sum_small ?trunc_log_ltn //. - by apply: (ltn_trans _ (trunc_log_ltn _ le2p)); rewrite ltn_subrL gt_m_0. - exact: (leq_trans _ (trunc_log_ltn _ le2p)). -have {hvp_bin} hvp_bin : vp 'C(k, m) = +have {}hvp_bin : vp 'C(k, m) = \sum_(i < tp k - vp m) (k %/ p ^ (vp m + i).+1) - \sum_(i < tp k - vp m) (m %/ p ^ (vp m + i).+1 + (k - m) %/ p ^ (vp m + i).+1). set rhs := RHS; rewrite {}hvp_bin. @@ -220,7 +215,7 @@ Qed. (* In the proof that zeta(3) is irrational, we use this corollary to show *) (* that (lcn (1..n))^3 * b_n is an integer. *) Corollary dvd_nbin_iter_lcmn (i j : nat) (n : nat) : - (1 <= j) -> (j <= i) -> (i <= n) -> (j * 'C(i, j) %| l n). + 1 <= j -> j <= i -> i <= n -> j * 'C(i, j) %| l n. Proof. move=> le0j leji lein. apply/dvdn_partP => [|p hp]; first by rewrite muln_gt0 bin_gt0 le0j. diff --git a/theories/b_over_a_props.v b/theories/b_over_a_props.v index a56aa80..3e3476f 100644 --- a/theories/b_over_a_props.v +++ b/theories/b_over_a_props.v @@ -3,7 +3,6 @@ From mathcomp Require Import all_ssreflect all_algebra. Require Import extra_mathcomp. -Require Import binomialz bigopz. Require Import field_tactics lia_tactics shift. Require Import seq_defs. @@ -17,10 +16,9 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (**** We introduce and study the casoratian of a and b ****) @@ -32,17 +30,17 @@ Definition ba_casoratian (k : int) : rat := (* This is the bulk of section 5 in apery1.html, and equation (7) p.5 in Van der Poorten's paper (not true for n = 1) *) -Lemma ba_casoratianE (n : int) : 2%:~R <= n -> - ba_casoratian n = 6%:~R / (n%:~R + 1%:~R) ^ 3. +Lemma ba_casoratianE (n : int) : + 2%:~R <= n -> ba_casoratian n = 6%:Q / (n%:Q + 1) ^ 3. Proof. -move=> le2n; have le0n : 0 <= n by exact: ler_trans le2n. -pose v (k : int) : rat := 6%:~R / (k%:~R + 1%:~R) ^ 3. +move=> le2n; have le0n : 0 <= n by exact: le_trans le2n. +pose v (k : int) : rat := 6%:Q / (k%:Q + 1) ^ 3. pose c1 := annotated_recs_c.P_cf2. pose c0 := annotated_recs_c.P_cf0. pose Urec (v : int -> rat) := forall (k : int), 2%:~R <= k -> (c1 k) * v (int.shift 1 k) - (c0 k) * v k = 0. have uUrec : Urec ba_casoratian. - move=> k le2k; have le0k : 0 <= k by exact: ler_trans le2k. + move=> k le2k; have le0k : 0 <= k by exact: le_trans le2k. have brec := b_Sn2 le0k; have arec := a_Sn2 le2k. have -> : 0 = a (int.shift 1 k) * annotated_recs_c.P_horner b k - b (int.shift 1 k) * annotated_recs_c.P_horner a k. @@ -56,7 +54,7 @@ have vUrec : Urec v. (* this step below is only the fact that U is a rec of order 1 : should be *) (* obtained from something more general... *) suff {uUrec vUrec v} Urec1P (w1 w2 : int -> rat) : w1 2 = w2 2 -> - Urec w1 -> Urec w2 -> forall (k : int), 2%:~R <= k -> w1 k = w2 k. + Urec w1 -> Urec w2 -> forall (k : int), 2%:~R <= k -> w1 k = w2 k. apply: (Urec1P _ v) => //; rewrite /ba_casoratian /v b2_eq b3_eq. rewrite int.shift2Z a2_eq a3_eq. rat_field; do 2! (split; first by move/eqP; rewrite rat_of_Z_eq0). @@ -65,7 +63,7 @@ have hUrec w k : Urec w -> 2%:~R <= k -> w (int.shift 1 k) = (c0 k / c1 k) * w k move=> wUrec le2k; move/wUrec/eqP: (le2k); rewrite subr_eq0. have c1kn0 : c1 k != 0. rewrite /c1 /annotated_recs_c.P_cf2 expf_eq0 /= rat_of_ZEdef. - rewrite -[rat_of_Z_ 2%coqZ]/(2%:~R) -rmorphD /= intr_eq0; intlia. + rewrite -[rat_of_Z_ 2]/(2%:Q) -rmorphD /= intr_eq0; intlia. by rewrite mulrC (can2_eq (mulfK _) (mulfVK _)) // mulrAC; move/eqP. move=> ic Uw1 Uw2; case=> //; elim => // [[]] // [] // k ihk _. by rewrite -[_.+3]addn1 PoszD -int.zshiftP !hUrec // ihk. @@ -74,10 +72,10 @@ Qed. (* A technical (trivial) fact to be used in the proof creal_bovera_seq *) (* that b / a is Cauchy convergent. *) -Fact lt_0_ba_casoratian (n : nat) : 0 < 6%:~R / (n%:~R + 1%:~R) ^ 3 :> rat. +Fact lt_0_ba_casoratian (n : nat) : 0 < 6%:Q / (n%:Q + 1%:Q) ^ 3. Proof. apply: mulr_gt0 => //; rewrite invr_gt0; apply: exprz_gt0. -by rewrite -rmorphD /= -[0]/0%:~R ltr_int ltz_nat addn1. +by rewrite -rmorphD /= -[0]/0%:Q ltr_int ltz_nat addn1. Qed. @@ -90,7 +88,7 @@ Definition b_over_a_seq (k : int) := b k / a k. (* due to the previous results on the casoratian. *) Lemma Db_over_a_casoratian (i j : nat) : (2 <= j)%N -> (j <= i)%N -> b_over_a_seq i - b_over_a_seq j = - \sum_(j <= k < i) 6%:~R / (k%:~R + 1%:~R) ^ 3 / ((a (int.shift 1 k) * a k)). + \sum_(j <= k < i) 6%:Q / (k%:Q + 1) ^ 3 / (a (int.shift 1 k) * a k). Proof. move=> le2j leji; rewrite -(telescope_nat (fun k => b_over_a_seq (Posz k))) //. have -> : \sum_(j <= k < i) (b_over_a_seq (k + 1)%N - b_over_a_seq k) = diff --git a/theories/b_props.v b/theories/b_props.v index 884ff78..69c611f 100644 --- a/theories/b_props.v +++ b/theories/b_props.v @@ -11,10 +11,9 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (**** Properties the sequence b ****) @@ -33,27 +32,25 @@ Local Notation l := iter_lcmn. (* The parentheses matter to ease subterm selection in the proof of Qint_l3b *) Fact cdM (n : nat) (k m : int) : - 0 <= k -> 1 <= m -> m < k + 1 -> k < (Posz n) + 1 -> + 0 <= k -> 1 <= m -> m < k + 1 -> k < Posz n + 1 -> c n k * d n k m = - ((-1) ^ (m + 1) / 2%:~R) * (m%:~R ^ 3 * (binomialz k m) ^ 2)^-1 * - ((binomialz n k) * (binomialz (Posz n + k) k) * - (binomialz (Posz n - m)) (Posz n - k) * (binomialz ((Posz n) + k) (k - m))). + ((-1) ^ (m + 1) / 2%:Q) / (m%:Q ^ 3 * binomialz k m ^ 2) * + (binomialz n k * binomialz (Posz n + k) k * + binomialz (Posz n - m) (Posz n - k) * binomialz ((Posz n) + k) (k - m)). +Proof. move=> h0k h1m hmk hkn; rewrite /c /d. case: m h1m hmk => // m; case: k h0k hkn => k _ //. -rewrite -![_ + 1]PoszD !ltz_nat (addn1 n) (addn1 k) !ltnS => hkn h1m hmk. -have hnm : (m <= n)%N by apply: leq_trans hkn. -rewrite (subzn hkn) (subzn hmk) (subzn hnm) !binzE // ?leq_addr ?leq_addl //; last first. -- by apply: leq_sub2l. -- apply: leq_trans (leq_subr _ _) _ ; exact: leq_addl. +rewrite !ltz_addr1 !lez_nat => hkn h1m hmk. +have hnm : (m <= n)%N by apply: leq_trans hmk hkn. +rewrite (subzn hkn) (subzn hmk) (subzn hnm) !binzE ?leq_addl //; last first. +- exact: leq_sub2l. +- exact/leq_trans/leq_addl/leq_subr. have -> : (n + k - (k - m) = n + m)%N by rewrite subnBA // addnAC addnK. -have -> : (n - m - (n - k) = k - m)%N. - rewrite -subnDA addnBA // subnBA addnC ?subnDr //; apply: leq_trans hkn _. - by exact: leq_addr. -rewrite !addnK [Posz (m + 1)]PoszD. -rat_field. -rewrite {}/emb7 {}/emb4 {}/emb0 {}/emb3 {}/emb6{} /emb1 {}/emb {}/emb5 {emb2}. -do 8! (split; first by apply/eqP; rewrite intr_eq0 -lt0n // ?fact_gt0). -by apply/eqP; rewrite intr_eq0 -lt0n // ?fact_gt0. +have -> : (n - m - (n - k) = k - m)%N by rewrite subnAC subnBA // addKn. +rewrite !addnK; rat_field. +rewrite {}/emb6 {}/emb7 {}/emb1 {}/emb {}/emb0 {}/emb4 {}/emb3 {}/emb5 {emb2}. +do 8! (split; first by apply/eqP; rewrite intr_eq0 -lt0n ?fact_gt0). +by apply/eqP; rewrite intr_eq0 -lt0n ?fact_gt0. Qed. (* First significant step in the proof: for any n, the rational number *) @@ -65,61 +62,47 @@ Qed. (* This lemma is not in arithmetics.v becuse it uses type rat. *) Lemma iter_lcmn_mul_rat (r : rat) (n : nat) : `|denq r| <= n -> - ((iter_lcmn n)%:~R * r)%R \is a Qint. + (iter_lcmn n)%:Q * r \is a Qint. Proof. -move=> ledn; rewrite -[r]divq_num_den mulrA -rmorphM; apply: Qint_dvdz. -apply: dvdz_mulr; rewrite dvdzE /=; apply: iter_lcmn_div => //. -rewrite absz_gt0; exact: denq_neq0. +move=> ledn; rewrite -[r]divq_num_den mulrA -rmorphM. +by apply/Qint_dvdz/dvdz_mulr/iter_lcmn_div; rewrite // absz_gt0 denq_neq0. Qed. (* FIXME : still too much nat/int conversions, not so easy to do better *) -Lemma Qint_l3b (n : nat) : 2%:~R * ((l n)%:~R ^ 3) * (b (Posz n)) \is a Qint. +Lemma Qint_l3b (n : nat) : 2%:Q * (l n)%:Q ^ 3 * b (Posz n) \is a Qint. Proof. set goal_term := (X in X \is a Qint). have {goal_term} -> : goal_term = - 2%:~R * (l n)%:~R ^ 3 * ghn3 n * a n + - 2%:~R * (l n)%:~R ^ 3 * (\sum_(0 <= k < Posz n + 1 :> int) c n k * s n k). - rewrite -mulrA -mulrDr mulr_sumr -big_split /= /goal_term; rewrite /b. - by congr (_ * _); apply: eq_bigr => i _; rewrite /v /u mulrDr mulrC. -have left_arg_is_int : 2%:~R * (l n)%:~R ^ 3 * ghn3 n * a n \is a Qint. - apply: rpredM; last exact: Qint_a. - rewrite -[2%:~R * _ * _]mulrA; apply: rpredM => //. - suff h i : (1 <= i < Posz n + 1) -> (l n)%:~R ^ 3 / i%:~R ^ 3 \is a Qint. - rewrite /ghn3 /ghn mulr_sumr big_int_cond; apply: rpred_sum => i. - by rewrite andbT; exact: h. - case/andP=> h1i hin; rewrite expfV -expfzMl; apply: rpredX. - by apply: iter_lcmn_mul_rat; rewrite normr_denq denqVz ?gtr0_norm; intlia. -suff {left_arg_is_int} right_arg_is_int : - 2%:~R * (l n)%:~R ^ 3 * (\sum_(0 <= k < Posz n + 1 :> int) c n k * s n k) - \is a Qint by exact: rpredD. -suff sumd_is_int (k m : int) : 0 <= k -> 1 <= m -> m < k + 1 -> k < Posz n + 1 -> - 2%:~R * (l n)%:~R ^ 3 * c n k * d n k m \is a Qint. - rewrite mulr_sumr big_int_cond /=. - apply: rpred_sum => k; rewrite andbT => /andP [le0k lekn]. - rewrite /s mulrA mulr_sumr big_int_cond /=. - apply: rpred_sum => m; rewrite andbT => /andP [le0m lemi]; exact: sumd_is_int. -move=> le0k le1m lemk lekn. -pose hardest_term := (l n)%:~R ^ 3 / (m%:~R ^ 3 * binomialz k m ^ 2). -suff h : hardest_term \is a Qint. -(* Without the pattern, rewrite cfM now diverges!!! *) -rewrite -mulrA [X in _ * _ * X]cdM //. set other_term := (X in _ * _ * _ * X). - set goal_term := (X in X \is a Qint). - have {goal_term} -> : goal_term = (-1) ^ (m + 1) * other_term * hardest_term. - rewrite {}/goal_term /hardest_term; rat_field. - split; first by apply/eqP; apply: lt0r_neq0; apply: binz_gt0; intlia. - by split => //; apply/ eqP; rewrite intr_eq0; intlia. - apply: rpredM => //; apply: rpredM; first by rewrite expN1r; exact: rpredX. - rewrite {}/other_term. - by do 4! ((try apply: rpredM); last by apply: Qint_binomialz; intlia). -have {hardest_term} -> : hardest_term = - ((l n)%:~R / m%:~R) * ((l n)%:~R / (m%:~R * binomialz k m)) ^ 2. - rewrite expfzMl {}/hardest_term; rat_field. + 2%:Q * (l n)%:Q ^ 3 * ghn3 n * a n + + 2%:Q * (l n)%:Q ^ 3 * (\sum_(0 <= k < Posz n + 1 :> int) c n k * s n k). + rewrite -mulrA -mulrDr mulr_sumr -big_split /=; congr (_ * _). + by apply: eq_bigr => i _; rewrite mulrC -mulrDr. +rewrite mulr_sumr big_int_cond /=. +apply/rpredD/rpred_sum. + apply/rpredM/Qint_a; rewrite mulr_sumr big_int_cond; apply: rpred_sum. + move=> i /andP [/andP [h1i hin] _]; rewrite -mulrA expfV -expfzMl. + apply/rpredM/rpredX/iter_lcmn_mul_rat => //. + by rewrite normr_denq denqVz ?gtr0_norm; intlia. +move=> k /andP [/andP [le0k lekn] _]; rewrite mulrA mulr_sumr big_int_cond /=. +apply/rpred_sum => m /andP [/andP [le1m lemk] _]; rewrite -mulrA cdM //. +pose hardest_term := (l n)%:Q ^ 3 / (m%:Q ^ 3 * binomialz k m ^ 2). +set other_term := (X in _ * _ * _ * X). +set goal_term := (X in X \is a Qint). +have {goal_term} -> : goal_term = (-1) ^ (m + 1) * other_term * hardest_term. + rewrite /goal_term /hardest_term; rat_field. split; first by apply/eqP; apply: lt0r_neq0; apply: binz_gt0; intlia. + by split => //; apply/ eqP; rewrite intr_eq0; intlia. +apply/rpredM. + by rewrite expN1r !rpredM ?rpredX // Qint_binomialz //; intlia. +have {hardest_term other_term} -> : + hardest_term = ((l n)%:Q / m%:Q) * ((l n)%:Q / (m%:Q * binomialz k m)) ^ 2. + rewrite expfzMl {}/hardest_term; rat_field. + split; first by apply/eqP/lt0r_neq0/binz_gt0; intlia. by apply/eqP; rewrite intr_eq0; intlia. -apply: rpredM. -- by apply: iter_lcmn_mul_rat; rewrite normr_denq denqVz ?gtr0_norm; intlia. -apply: rpredX; case: k le0k lemk lekn => k // ; case: m le1m => m //. +apply/rpredM/rpredX. + by apply: iter_lcmn_mul_rat; rewrite normr_denq denqVz ?gtr0_norm; intlia. +case: k m le0k le1m lemk lekn => [] k [] m //. rewrite -![_ + 1]PoszD !ltz_nat !addn1 => *. -by rewrite binz_nat_nat -rmorphM /=; apply: Qint_dvdz; apply: dvd_nbin_iter_lcmn. +by rewrite binz_nat_nat -rmorphM /=; apply/Qint_dvdz/dvd_nbin_iter_lcmn. Qed. diff --git a/theories/bigopz.v b/theories/bigopz.v index b6ea35c..87e02ed 100644 --- a/theories/bigopz.v +++ b/theories/bigopz.v @@ -29,15 +29,14 @@ Reserved Notation "\prod_ ( m <= i < n :> 'int' ) F" (at level 36, F at level 36, i, m, n at level 50, format "'[' \prod_ ( m <= i < n :> 'int' ) '/ ' F ']'"). -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* Not sure this is the best definition...*) -Definition index_iotaz_ (mi ni : int) := +Definition index_iotaz (mi ni : int) := match mi, ni with | Posz _, Negz _ => [::] | Posz m, Posz n => map Posz (index_iota m n) @@ -45,10 +44,7 @@ Definition index_iotaz_ (mi ni : int) := | Negz m, Posz n => rev (map Negz (index_iota 0 m.+1)) ++ (map Posz (index_iota 0 n)) end. -Definition index_iotaz := nosimpl index_iotaz_. - -Lemma index_iotazE : index_iotaz = index_iotaz_. Proof. by []. Qed. - +Arguments index_iotaz mi ni : simpl never. Lemma size_index_iotaz m n : size (index_iotaz m n) = if m <= n then `|n - m|%N else 0%N. @@ -115,13 +111,13 @@ case: m => m; case: n => n // hmn hi; rewrite /index_iotaz /=. rewrite nth_iota; last by rewrite -ek leq_subr. by rewrite NegzE -addnS PoszD opprD addrC. by rewrite size_iota -ek leq_subr. - - have {hi} hi : (i - m.+1 < n)%N. + - have {}hi : (i - m.+1 < n)%N. move: hi; rewrite NegzE opprK -PoszD ger0_norm //. by rewrite PoszD -lter_sub_addr subzn ?ltz_nat // ltnNge -ltnS him. rewrite (nth_map 0%N); last by rewrite /index_iota size_iota subn0. rewrite /index_iota subn0 nth_iota // add0n NegzE addrC subzn //. by rewrite ltnNge -ltnS him. -- have {hmn} hmn : (n <= m)%N. +- have {}hmn : (n <= m)%N. by move: hmn; rewrite !NegzE ler_oppl opprK lez_nat. have hi' : (i < m - n)%N. by move: hi; rewrite !NegzE opprK addrC subzn. @@ -205,9 +201,9 @@ Proof. by move=> eqF; apply: congr_big_int. Qed. Lemma big_geqz m n (P : pred int) F : m >= n -> \big[op/idx]_(m <= i < n :> int | P i) F i = idx. Proof. -case: m => m; case: n => // n; rewrite index_iotazE ?big_nil //. - by rewrite lez_nat /index_iotaz_ /index_iota; move/eqnP->; rewrite big_nil. -rewrite ![in _ <= _]NegzE ler_opp2 lez_nat /index_iotaz_ /index_iota; move/eqnP->. +case: m => m; case: n => // n; rewrite /index_iotaz ?big_nil //. + by rewrite lez_nat /index_iota; move/eqnP->; rewrite big_nil. +rewrite ![in _ <= _]NegzE ler_opp2 lez_nat /index_iota; move/eqnP->. by rewrite big_nil. Qed. @@ -222,11 +218,11 @@ Proof. case: m => m; case: n => n // hmn. - by rewrite /= !big_map big_ltn_cond ?addn1. - case: m hmn => [_ | m]; rewrite NegzE. - by rewrite addNr big_map -NegzE index_iotazE /= big_cons big_map. - rewrite addrC subzSS add0r -!NegzE index_iotazE /index_iotaz_ -(addn1 m.+1). + by rewrite addNr big_map -NegzE /index_iotaz /= big_cons big_map. + rewrite addrC subzSS add0r -!NegzE /index_iotaz -(addn1 m.+1). by rewrite /index_iota subn0 iota_add map_cat rev_cat add0n /= big_cons. - case: m hmn => [ | m] //; rewrite !NegzE ltr_opp2 ltz_nat => hmn. - rewrite addrC subzSS add0r -!NegzE index_iotazE /= /index_iota subSn //. + rewrite addrC subzSS add0r -!NegzE /index_iotaz /index_iota subSn //. by rewrite -[(_ - _).+1]addn1 iota_add rev_cat map_cat subnKC // big_cons. Qed. @@ -286,17 +282,17 @@ have h : `|n - m| + `|p - n| = `|p - m|%N. rewrite hnp hmn orbT addnC; move/eqP; move/(f_equal Posz). by rewrite PoszD; move<-. apply: (@eq_from_nth _ 0); rewrite size_cat !size_index_iotaz hmn hnp. -- rewrite (ler_trans hmn hnp); move: h; rewrite -PoszD /=; move/eqP. +- rewrite (le_trans hmn hnp); move: h; rewrite -PoszD /=; move/eqP. by rewrite eqz_nat; move/eqP. - move=> i; move: (h); rewrite -PoszD; move/eqP; rewrite eqz_nat. move/eqP-> => hi1. rewrite (nth_cat 0) size_index_iotaz. rewrite hmn; case: ifP => hi2. - + by rewrite !nth_index_iotaz //;apply: ler_trans hnp. + + by rewrite !nth_index_iotaz //;apply: le_trans hnp. have hmn' : `|n - m | = n - m by apply: ger0_norm; rewrite subr_gte0. rewrite nth_index_iotaz //; last first. rewrite -subzn; last by rewrite leqNgt hi2. by rewrite lter_sub_addr addrC h ltz_nat. - rewrite nth_index_iotaz //; last exact: ler_trans hnp. + rewrite nth_index_iotaz //; last exact: le_trans hnp. rewrite -subzn; last by rewrite leqNgt hi2. move: hmn'; rewrite abszE; move->. rewrite addrCA opprB. by rewrite [_ + (_ - _)]addrCA subrr addr0 addrC. @@ -337,15 +333,14 @@ case: ifP=> hj; last first. apply: big_hasC; apply/hasPn => k. by rewrite mem_index_iotaz => hk; move/negbT: hj; apply: contra; move/eqP<-. case/andP: hj => hmj hjn. -rewrite (@big_cat_int _ _ _ _ _ hmj) /=; last by exact: ltrW. +rewrite (@big_cat_int _ _ _ _ _ hmj) /=; last by exact: ltW. rewrite big_hasC; last first. - apply/hasPn => k. rewrite mem_index_iotaz; case/andP=> _. - by rewrite ltr_def eq_sym; case/andP. + by apply/hasPn => k; rewrite mem_index_iotaz; case/andP=> _; apply: ltr_neq. rewrite Monoid.Theory.mul1m. rewrite big_ltz_cond // eqxx big_hasC; last first. apply/hasPn => k. rewrite mem_index_iotaz; case/andP=> hkj _. - suff : j < k by rewrite ltr_def eq_sym; case/andP. - by apply: ltr_le_trans hkj; rewrite cpr_add. + suff : j < k by rewrite lt_def eq_sym; case/andP. + by apply: lt_le_trans hkj; rewrite cpr_add. by rewrite Monoid.Theory.mulm1. Qed. @@ -365,7 +360,7 @@ Lemma big_nat_widen_lr (m1 m2 n1 n2 : nat) (P : pred nat) F : = \big[op/idx]_(m2 <= i < n2 | P i && (m1 <= i < n1)%N) F i. Proof. move=> len12 len21; symmetry; rewrite -big_filter filter_predI big_filter. -have [ltn_trans eq_by_mem] := (ltn_trans, eq_sorted_irr ltn_trans ltnn). +have [ltn_trans eq_by_mem] := (ltn_trans, irr_sorted_eq ltn_trans ltnn). congr bigop; apply: eq_by_mem; rewrite ?sorted_filter ?iota_ltn_sorted // => i. rewrite mem_filter !mem_index_iota; apply/idP/idP; first by case/and3P. move=> himn; rewrite himn; case/andP: himn => h1 h2. @@ -421,4 +416,4 @@ rewrite (@telescope_prod_nat _ _ _ (fun i => f (Posz i + a))%R) //. by rewrite e ltz_nat. Qed. -End TelescopeProd. \ No newline at end of file +End TelescopeProd. diff --git a/theories/binomialz.v b/theories/binomialz.v index 6d2d910..d5cfab7 100644 --- a/theories/binomialz.v +++ b/theories/binomialz.v @@ -1,4 +1,3 @@ -Require Import Psatz. From mathcomp Require Import all_ssreflect all_algebra. Require Import field_tactics lia_tactics. @@ -8,10 +7,9 @@ Unset Strict Implicit. Unset Printing Implicit Defensive. Set Printing Coercions. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* A binomial function over signed integers*) Fixpoint binomial_rec (n m : nat) (pn pm : bool) : rat := @@ -31,7 +29,7 @@ end. (* Eval compute in (binomial_rec 5 3 false true).*) -Definition binomialz_ (n m : int) : rat := +Definition binomialz (n m : int) : rat := match n,m with | Posz n1, Posz m1 => binomial_rec n1 m1 true true | Negz n1, Posz m1 => binomial_rec n1 m1 false true @@ -39,13 +37,13 @@ match n,m with | Negz n1, Negz m1 => binomial_rec n1 m1 false false end. -Definition binomialz := nosimpl binomialz_. +Arguments binomialz n m : simpl never. (* Eval compute in binomialz 5 3.*) (* Facts from the recursive code defining of binomialz. *) Fact binz0 (n : int) : binomialz n 0 = 1. -Proof. by case: n => n /=; rewrite /binomialz /binomialz_ /=. Qed. +Proof. by case: n => n. Qed. Fact binz_neg (n m : int) : m <= -1 -> binomialz n m = 0. Proof. by case: m => m //= _; case: n => n; case: m. Qed. @@ -91,7 +89,7 @@ Qed. (* Now we prove more (conditional) relations and values for binomialz *) -Lemma binz_nat_nat (n m : nat) : binomialz (Posz n) (Posz m) = 'C(n,m)%:~R. +Lemma binz_nat_nat (n m : nat) : binomialz (Posz n) (Posz m) = 'C(n,m)%:Q. Proof. elim: n m => [ | n Hn] [ | n0] //; rewrite -[in LHS](addn1 n) -[in LHS](addn1 n0). @@ -101,17 +99,21 @@ Qed. Lemma binzE (m n : nat) : (m <= n)%N -> binomialz (Posz n) (Posz m) = - (Posz n`!)%:~R / ((Posz m`!)%:~R * (Posz (n - m)`!)%:~R). + (Posz n`!)%:Q / ((Posz m`!)%:Q * (Posz (n - m)`!)%:Q). Proof. move=> hmn; rewrite binz_nat_nat; apply/eqP. -set denom := (X in _ / X). -have side : denom != 0. - by rewrite /denom -rmorphM pnatr_eq0 muln_eq0 negb_or -!lt0n !fact_gt0. -rewrite -(inj_eq (@mulIf _ denom _)) // divfK // /denom {side denom}. -by rewrite -!rmorphM -!PoszM /= bin_fact. +rewrite -(bin_fact hmn) !PoszM !rmorphM mulfK //=. +by apply/mulf_neq0; rewrite pnatr_eq0 lt0n_neq0 ?fact_gt0. Qed. -Lemma binz_on_diag (n : int) : binomialz n n = (n >= 0)%:~R. +Lemma binzE_ffact (m n : nat) : + binomialz (Posz n) (Posz m) = (Posz (n ^_ m))%:Q / (Posz m`!)%:Q. +Proof. +apply/eqP; rewrite binz_nat_nat -bin_ffact !PoszM !rmorphM mulfK //=. +by rewrite pnatr_eq0 lt0n_neq0 ?fact_gt0. +Qed. + +Lemma binz_on_diag (n : int) : binomialz n n = (n >= 0)%:Q. Proof. case: n => n; last by rewrite binz_neg. by rewrite binz_nat_nat // binn le0z_nat. @@ -129,8 +131,8 @@ wlog: m n / n <= 0. - rewrite binz_nat_nat bin_small //. rewrite -addrA -opprB opprK subzn // binz_nat_nat bin_small ?mulr0 //. by rewrite add1n subnSK // leq_subLR leq_addl. - - have {hnm} hnm : (Posz m) - (Posz n.+1) - 1 <= 0. - rewrite subr_le0 ler_subl_addl; apply: ler_trans hnm _. + - have {}hnm : (Posz m) - (Posz n.+1) - 1 <= 0. + rewrite subr_le0 ler_subl_addl; apply: le_trans hnm _. by rewrite ler_addl. rewrite [in RHS]hwlog //. rewrite opprB addrA addrAC -[Posz m + 1 - 1]addrA subrr addr0 opprB addrCA. @@ -155,37 +157,36 @@ Qed. (* First, three weak versions of the recurrences verified by binomialz, *) (* on a half plane only.*) Lemma binzSS_weak (n k : int) : n >= 0 -> k + 1 != 0 -> - binomialz (n + 1) (k + 1) = (n%:~R + 1) / (k%:~R + 1) * binomialz n k. + binomialz (n + 1) (k + 1) = (n%:Q + 1) / (k%:Q + 1) * binomialz n k. Proof. move=> hn hk; case: (lerP k (-1 - 1)) => hk1. rewrite binz_neg; last by rewrite -ler_subr_addr. - rewrite binz_neg; last by apply: ler_trans hk1 _. + rewrite binz_neg; last by apply: le_trans hk1 _. by rewrite mulr0. have {hk hk1}: k >= 0 by goal_to_lia; intlia. case: n hn => n //; case: k => k // _ _. rewrite mulrAC; apply/eqP. have -> m : Posz m + 1 = Posz m.+1 by rewrite -addn1 PoszD. -have h m : (Posz m)%:~R + 1 = (Posz m.+1)%:~R. - by rewrite -[X in _ + X]/(Posz 1)%:~R -rmorphD -PoszD addn1. +have h m : (Posz m)%:Q + 1 = (Posz m.+1)%:Q. + by rewrite -[X in _ + X]/(Posz 1)%:Q -rmorphD -PoszD addn1. rewrite !{}h eq_sym (can2_eq (divfK _) (mulfK _)) ?pnatr_eq0 //; apply/eqP. rewrite !binz_nat_nat -!rmorphM /= -!PoszM. by rewrite [(_ * _.+1)%N]mulnC addn1 mul_bin_diag. Qed. Lemma binzS_weak (n k : int) : n >= 0 -> k + 1 != 0 -> - binomialz n (k + 1) = (n%:~R - k%:~R) / (k%:~R + 1) * binomialz n k. + binomialz n (k + 1) = (n%:Q - k%:Q) / (k%:Q + 1) * binomialz n k. Proof. move=> hn hk; case: (lerP k (-1 - 1)) => hk1. rewrite binz_neg; last by rewrite -ler_subr_addr. - rewrite binz_neg; last by apply: ler_trans hk1 _. + rewrite binz_neg; last by apply: le_trans hk1 _. by rewrite mulr0. have {hk1 hk}: k >= 0 by goal_to_lia; intlia. case: n hn => n //; case: k => k // hn hk. -have -> : n%:~R - k%:~R = (n%:~R + 1) - (k%:~R + 1) :> rat. - rat_field. -rewrite -mulrA mulrBl !mulrA -binzSS_weak //; last by goal_to_lia; intlia. +have -> : n%:Q - k%:Q = (n%:Q + 1) - (k%:Q + 1) by rat_field. +rewrite -mulrA mulrBl !mulrA -binzSS_weak //; last by goal_to_lia; intlia. rewrite divff ?mul1r; last first. - by rewrite -[1]/(1%:~R) -rmorphD -PoszD pnatr_eq0 addn1. + by rewrite -[1]/(1%:Q) -rmorphD -PoszD pnatr_eq0 addn1. by apply/eqP; rewrite eq_sym subr_eq; apply/eqP; rewrite Pascal_z. Qed. @@ -194,18 +195,17 @@ Qed. (* only the non nullity of the denominator. *) Lemma binzSS (n k : int) : k + 1 != 0 -> -binomialz (n + 1) (k + 1) = (n%:~R + 1) / (k%:~R + 1) * binomialz n k. +binomialz (n + 1) (k + 1) = (n%:Q + 1) / (k%:Q + 1) * binomialz n k. Proof. case: (lerP 0 n); first exact: binzSS_weak. case: (lerP k (-1 - 1)) => hkN2. rewrite binz_neg; last by rewrite -ler_subr_addr. - rewrite binz_neg; last by apply: ler_trans hkN2 _. + rewrite binz_neg; last by apply: le_trans hkN2 _. by rewrite mulr0. move=> hn hk1. have {hkN2} hk : k >= 0 by goal_to_lia; intlia. rewrite [LHS]binNzz [in RHS]binNzz. -have -> : k + 1 - (n + 1) - 1 = k - n - 1. - by rewrite -![in LHS]addrA [1 + (_ + - 1)]addrCA subrr addr0 opprD addrA. +have -> : k + 1 - (n + 1) - 1 = k - n - 1 by intlia. rewrite binzS_weak //; last by goal_to_lia; intlia. rewrite !rmorphD !rmorphN /=; case: k hk1 hk => [k hk0 hk| //]. rewrite -[Posz k + 1]PoszD addn1 exprSzr. @@ -214,24 +214,23 @@ by rat_field; goal_to_lia; intlia. Qed. Lemma binzS (n k : int) : k + 1 != 0 -> - binomialz n (k + 1) = (n%:~R - k%:~R) / (k%:~R + 1) * binomialz n k. + binomialz n (k + 1) = (n%:Q - k%:Q) / (k%:Q + 1) * binomialz n k. Proof. move=> hk; case: (lerP k (-1 - 1)) => hk1. rewrite binz_neg; last by rewrite -ler_subr_addr. - rewrite binz_neg; last by apply: ler_trans hk1 _. + rewrite binz_neg; last by apply: le_trans hk1 _. by rewrite mulr0. -have -> : n%:~R - k%:~R = (n%:~R + 1) - (k%:~R + 1) :> rat. - rat_field. +have -> : n%:Q - k%:Q = (n%:Q + 1) - (k%:Q + 1) by rat_field. rewrite -mulrA mulrBl !mulrA -binzSS // divff ?mul1r; last first. - by rewrite -[1]/(1%:~R) -rmorphD /= intr_eq0. + by rewrite -[1]/(1%:Q) -rmorphD /= intr_eq0. by apply/eqP; rewrite eq_sym subr_eq; apply/eqP; rewrite Pascal_z. Qed. Lemma binSz (n k : int): (k != n + 1) -> - binomialz (n + 1) k = (n%:~R + 1) / (n%:~R + 1 - k%:~R) * binomialz n k. + binomialz (n + 1) k = (n%:Q + 1) / (n%:Q + 1 - k%:Q) * binomialz n k. Proof. move=> hkn; case: (altP (k =P 0)) hkn => [-> | hk0] hkn. - by rewrite !binz0 subr0 divff // -[1]/(1%:~R) -intrD intr_eq0 eq_sym. + by rewrite !binz0 subr0 divff // -[1]/(1%:Q) -intrD intr_eq0 eq_sym. have hk : k = (k - 1) + 1 by rewrite -addrA subrr addr0. rewrite hk binzSS; last by rewrite -hk. rewrite binzS; last by rewrite -hk. @@ -267,9 +266,8 @@ case: k ltnk => // k ltnk. elim: n ltnk nge0 => [ltnk _ | n HIn ltSnk lt0Sn]. by rewrite ltz_nat lt0n in ltnk; rewrite binz_nat_nat bin0n (negPf ltnk). rewrite -addn1 PoszD binSz ?HIn ?mulr0 //. - apply: (@ltr_trans _ (Posz n.+1)); first by rewrite ltz_nat ltnSn. - by rewrite ltSnk. -by rewrite neqr_lt -PoszD addn1 ltSnk orbT. + by rewrite ltz_nat ltnW. +by rewrite neq_lt -PoszD addn1 ltSnk orbT. Qed. @@ -278,49 +276,26 @@ Qed. Lemma binzSn (n : nat) (m : int) : binomialz (Posz n + 1) m = if m == Posz n + 1 then 1 - else ((Posz n)%:~R + 1) / ((Posz n)%:~R + 1 - m%:~R) * binomialz (Posz n) m. + else ((Posz n)%:Q + 1) / ((Posz n)%:Q + 1 - m%:Q) * binomialz (Posz n) m. Proof. case: ifP => [ | hnm]; first by move/eqP->; rewrite binz_on_diag. by apply: binSz; rewrite ?hnm. Qed. Lemma bin_nonneg (a b : int) : a >= 0 -> b >= 0 -> a >= b -> binomialz a b > 0. -Proof. -case: a => // n _. -case: b => // k _. -exact: binz_gt0. -Qed. +Proof. by case: a b => [] a [] b //= _ _; exact: binz_gt0. Qed. Lemma bin_int (a b : int) : a >= 0 -> b >= 0 -> - exists e : nat, binomialz a b = (Posz e)%:~R. + exists e : nat, binomialz a b = (Posz e)%:Q. Proof. -case: a => // n _. -case: b => // k _. -rewrite binz_nat_nat. -by exists 'C(n, k). +by case: a b => [] a [] b //= _ _; rewrite binz_nat_nat; exists 'C(a, b). Qed. Lemma bin_nonneg_int (a b : int) : a >= 0 -> b >= 0 -> a >= b -> - exists e : int, binomialz a b = e%:~R /\ e > 0. + exists e : int, binomialz a b = e%:Q /\ e > 0. Proof. -move=> ha hb hab. -set m := binomialz a b. -have : m > 0 by apply: bin_nonneg; intlia. -have : exists n : nat, m = (Posz n)%:~R by apply: bin_int; intlia. -case=> n m_is_n. -have {m_is_n} n_is_m : n%:~R = m by rewrite m_is_n. -rewrite -n_is_m. -set j := Posz n => pos_j. -exists j. -split => //. -have : j <> 0. - rewrite /not => j_eq_0. - move: pos_j. - by rewrite j_eq_0. -move=> {pos_j} j_neq_0. -have : j >= 0 by rewrite /j. -move=> nonneg_j. -intlia. +case: a b => [] a [] b //= _ _ leba. +by exists (Posz 'C(a, b)); rewrite binz_nat_nat [_ < _]bin_gt0. Qed. @@ -332,14 +307,14 @@ Proof. apply/idP/idP=> h. case: (ltrP k 0) => //= hk. - case: (lerP 0 n) => /= hn. - apply: contraLR h; rewrite -lerNgt; move/(bin_nonneg hn hk). + apply: contraLR h; rewrite -leNgt; move/(bin_nonneg hn hk). by rewrite lt0r; case/andP. apply: contraLR h => _. rewrite binNzz; apply: mulf_neq0; first by rewrite expfz_eq0 andbF. suff: binomialz (k - n - 1) k > 0 by rewrite lt0r; case/andP. - have hnk : k <= k - n - 1 by goal_to_lia; intlia. - by apply: bin_nonneg => //; apply: ler_trans hnk. -case/orP: h => [h | /andP [h1 h2]]; apply/eqP; first by apply: binz_neg; intlia. + have hnk : k <= k - n - 1 by intlia. + by apply: bin_nonneg => //; apply: le_trans hnk. +case/orP: h => [h | /andP [h1 h2]]; apply/eqP; first by apply: binz_neg. exact: binz_geq. Qed. @@ -352,6 +327,8 @@ Qed. (************* Experimental, old, unsed stuff below this ************) +Module SignedFfact. + (* Experiments around the falling factorial function *) Fixpoint ffact_rec (n : int) (m : nat) := if m is m'.+1 then n * ffact_rec (n - 1) m' else 1. @@ -402,11 +379,13 @@ Qed. Lemma ffact_small (n m : nat) : Posz n < Posz m -> n ^_ m = 0. Proof. -move=> hnm; apply/eqP; rewrite eqr_le ffact_ge0 // lerNgt ffact_gt0 //. -by rewrite -ltrNge andbT. +move=> hnm; apply/eqP; rewrite eq_le ffact_ge0 // leNgt ffact_gt0 //. +by rewrite -ltNge andbT. Qed. Lemma ffactnn (n : nat) : (Posz n) ^_ n = Posz n`!. Proof. by elim : n => [ | n Hn] //; rewrite ffactnS factS subzn // subn1 Hn PoszM. Qed. + +End SignedFfact. diff --git a/theories/c_props.v b/theories/c_props.v index a2b8aad..0fc6dc3 100644 --- a/theories/c_props.v +++ b/theories/c_props.v @@ -7,17 +7,16 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (**** Properties of the sequence c ****) Fact lt_0_c (i j : int) : 0 <= j <= i -> 0 < c i j. Proof. -case/andP=> h0j hji; rewrite /c -expfzMl; apply: exprz_gt0. -by apply: mulr_gt0; apply: binz_gt0 => //; goal_to_lia; intlia. +case/andP=> h0j hji; rewrite /c -expfzMl. +by apply/exprz_gt0/mulr_gt0; apply/binz_gt0; intlia. Qed. (* c is monotonic wrt its first argument *) @@ -28,4 +27,3 @@ case: n => // n _; case: i => // i _ lein; case: m => // m lenm; rewrite /c. rewrite -!PoszD !binz_nat_nat -!expfzMl -!rmorphM /= !exprz_pintl // ler_nat. by apply: leq_mul; apply: leq_mul; apply: leq_bin2l => //; rewrite leq_add2r. Qed. - diff --git a/theories/extra_cauchyreals.v b/theories/extra_cauchyreals.v index fa6f407..22b4b65 100644 --- a/theories/extra_cauchyreals.v +++ b/theories/extra_cauchyreals.v @@ -7,18 +7,14 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. -Import BigEnough. +Import Order.TTheory GRing.Theory Num.Theory BigEnough. -Open Scope ring_scope. +Local Open Scope ring_scope. Section ExtraCreals. Variable F : realFieldType. -Local Open Scope ring_scope. - Lemma eq_creal_ext (x y : creal F) : x =1 y -> (x == y)%CR. Proof. move=> heq; apply/eq_crealP; exists (fun _ => 0%N) => * /=. @@ -68,8 +64,8 @@ move=> ltxy lt0z; pose_big_enough i. apply: (@lt_crealP _ ((diff ltxy) * (diff lt0z)) i i) => //=. - apply: mulr_gt0; exact: diff_gt0. rewrite -ler_sub_addl -mulrBl; apply: ler_pmul. - - by apply: ltrW; apply: diff_gt0. - - by apply: ltrW; apply: diff_gt0. + - by apply: ltW; apply: diff_gt0. + - by apply: ltW; apply: diff_gt0. - by rewrite ler_sub_addl diffP. - by rewrite -[X in X <= _]add0r -[0]/((0%:CR)%CR i) diffP. by close. @@ -121,8 +117,8 @@ move=> lt_0x lt_0y; pose_big_enough i. apply: (@lt_crealP _ ((diff lt_0x) * (diff lt_0y)) i i) => //=. - apply: mulr_gt0; exact: diff_gt0. rewrite add0r; apply: ler_pmul. - - by apply: ltrW; apply: diff_gt0. - - by apply: ltrW; apply: diff_gt0. + - by apply: ltW; apply: diff_gt0. + - by apply: ltW; apply: diff_gt0. - by rewrite -[X in X <= _]add0r -[0]/((0%:CR)%CR i) diffP. - by rewrite -[X in X <= _]add0r -[0]/((0%:CR)%CR i) diffP. by close. @@ -143,14 +139,14 @@ Proof. by apply: eq_creal_ext=> i /=. Qed. Lemma le_ubound (x : creal F) : (x <= (ubound x)%:CR)%CR. Proof. apply: (@le_crealP _ 0%N) => j _ /=. -apply: ler_trans (uboundP x j); exact: ler_norm. +apply: le_trans (uboundP x j); exact: ler_norm. Qed. Lemma lt_ubound (x : creal F) : (x < (ubound x + 1)%:CR)%CR. Proof. pose_big_enough i. apply: (@lt_crealP _ 1 i i) => //=; rewrite ler_add2r. - apply: ler_trans (uboundP x i); exact: ler_norm. + apply: le_trans (uboundP x i); exact: ler_norm. by close. Qed. @@ -164,7 +160,7 @@ move=> ltxy leyz; pose_big_enough i. apply/eqP; rewrite eq_sym subr_eq -addrA -mulrDr. have <- : 1 = 2%:~R^-1 + 2%:~R^-1 :> F by rewrite [LHS](splitf 2) div1r. by rewrite mulr1. - rewrite ler_subl_addr; apply: ler_trans (diffP _ _) _ => //; apply: ltrW. + rewrite ler_subl_addr; apply: le_trans (diffP _ _) _ => //; apply: ltW. by apply: le_modP. by close. Qed. @@ -177,9 +173,9 @@ move=> lexy ltyz; pose_big_enough i. have hpos : 0 < diff ltyz / 2%:~R. apply: divr_gt0; rewrite ?ltr0Sn //; exact: diff_gt0. apply: (@lt_crealP _ ((diff ltyz) / 2%:~R) i i) => //=. - apply: ler_trans (@diffP _ _ _ ltyz _ _ _) => //; rewrite -ler_subr_addr. + apply: le_trans (@diffP _ _ _ ltyz _ _ _) => //; rewrite -ler_subr_addr. suff <- : y i + diff ltyz / 2%:~R = y i + diff ltyz - diff ltyz / 2%:~R. - by apply: ltrW; apply: le_modP. + by apply: ltW; apply: le_modP. apply/eqP; rewrite eq_sym subr_eq -addrA -mulrDr. have <- : 1 = 2%:~R^-1 + 2%:~R^-1 :> F by rewrite [LHS](splitf 2) div1r. by rewrite mulr1. @@ -196,7 +192,7 @@ Lemma lecr_mulf2r (z : F) (x y : creal F) : (x <= y)%CR -> 0 <= z -> (x * z%:CR <= y * z%:CR)%CR. Proof. move=> lexy. -rewrite ler_eqVlt; case/orP=> [/eqP <- | lt0z]; first by rewrite !mul_creal0. +rewrite le_eqVlt; case/orP=> [/eqP <- | lt0z]; first by rewrite !mul_creal0. move => h; apply: lexy. have aux t : (t == t * z%:CR * z^-1%:CR)%CR. rewrite -mulcrA -cst_crealM mulfV ?mul_creal1 //; move: lt0z; rewrite lt0r. @@ -239,9 +235,9 @@ exists_big_modulus m F. rewrite /d [(_ - _) + _]addrC addrA addrNK opprB addrA [_ - x i]addrC. by rewrite addrA addKr addrC. suff step1 : `|d j + (x i - x j)| + `|d i| < eps. - by apply: ler_lt_trans step1; rewrite -[`|d i|]normrN; apply: ler_norm_add. + by apply: le_lt_trans step1; rewrite -[`|d i|]normrN; apply: ler_norm_add. suff step2 : `|d j| + `|x i - x j| + `|d i| < eps. - by apply: ler_lt_trans step2; rewrite ler_add2r; apply: ler_norm_add. + by apply: le_lt_trans step2; rewrite ler_add2r; apply: ler_norm_add. have -> : eps = eps / 3%:~R + eps / 3%:~R + eps / 3%:~R. rewrite /= in eps lt_eps_0 hmi hmj *. rewrite -!mulrDl -[in X in _ = X](mulr1 eps) -!mulrDr -mulrA. diff --git a/theories/extra_mathcomp.v b/theories/extra_mathcomp.v index cfd3397..9af73a3 100644 --- a/theories/extra_mathcomp.v +++ b/theories/extra_mathcomp.v @@ -1,7 +1,4 @@ -From mathcomp Require Import all_ssreflect all_algebra. -(* Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path div choice. *) -(* Require Import fintype tuple finfun bigop prime finset binomial. *) -(* Require Import ssralg ssrnum ssrint intdiv rat. *) +From mathcomp Require Import all_ssreflect all_algebra all_field. From mathcomp Require Import bigenough. @@ -9,121 +6,129 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. -Import BigEnough. +Import Order.TTheory GRing.Theory Num.Theory BigEnough. -Open Scope ring_scope. +Section ExtraBinomial. -Section AlgCMissing. - -Lemma ler1q (F : numFieldType) x: (1 <= ratr x :> F) = (1 <= x). -Proof. by rewrite (_ : 1 = ratr 1) ?ler_rat ?rmorph1. Qed. - -Lemma lerq1 (F : numFieldType) x: (ratr x <= 1 :> F) = (x <= 1). -Proof. by rewrite (_ : 1 = ratr 1) ?ler_rat ?rmorph1. Qed. - -Lemma ltrq1 (F : numFieldType) x: (ratr x < 1 :> F) = (x < 1). -Proof. by rewrite (_ : 1 = ratr 1) ?ltr_rat ?rmorph1. Qed. - -Lemma ltr1q (F : numFieldType) x: (1 < ratr x :> F) = (1 < x). -Proof. by rewrite (_ : 1 = ratr 1) ?ltr_rat ?rmorph1. Qed. +Lemma ffact_le_expn m p : p ^_ m <= p ^ m. +Proof. +elim: m p => [|m IHm] p //. +by rewrite ffactnSr expnSr; apply/leq_mul/leq_subr/IHm. +Qed. -End AlgCMissing. +End ExtraBinomial. -(* FIXME : are these lemmas missing in MathComp? *) +Section ExtraPrime. -(* Suggestions for alternative statements of lemmas in big_op: *) -Section AltBigOp. +Lemma lognn p (Hp : prime p) : logn p p = 1. +Proof. exact: pfactorK 1 Hp. Qed. -Variables (R : Type) (idx : R) (op : Monoid.law idx). +Lemma partp_dvdn p (Hprime : prime p) n m : + (0 < n) -> (p ^ m %| n) -> p ^ m %| n`_p . +Proof. by move => Hn Hdiv; rewrite -(pfactorK m Hprime) -p_part partn_dvd. Qed. -Lemma big_nat_recr_alt (n m : nat) (F : nat -> R) : (m <= n)%N -> -\big[op/idx]_(m <= i < n.+1) F i = op (\big[op/idx]_(m <= i < n) F i) (F n). -Proof. by move=> lemn; rewrite (@big_cat_nat _ _ _ n) //= big_nat1. Qed. +Lemma trunc_logn0 n : trunc_log n 0%N = 0%N. Proof. by case: n => // [] []. Qed. -Lemma big_nat_recl_alt (n m : nat) (F : nat -> R) : (m <= n)%N -> - \big[op/idx]_(m <= i < n.+1) F i = - op (F m) (\big[op/idx]_(m <= i < n) F i.+1). -Proof. by move=> lemn; rewrite big_ltn // big_add1. Qed. +(* See also inlined stuff in proof of Lemma 2. *) -End AltBigOp. +End ExtraPrime. -Section ExtraInt. +Local Open Scope ring_scope. -Lemma expfV (R : idomainType) (x : R) (i : int) : (x ^ i) ^-1 = (x ^-1) ^ i. -Proof. by rewrite invr_expz exprz_inv. Qed. +Section ExtraSsrNum. -End ExtraInt. +Implicit Types (R : numDomainType) (F : numFieldType). +Lemma ltr_neq R (x y : R) : x < y -> x != y. +Proof. by case: comparableP. Qed. -Section ExtraRat. +Lemma ltr_pmul_le_l R (x1 y1 x2 y2 : R) : + 0 < x1 -> 0 < x2 -> x1 <= y1 -> x2 < y2 -> x1 * x2 < y1 * y2. +Proof. +rewrite le_eqVlt => posx1 posx2 /predU1P[<-|lt1] lt2. + by rewrite ltr_pmul2l. +by apply: ltr_pmul=> //; exact: ltW. +Qed. -(* Two technical lemmas about rationals that are integers *) -(* FIXME: They could be turned into equivalences although this is not needed*) -(* here. We do not do this to avoid a side condition on d != 0, and because*) -(* the other direction seems less usefull *) -Lemma Qint_dvdz (m d : int) : (d %| m)%Z -> ((m%:~R / d%:~R : rat) \is a Qint). +Lemma ltr_pmul_le_r R (x1 y1 x2 y2 : R) : + 0 < x1 -> 0 < x2 -> x1 < y1 -> x2 <= y2 -> x1 * x2 < y1 * y2. Proof. -case/dvdzP=> z ->; rewrite rmorphM /=; case: (altP (d =P 0)) => [->|dn0]. - by rewrite mulr0 mul0r. -by rewrite mulfK ?intr_eq0 // rpred_int. +move=> Hx1 Hx2 Hx1y1 Hx2y2; rewrite mulrC [y1*y2]mulrC; exact: ltr_pmul_le_l. Qed. -Lemma Qnat_dvd (m d : nat) : (d %| m)%N -> ((m%:R / d%:R : rat) \is a Qnat). +Lemma exp_incr_expp R (x : R) (H1x : 1 <= x) (m n : nat) : + (m <= n)%N -> x ^+ m <= x ^+ n. Proof. -move=> h; rewrite Qnat_def divr_ge0 ?ler0n // -[m%:R]/(m%:~R) -[d%:R]/(d%:~R). -by rewrite Qint_dvdz. +move/subnK => <-; rewrite exprD. +exact/ler_pemull/exprn_ege1/H1x/exprn_ge0/le_trans/H1x. Qed. -Lemma denqVz (i : int) : i != 0 -> denq (i%:~R^-1) = `|i|. +Lemma exp_incr_expn R (x : R) (H1x : 0 < x < 1) (m n : nat) : + (n <= m)%N -> x ^+ m <= x ^+ n. Proof. -by move=> h; rewrite -div1r -[1]/(1%:~R) coprimeq_den /= ?coprime1n // (negPf h). +case/andP: H1x => lt0x ltx1 /subnK <-; rewrite exprD. +exact/ler_pimull/exprn_ile1/ltW/ltx1/ltW/lt0x/exprn_ge0/ltW. Qed. -End ExtraRat. +Lemma ler1q F x: (1 <= ratr x :> F) = (1 <= x). +Proof. by rewrite (_ : 1 = ratr 1) ?ler_rat ?rmorph1. Qed. -Section ExtraSsrNum. +Lemma lerq1 F x: (ratr x <= 1 :> F) = (x <= 1). +Proof. by rewrite (_ : 1 = ratr 1) ?ler_rat ?rmorph1. Qed. -Variable R : numDomainType. +Lemma ltrq1 F x: (ratr x < 1 :> F) = (x < 1). +Proof. by rewrite (_ : 1 = ratr 1) ?ltr_rat ?rmorph1. Qed. -Lemma ler1z (n : int) : (1 <= n%:~R :> R) = (1 <= n). -Proof. by rewrite -[1]/(1%:~R) ler_int. Qed. +Lemma ltr1q F x: (1 < ratr x :> F) = (1 < x). +Proof. by rewrite (_ : 1 = ratr 1) ?ltr_rat ?rmorph1. Qed. -Lemma ltr1z (n : int) : (1 < n%:~R :> R) = (1 < n). -Proof. by rewrite -[1]/(1%:~R) ltr_int. Qed. +End ExtraSsrNum. -Lemma ltr_neq (x y : R) : x < y -> x != y. -Proof. by rewrite ltr_def eq_sym; case/andP. Qed. +Section ExtraAlgC. -Lemma lt0r_neq0 (x : R) : 0 < x -> x != 0. -Proof. by move => ?; rewrite eq_sym ltr_neq. Qed. +Implicit Types x y z : algC. -Lemma ltr0_neq0 (x : R) : x < 0 -> x != 0. -Proof. by move => Hx; rewrite ltr_neq. Qed. +Lemma root_le_x (n : nat) x y : + (0 < n)%N -> 0 <= x -> 0 <= y -> (n.-root x <= y) = (x <= y ^+ n). +Proof. +move => Hn Hx Hy. +have ->: (x <= y ^+ n) = (n.-root x ^+ n <= y ^+ n) by rewrite rootCK. +by rewrite ler_pexpn2r // nnegrE rootC_ge0. +Qed. -Lemma expN1r (i : int) : (-1 : R) ^ i = (-1) ^+ `|i|. +Lemma root_x_le (n : nat) x y : + (0 < n)%N -> 0 <= x -> 0 <= y -> (x <= n.-root y) = (x ^+ n <= y). Proof. -case: i => n; first by rewrite exprnP absz_nat. -by rewrite NegzE abszN absz_nat -invr_expz expfV invrN1. +move => Hn Hx Hy. +have ->: (x ^+ n <= y) = (x ^+ n <= n.-root y ^+ n) by rewrite rootCK. +by rewrite ler_pexpn2r // nnegrE rootC_ge0. Qed. -Lemma ltr_prod (E1 E2 : nat -> R) (n m : nat) : - (m < n)%N -> (forall i, (m <= i < n)%N -> 0 <= E1 i < E2 i) -> - \prod_(m <= i < n) E1 i < \prod_(m <= i < n) E2 i. +Lemma rootC_leq (m n : nat) x : + 1 <= x -> (0 < n)%N -> (n <= m)%N -> m.-root x <= n.-root x. Proof. -elim: n m => // n ihn m; rewrite ltnS leq_eqVlt; case/orP => [/eqP -> | ltnm hE]. - by move/(_ n) => /andb_idr; rewrite !big_nat1 leqnn ltnSn /=; case/andP. -rewrite big_nat_recr_alt ?[X in _ < X]big_nat_recr_alt ?leqW //=. -move/andb_idr: (hE n); rewrite leqnn ltnW //=; case/andP => h1n h12n. -rewrite big_nat_cond [X in _ < X * _]big_nat_cond; apply: ltr_pmul => //=. -- apply: prodr_ge0 => i; rewrite andbT; case/andP=> hm hn. - by move/andb_idr: (hE i); rewrite hm /= ltnS ltnW //=; case/andP. -rewrite -!big_nat_cond; apply: ihn => // i /andP [hm hn]; apply: hE. -by rewrite hm ltnW. +move=> Hx Hn Hmn. +have x_ge0 : 0 <= x by apply: le_trans Hx. +rewrite root_le_x -?rootCX ?root_x_le ?exprn_ge0 //; first exact: exp_incr_expp. +by rewrite expr0n; case: eqP. Qed. -End ExtraSsrNum. +(* Not sure if actually needed in library, but this lemma is helpful +to prove one_plus_invx_expx below *) +Lemma le_mrootn_n (m n : nat) : m.+1.-root n.+1%:R <= n.+1%:R :> algC. +Proof. by rewrite root_le_x ?ler_eexpr // (ler0n, ler1n). Qed. + +Lemma prod_root m n x : (0 < m)%N -> (0 < n)%N -> 0 <= x -> + (m * n)%N.-root x = m.-root (n.-root x). +Proof. +move => Hm Hn Hx. +have Hmnpos : (0 < m * n)%N by rewrite muln_gt0 Hm Hn. +suff: ((m * n).-root x) ^+ (m*n)%N = (m.-root (n.-root x)) ^+ (m * n)%N. + by apply: pexpIrn; rewrite // nnegrE ?rootC_ge0 //. +by rewrite rootCK // exprM rootCK // rootCK. +Qed. + +End ExtraAlgC. (*** Two lemmas about geometric sequences. We just use the second one. ***) Section ExtraGeom. @@ -132,35 +137,29 @@ Section ExtraGeom. (* The proof uses bigenough so that's not strictly in MathComp, but *) (* as usual we could eliminate the pose_big_enough a posteriori. *) Lemma Gseqgt1 (r : rat)(E : rat) : 0 <= E -> 1 < r -> - exists N : nat, forall n : nat, (N <= n)%nat -> E < r ^ n. + exists N : nat, forall n : nat, (N <= n)%N -> E < r ^ n. Proof. move=> ge0E lt1r. pose_big_enough M. exists M => k hMk. - have le1r : 1 <= r by rewrite ltrW. - have {lt1r} lt1r : 0 < r - 1 by rewrite subr_gt0. - suff aux (n : nat) : n%:~R * (r - 1) - 1 <= r ^ n. - apply: ltr_le_trans (aux k); rewrite -ltr_sub_addr opprK -ltr_pdivr_mulr //. - have h : 0 <= (E + 1) / (r - 1). - apply: divr_ge0; by [exact: addr_ge0 | exact: ltrW]. - by apply: ltr_trans (archi_boundP h) _; rewrite ltr_nat. - elim: n => [|n ihn]; first by rewrite mul0r add0r expr0z. - have -> : n.+1%:~R * (r - 1) - 1 = n%:~R * (r - 1) - 1 + (r - 1). - by rewrite -addn1 PoszD rmorphD /= mulrDl mul1r addrAC. - have -> : r ^ n.+1 = r ^ n + (r ^ n.+1 - r ^ n) by rewrite addrCA addrN addr0. - apply: ler_add => //. - have -> : r ^ n.+1 - r ^ n = r ^ n * (r - 1). - by rewrite mulrDr mulrN mulr1 -exprnP exprSr. - case: n {ihn} => [| n ]; first by rewrite mul1r. - rewrite ler_pmull // -exprnP expr_ge1 //; exact: ler_trans le1r. + have le1r : 1 <= r by rewrite ltW. + have {}lt1r : 0 < r - 1 by rewrite subr_gt0. + suff aux (n : nat) : n%:Q * (r - 1) - 1 <= r ^ n. + apply: lt_le_trans (aux k); rewrite -ltr_sub_addr opprK -ltr_pdivr_mulr //. + have: 0 <= (E + 1) / (r - 1) by apply/divr_ge0/ltW/lt1r/addr_ge0. + by move/archi_boundP/lt_trans; apply; rewrite ltr_nat. + rewrite -pmulrn /exprz; elim: n => [|n ihn]; first by rewrite mul0r. + rewrite mulrSr mulrDl mul1r addrAC -ler_subr_addr; apply: le_trans ihn _. + rewrite exprSr -[r - 1]mul1r -[r in _ * r](subrK 1) mulrDr mulr1 addrAC. + by rewrite -mulrBl ler_addr pmulr_lge0 // subr_ge0 exprn_ege1. by close. Qed. Lemma Gseqlt1 (r : rat)(eps : rat) : 0 < eps -> 0 < r < 1 -> - exists N : nat, forall n : nat, (N <= n)%nat -> r ^ n < eps. + exists N : nat, forall n : nat, (N <= n)%N -> r ^ n < eps. Proof. move=> ge0eps /andP [lt0r ltr1]. -have hE : 0 <= eps ^-1 by apply/ltrW; rewrite invr_gt0. +have hE : 0 <= eps ^-1 by apply/ltW; rewrite invr_gt0. have hr : 1 < r ^-1 by rewrite invf_gt1. have [M hM] := Gseqgt1 hE hr; exists M => n hMn. rewrite -ltf_pinv //; first by rewrite invr_expz -exprz_inv; exact: hM. @@ -177,32 +176,28 @@ Variable R : zmodType. Lemma telescope_nat (a b : nat) (f : nat -> R) : (a <= b)%N -> \sum_(a <= k < b) (f (k + 1)%N - f k) = f b - f a. Proof. -rewrite -{2}[a]add0n big_addn; elim: b => [ | b ihb]. - by rewrite leqn0=> /eqP ->; rewrite subrr subnn big_mkord big_ord0. -rewrite leq_eqVlt; case/orP=> [/eqP -> | a_lt_b1]. - by rewrite subnn subrr big_geq. -rewrite subSn ?big_nat_recr //= ihb ?subnK // addn1 addrC -addrA [- _ + _]addrA. -by rewrite addNr sub0r. +rewrite leq_eqVlt => /predU1P[->|]; first by rewrite big_geq // subrr. +case: b => // b; rewrite ltnS => leab. +rewrite big_split sumrN big_nat_recr //= addn1 [_ + f _]addrC big_nat_recl //=. +rewrite opprD addrACA -[RHS]addr0; congr (_ + _). +by rewrite -sumrN -big_split big1 => //= i _; rewrite addn1 subrr. Qed. End Telescope. - Section TelescopeProd. Variable R : fieldType. Lemma telescope_prod_nat (a b : nat) (f : nat -> R) : - (forall k, (a <= k < b)%N -> f k != 0) -> (a < b)%N -> + (forall k, (a <= k < b)%N -> f k != 0) -> (a < b)%N -> \prod_(a <= k < b) (f (k + 1)%N / f k) = f b / f a. Proof. -move=> hf; rewrite -{2}[a]add0n big_addn; elim: b hf => [ | b ihb] hf //. -rewrite ltnS leq_eqVlt; case/orP=> [/eqP -> | a_lt_b1]. - by rewrite subSn // subnn big_nat_recr //= big_nil mul1r add0n addn1. -rewrite subSn ?big_nat_recr //= ihb ?subnK //; last first. - by move=> k /andP [hak hkb]; apply: hf; rewrite hak ltnS ltnW. -rewrite addn1 -!mulrA mulrC -!mulrA mulVf; first by rewrite mulr1 mulrC. -by apply: hf; rewrite ltnW //=. +case: b => // b hf; rewrite ltnS => leab. +rewrite big_split prodfV big_nat_recr //= addn1 [_ * f b.+1]mulrC. +rewrite big_nat_recl //= invfM mulrACA -[RHS]mulr1; congr (_ * _). +rewrite -prodfV -big_split big_nat_cond big1 => //= i /andP[/andP[leai ltib] _]. +by rewrite addn1 divff ?hf // ltnS ltib leqW. Qed. End TelescopeProd. @@ -212,10 +207,10 @@ Section ExtraZip. Variables S T : Type. -Lemma zip_nil_l (t : seq T) : zip ([::] : seq S) t = [::]. +Lemma zip_nil_l (t : seq T) : zip [::] t = [::] :> seq (S * T). Proof. by case: t. Qed. -Lemma zip_nil_r (s : seq S) : zip s ([::] : seq T) = [::]. +Lemma zip_nil_r (s : seq S) : zip s [::] = [::] :> seq (S * T). Proof. by case: s. Qed. End ExtraZip. @@ -239,12 +234,3 @@ by case: ifP=> //; rewrite Monoid.mulm1. Qed. End ExtraBigOp. - -Section ExtraTruncLog. - -Local Open Scope nat_scope. - -Lemma trunc_logn0 n : trunc_log n 0 = 0. Proof. by case: n => // [] []. Qed. - -(* See also inlined stuff in proof of Lemma 2. *) -End ExtraTruncLog. diff --git a/theories/field_tactics.v b/theories/field_tactics.v index 94ed433..994be37 100644 --- a/theories/field_tactics.v +++ b/theories/field_tactics.v @@ -219,11 +219,11 @@ prefield; patch_incomplete_field; repeat catch_embedded; field; -rewrite ?rat_of_ZEdef /=. +rewrite ?rat_of_ZEdef. Ltac rat_field_simplify := prefield; patch_incomplete_field; repeat catch_embedded; field_simplify; -rewrite ?rat_of_ZEdef /=. +rewrite ?rat_of_ZEdef. diff --git a/theories/floor.v b/theories/floor.v index f4d307e..c84bca7 100644 --- a/theories/floor.v +++ b/theories/floor.v @@ -1,163 +1,66 @@ From mathcomp Require Import all_ssreflect all_algebra. -Require Import field_tactics. -Require Import bigopz. -Require Import lia_tactics conj. -Require Import shift. - Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* reminder: Posz k = k, Negz k = (-(k+1)) *) Definition floorQ (r : rat) := (numq r %/ denq r)%Z. -Lemma floorQ_spec (r : rat) : ((floorQ r)%:Q <= r < (floorQ r)%:Q + 1)%Q. +Lemma floorQ_spec (r : rat) : (floorQ r)%:Q <= r < (floorQ r)%:Q + 1. Proof. -set p := numq r. -set q := denq r. -have Hfloor_r : floorQ r = (p %/ q)%Z by []. -have Hrpq : r = p%:Q / q%:Q by rewrite -[r]divq_num_den. -have EqEuclid : p = (p %/ q)%Z * q + (p %% q)%Z by apply: divz_eq. -have qnot0 : q%:Q != 0 by rewrite intq_eq0; apply: denq_neq0. -have qgt0 : 0 < q by exact: denq_gt0. -have qrge0 : 0 <= q%:~R :> rat by rewrite ler0z ?ltrW. -have EqEuclidQ : r = (p %/ q)%Z%:Q + ((p %% q)%Z%:Q / q%:Q) . - apply: (mulIf qnot0); set rq := q%:~R. - by rewrite mulrDl Hrpq !(mulfVK qnot0) /rq -rmorphM /= -rmorphD /= -EqEuclid. -rewrite Hfloor_r EqEuclidQ. -apply/andP; split. - - by rewrite cpr_add divr_ge0 // ler0z; apply: modz_ge0; exact: denq_neq0. - - by rewrite ltr_add2l ltr_pdivr_mulr ?ltr0z // mul1r ltr_int ltz_pmod. +rewrite -[r in _ <= r < _]divq_num_den ler_pdivl_mulr ?ltr_pdivr_mulr ?ltr0z //. +by rewrite -rat1 -intrD -!intrM ler_int ltr_int lez_floor ?ltz_ceil. Qed. +Lemma floorQ_epslt1 (r : rat) : 0 <= r - (floorQ r)%:Q < 1. +Proof. by rewrite subr_ge0 ltr_subl_addl floorQ_spec. Qed. -Lemma floorQ_epslt1 (r : rat) : 0 <= (r - (floorQ r)%:Q)%Q < 1. -Proof. -apply/andP. -have := (floorQ_spec r). -case/andP. -split. - by rewrite lter_sub_addr add0r. -by rewrite lter_sub_addr addrC. -Qed. - -Lemma floorQ_grows (r1 r2 : rat) : (r1 <= r2) -> floorQ r1 <= floorQ r2. +Lemma floorQ_grows (r1 r2 : rat) : r1 <= r2 -> floorQ r1 <= floorQ r2. Proof. move => Hr12. -rewrite -ltz_addr1. -suff: (floorQ r1)%:Q < (floorQ r2 + 1)%:Q by rewrite ltr_int. -have Hle12 : (floorQ r1)%:Q <= r2. - have Hle1 : (floorQ r1)%:Q <= r1 by case/andP: (floorQ_spec r1). - by apply: (ler_trans Hle1). -apply: (ler_lt_trans Hle12). -by rewrite intrD; case/andP: (floorQ_spec r2). +suff: (floorQ r1)%:Q < (floorQ r2 + 1)%:Q by rewrite ltr_int ltz_addr1. +rewrite intrD; case/andP: (floorQ_spec r2) => _; apply: le_lt_trans. +by apply: le_trans Hr12; case/andP: (floorQ_spec r1). Qed. Lemma floorQ_unique (r : rat) (m : int) : m%:Q <= r < (m + 1)%:Q -> m = floorQ r. Proof. -have HfloorQ := (floorQ_spec r). -move => H. -apply/eqP; rewrite eqr_le; apply/andP; split. -- suff: m%:Q < ((floorQ r) + 1)%:Q by rewrite ltr_int ltz_addr1. - have Hlemr : m%:Q <= r by case/andP: H. - apply: (ler_lt_trans Hlemr); by case/andP: HfloorQ; rewrite intrD. -- rewrite -ltz_addr1. - have Hleflm : (floorQ r)%:Q <= r by case/andP: HfloorQ. - suff: (floorQ r)%:Q < (m + 1)%:Q by rewrite ltr_int. - apply: (ler_lt_trans Hleflm). - by case/andP: H. +have /andP[Hfloor1 Hfloor2] := floorQ_spec r. +case/andP => Hm1 Hm2. +move: (le_lt_trans Hm1 Hfloor2) (le_lt_trans Hfloor1 Hm2). +rewrite -[n in _ + n]rat1 -intrD !ltr_int !ltz_addr1 => ? ?. +by apply/eqP; rewrite eq_le; apply/andP. Qed. Lemma floorQ_int (m : int) : m = floorQ m%:Q. -Proof. -apply: floorQ_unique; apply/andP; split => // . -by rewrite ltr_int ltz_addr1. -Qed. +Proof. by apply: floorQ_unique; rewrite ltr_int ltz_addr1 !lexx. Qed. -Lemma floorQ_ge0 (r : rat) : (0 <= r) -> 0 <= floorQ r. -Proof. -move => Hrge0. -have -> : 0 = floorQ (0%:Z%:Q). - by rewrite -floorQ_int. -exact: floorQ_grows. -Qed. +Lemma floorQ_ge0 (r : rat) : 0 <= r -> 0 <= floorQ r. +Proof. by move=> Hrge0; rewrite [0]floorQ_int floorQ_grows. Qed. -Lemma floorQ_ge1 (r : rat) : (1 <= r) -> 1 <= floorQ r. -Proof. -move => Hrge0. -have -> : 1 = floorQ (1%:Z%:Q). - by rewrite -floorQ_int. -exact: floorQ_grows. -Qed. +Lemma floorQ_ge1 (r : rat) : 1 <= r -> 1 <= floorQ r. +Proof. by move=> Hrge0; rewrite [1]floorQ_int floorQ_grows. Qed. -Lemma floor_addEpsilon (m : int) (epsilon : rat) : (0 <= epsilon < 1) -> floorQ (m%:Q + epsilon) = m. +Lemma floor_addEpsilon (m : int) (epsilon : rat) : + 0 <= epsilon < 1 -> floorQ (m%:Q + epsilon) = m. Proof. -move => Heps; symmetry. -apply: floorQ_unique. -apply/andP; split. -rewrite ler_addl. -by case/andP: Heps. -rewrite intrD. -rewrite ltr_add2l. -by case/andP: Heps. +move=> /andP[Heps1 Heps2]. +by apply/esym/floorQ_unique; rewrite ler_addl Heps1 intrD ltr_add2l. Qed. -Lemma floorQ_div (q : rat) (m : nat) : floorQ (q / m.+1%:Q) = floorQ ((floorQ q)%:Q / m.+1%:Q). -have usedAlot : m.+1%:Q != 0 by rewrite intq_eq0. -have usedALot1 : 0 < m.+1%:Q by rewrite -rat0 ltr_int // . -have usedALot2 : 0 <= m.+1%:Q by rewrite -rat0 ler_int // . -have Hq1 : q = (floorQ q)%:Q + (q - (floorQ q)%:Q). - rewrite addrC -addrA. - by rewrite [(-_ + _)]addrC subrr addr0. -have floorEuclid := (divz_eq (floorQ q) m.+1). -rewrite {1}floorEuclid in Hq1. -have Heps : (floorQ q %% m.+1)%Z%:Q + - (q - (floorQ q)%:~R) < m.+1%:Q. -rewrite -addn1 PoszD intrD . -apply: ler_lt_add. -rewrite ler_int -ltz_addr1. -apply: ltz_pmod. -rewrite -PoszD addn1 ltz_nat // . -by case/andP: (floorQ_epslt1 q). -suff Hdecomp : q / m.+1%:~R = ((floorQ q %/ m.+1)%Z%:Q + (((floorQ q %% m.+1)%Z)%:~R + (q - (floorQ q)%:~R)) / m.+1%:Q). -rewrite Hdecomp. -suff HdivQdivz : floorQ ((floorQ q)%:~R / m.+1%:~R) = floorQ (((floorQ q) %/ m.+1)%Z%:Q). -set epsilon := ((floorQ q %% m.+1)%Z%:~R + (q - (floorQ q)%:~R)) / m.+1%:~R. -rewrite HdivQdivz -floorQ_int. -apply: floor_addEpsilon. - rewrite /epsilon. - apply/andP; split. - - apply: divr_ge0. - apply: addr_ge0. - rewrite -rat0 ler_int; apply: modz_ge0 => // . - by case/andP: (floorQ_epslt1 q). - by rewrite -rat0 ler_int // . - - rewrite ltr_pdivr_mulr ?mul1r. - exact: Heps. - by rewrite -rat0 ltr_int // . -rewrite {1}floorEuclid. -rewrite intrD mulrDl. -set eps2 := (floorQ q %% m.+1)%Z%:~R / m.+1%:~R. -have -> : ((floorQ q %/ m.+1)%Z * m.+1)%:~R / m.+1%:~R = ((floorQ q %/ m.+1)%Z)%:Q by rewrite intrM mulfK. -rewrite (@floor_addEpsilon _ eps2). - - by rewrite -floorQ_int. - - apply/andP; split. - + apply: divr_ge0 => // . - rewrite -rat0 ler_int; apply: modz_ge0 => // . - + rewrite ltr_pdivr_mulr ?mul1r // . - rewrite ltr_int. apply: ltz_pmod => // . -rewrite {1}Hq1 intrD. -rewrite -[_ + _ + (_ - _) ]addrA. rewrite [LHS]mulrDl. -congr (_ + _). -rewrite intrM mulfK. -by []. -by rewrite intq_eq0. +Lemma floorQ_div (q : rat) (m : nat) : + floorQ (q / m.+1%:Q) = floorQ ((floorQ q)%:Q / m.+1%:Q). +Proof. +apply/floorQ_unique; move: (floorQ_spec q) (floorQ_spec (q / m.+1%:Q)). +rewrite !ler_pdivl_mulr ?ltr_pdivr_mulr ?ltr0z // intrD -intrM ler_int. +move=> /andP[_ Hq] /andP[Hdiv /le_lt_trans ->] //. +rewrite -ltz_addr1 -(ltr_int [numDomainType of rat]) intrD. +by rewrite (le_lt_trans Hdiv). Qed. (* Lemma floorQ_div_pos (q : rat) (m : nat) : *) @@ -165,24 +68,19 @@ Qed. (* floorQ (q / m%:Q) = floorQ ((floorQ q)%:Q / m%:Q). *) (* Proof. *) - (* Lemma foo (n m : int) : m%:Q / n%:Q = m%:Q + n%:Q. *) (* case: (divqP m n). *) - - - Lemma floorQ_divn (m : nat) (n : nat) : - floorQ (m%:Q / n.+1%:Q) = floorQ (m %/ n.+1)%N%:~R. + floorQ (m%:Q / n.+1%:Q) = floorQ (m %/ n.+1)%N%:Q. Proof. - rewrite -divz_nat; move: (le0z_nat n.+1). - case: (divqP m (n.+1)%:Z) => // k x kn0 ple0. - have {ple0 kn0} lt0k: 0 < k. - by rewrite lt0r kn0 /= -(pmulr_lge0 _ (denq_gt0 x)). - by rewrite divzMpl // [LHS]floorQ_int. +apply/esym/floorQ_unique. +rewrite -floorQ_int ler_pdivl_mulr ?ltr_pdivr_mulr ?ltr0z //. +rewrite -!natrM ler_nat ltr_nat mulnDl mul1n. +by rewrite [m in (_ <= m < _)%N](divn_eq m n.+1) leq_addr ltn_add2l ltn_mod. Qed. -(* Lemma floorQ_divn_pos (m n : nat) : (n > 0)%N -> floorQ (m%:Q / n%:Q) = floorQ (m %/ n)%N%:~R. *) +(* Lemma floorQ_divn_pos (m n : nat) : (n > 0)%N -> floorQ (m%:Q / n%:Q) = floorQ (m %/ n)%N%:Q. *) (* Proof. *) (* by case: n => [|n] // H ; apply: floorQ_divn. *) (* Qed. *) @@ -192,14 +90,7 @@ Lemma helper1 n1 n2 n3 : ((n1 %/ n2) %/ n3)%N = floorQ (n1%:Q / (n2 * n3)%N%:Q) :> int. Proof. case: n2 =>[|n2] //; case: n3 => [|n3] // => Hpos2 Hpos3. -rewrite [LHS]floorQ_int. -rewrite -floorQ_divn // . -rewrite floorQ_div. -rewrite -floorQ_divn. -rewrite -floorQ_div. -rewrite PoszM intrM. -suff -> : n1%:Q / n2.+1%:Q / n3.+1%:Q = n1%:Q / (n2.+1%:Q * n3.+1%:Q) => // . -by rewrite -mulrA -invfM. +by rewrite -divnMA mulSn addSn floorQ_divn -floorQ_int. Qed. (* Lemma helper2 n1 n2 n3 : *) @@ -208,4 +99,4 @@ Qed. (* Proof. *) (* move => Hn2 Hn3. *) (* by rewrite helper1 // mulnC -helper1 //. *) -(* Qed. *) \ No newline at end of file +(* Qed. *) diff --git a/theories/hanson.v b/theories/hanson.v index da45ef9..63ec2d2 100644 --- a/theories/hanson.v +++ b/theories/hanson.v @@ -9,16 +9,16 @@ Unset Printing Implicit Defensive. Require Import field_tactics. Require Import bigopz. -Require Import lia_tactics conj. +Require Import lia_tactics. Require Import shift. Require Import extra_mathcomp. Require Import hanson_elem_arith. Require Import hanson_elem_analysis. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. +Local Open Scope ring_scope. (******************************************************************************) (* An elementary proof that lcm (1 ... n) = O(3^n), following *) @@ -37,158 +37,72 @@ hanson_elem_analysis.v *) (* Lemma 3 from original paper *) -Section Missing. - -Variable R : numFieldType. -(* Implicit Type x1 x2 y1 y2 x y : nat. *) - -Lemma ltr_pmul_le_l (x1 y1 x2 y2 : R): - 0 < x1 -> 0 < x2 -> x1 <= y1 -> x2 < y2 -> x1 * x2 < y1 * y2. -Proof. -move => posx1 posx2 le1 lt2. -have posy1 : (0 < y1) by exact: ltr_le_trans le1. -move: le1; rewrite ler_eqVlt; case/orP=> [/eqP-> | ?]; first by rewrite ltr_pmul2l. -by apply: ltr_pmul=> //; exact: ltrW. -Qed. - -Lemma ltr_pmul_le_r (x1 y1 x2 y2 : R): - 0 < x1 -> 0 < x2 -> x1 < y1 -> x2 <= y2 -> x1 * x2 < y1 * y2. -Proof. -move => Hx1 Hx2 Hx1y1 Hx2y2; rewrite mulrC [y1*y2]mulrC; exact: ltr_pmul_le_l. -Qed. - -Lemma exp_incr_expp (x : R) (H1x : 1 <= x) (m n : nat) : - (m <= n)%nat -> x ^+ m <= x ^+ n. -Proof. -move => Hmn; have Hx : 0 < x by apply: ltr_le_trans H1x. -have H : 0 < x ^+ m by rewrite exprn_gt0. -rewrite -(subnKC Hmn) exprD mulrC -ler_pdivr_mulr ?divrr ?unitf_gt0 //. -by rewrite exprn_ege1. -Qed. - -Lemma exp_incr_expn (x : R) (H1x : 0 < x < 1) (m n : nat) : - (n <= m)%nat -> x ^+ m <= x ^+ n. -Proof. -move => Hmn; rewrite -(subnKC Hmn) exprD mulrC; case/andP: H1x => H0 H1. -by rewrite ger_pmull ?exprn_gt0 //; apply: exprn_ile1 => //; apply: ltrW. -Qed. - -Lemma exp_quo_0 p q : exp_quo 0 p q = (p == 0%nat)%:R. -Proof. by rewrite /exp_quo /ratr mul0r rootC0 expr0n. Qed. - -Lemma C_n0 n : C n 0 = n `!. -Proof. by have := C_multi n 0; rewrite big_nil mul1n. Qed. - -Lemma iter_lcmn1 : iter_lcmn 1 = 1%nat. -Proof. by rewrite iter_lcmnS iter_lcmn0 lcmn1. Qed. - -End Missing. - Module Hanson. -Import Num.Internals. - Section PreliminaryRemarksLemma7. Variables (n i : nat). Hypothesis Hain : (a i <= n)%N. -Lemma remark_7_1 : ((n.+1 - a i) <= (n %/ a i) * (a i))%N . -Proof. -have H1n : (1 < n)%N by apply: leq_trans (a_gt1 i) _. -move: Hain; rewrite leq_eqVlt; case/orP => [|h]. - by move/eqP ->; rewrite subSnn divnn (ltnW H1n) mul1n; exact: leq_trans H1n. -by rewrite leq_subLR {1}(divn_eq n (a i)) addnC ltn_add2r ltn_mod; exact: a_pos. -Qed. +Lemma remark_7_1 : (n.+1 - a i <= n %/ a i * a i)%N. +Proof. by rewrite leq_subLR -mulSn ltn_ceil. Qed. -Lemma remark_7_2 : - exp_quo ((n.+1 - a i)%N%:Q / (a i)%:Q) (n.+1 - a i)%N (a i) <= - (((n %/ (a i)) ^ (n %/ (a i)))%N%:Q)%:C. +Lemma remark_7_2 : + exp_quo ((n.+1 - a i)%N%:Q / (a i)%:Q) (n.+1 - a i) (a i) <= + ((n %/ a i) ^ (n %/ a i))%N%:Q%:C. Proof. -rewrite exp_quo_nat_nat; apply: exp_quo_self_grows => // . +rewrite exp_quo_nat_nat; apply: exp_quo_self_grows => //. - by rewrite divr1. -- rewrite divr_gt0 // ?ltr0n ?(a_pos i) // . - by rewrite subn_gt0. - by rewrite extra_mathcomp.ler1z lez_nat divn_gt0 ?a_pos //. -rewrite ler_pdivr_mulr ?ltr0n ?a_pos // -intrM. rewrite ler_int lez_nat. -exact: remark_7_1. +- by rewrite divr_gt0 // ltr0n subn_gt0. +- by rewrite ler1n divn_gt0. +by rewrite ler_pdivr_mulr // -natrM ler_nat remark_7_1. Qed. Lemma remark_7_3 : -let f := fun u x y => exp_quo (u / (a i)%:Q) x y in - f n%:Q n (a i) / ((n %/ (a i)) ^ (n %/ (a i)))%N%:Q%:C - <= f n%:Q n (a i) / f (n.+1 - a i)%N%:Q (n.+1 - a i)%N (a i). + let f := fun u => exp_quo (u / (a i)%:Q) in + f n%:Q n (a i) / ((n %/ a i) ^ (n %/ a i))%N%:Q%:C <= + f n%:Q n (a i) / f (n.+1 - a i)%N%:Q (n.+1 - a i)%N (a i). Proof. -have Ha1 : (0 <= a i)%N by exact: (ltnW (a_pos i)). -have Ha2 : (0 < a i)%N by exact: (a_pos i). rewrite /= ler_pdivr_mulr; last first. - by rewrite ltr0q ltr0n // expn_gt0 divn_gt0 // Hain. + by rewrite ltr0q ltr0n expn_gt0 divn_gt0 ?Hain. rewrite[X in _ <= X]mulrC mulrA ler_pdivl_mulr. -- rewrite mulrC; apply: ler_pmul; try rewrite lerr // . - + by apply: exp_quo_ge0 => //; rewrite divr_ge0 // ?ler0z //. - + by apply: exp_quo_ge0 => //; rewrite divr_ge0 // ?ler0z //. - + exact: remark_7_2. -- by apply: exp_quo_gt0 => //; rewrite divr_gt0 // ?ltr0n // subn_gt0. +- rewrite mulrC; apply/ler_pmul/remark_7_2 => //. + + by apply: exp_quo_ge0; rewrite // divr_ge0 ?ler0n. + + by apply: exp_quo_ge0; rewrite // divr_ge0 ?ler0n. +- by apply: exp_quo_gt0; rewrite // divr_gt0 // ltr0n ?subn_gt0. Qed. (* This one would ideally be entirely automated *) Lemma remark_7_4 : -let r := (n.+1 - a i)%N%:Q / (a i - 1)%N%:Q in - (exp_quo (n%:Q / (a i)%:Q) n%N (a i) / - exp_quo ((n.+1 - a i)%N%:Q / (a i)%:Q) (n.+1 - a i)%N (a i)) ^+ (a i) = - (exp_quo (1 + 1 / r) (n.+1 - a i)%N (a i)) ^+(a i) * + let r := (n.+1 - a i)%N%:Q / (a i - 1)%N%:Q in + (exp_quo (n%:Q / (a i)%:Q) n (a i) / + exp_quo ((n.+1 - a i)%N%:Q / (a i)%:Q) (n.+1 - a i) (a i)) ^+ a i = + exp_quo (1 + 1 / r) (n.+1 - a i) (a i) ^+ a i * ((n%:Q / (a i)%:Q) ^ (a i - 1)%N)%:C. Proof. move => r. have Hapos := a_pos i. -have npos : (0 < n)%N by exact: (leq_trans Hapos). +have npos : (0 < n)%N by exact: leq_trans Hapos _. have helper1 : (n < a i + n)%N by rewrite -{1}[n]add0n ltn_add2r. -have -> : (1 + 1 / r) = n%:Q / (n.+1 - a i)%N%:Q. (* automation missing...*) - rewrite /r -addn1 -!subzn // ; last by rewrite addn1 leqW. - rewrite // ?rmorphD /= ?rmorphN //= !PoszD !rmorphD /= . - rat_field. rewrite /emb /emb0. - split. - suff: (a i)%:Q < (n + 1)%N%:Q by goal_to_lia; intlia. - by rewrite ltr_nat addn1. - suff : 1%:Q < (a i)%:Q. by goal_to_lia; intlia. - by rewrite ltr_nat a_gt1. -suff {1}<- : (n%:Q / (a i)%:Q) * ((n.+1 - a i)%N%:Q / n%:Q) = - (n.+1 - a i)%N%:Q / (a i)%:Q. - rewrite -[X in (_ / X)^+ _ = _]exp_quo_mult_distr ?divr_ge0 ?ler0n // . - rewrite [in LHS]exprMn. - rewrite exprVn. - rewrite [in LHS]exprMn. - rewrite [X in (_ / X)]mulrC invrM ?GRing.unitfE ?extra_mathcomp.lt0r_neq0 // . - + rewrite mulrA exprnN {1 2}/exp_quo -exprM mulnC exprM rootCK // . - rewrite [(a i).-root (ratr (n%:~R / (a i)%:~R)) ^+ (n.+1 - a i)]exprnP. - rewrite exprz_exp. - rewrite mulrN [(Posz(n.+1 - a i)%N * (a i))]mulrC -mulrN -exprz_exp -exprnP. - rewrite rootCK // -exprnN. - rewrite -GRing.exprB ?leq_subLR ?unitf_gt0 //; last first. - by rewrite ltr0q divr_gt0 // ltr0n. - rewrite subnBA ?leqW // . - have -> : (n + a i - n.+1 = a i - 1)%N by rewrite -addn1 subnDl. - rewrite [RHS]mulrC. - congr (_ * _). - by rewrite exprnP rmorphX. - have -> : exp_quo ((n.+1 - a i)%N%:~R / n%:~R) (n.+1 - a i) (a i) ^- a i = - ratr ((n.+1 - a i)%N%:~R / n%:~R) ^ (- (n.+1 - a i)%N%:Z). - by rewrite exprnP -exprnP -exprM exprnP mulnC -exprnP exprM rootCK ?exprnN. - rewrite -exprz_inv; repeat (rewrite CratrE /=); rewrite invrM /= ?invrK. - * by rewrite /exp_quo; repeat (rewrite CratrE /=); - rewrite -exprM mulnC exprM rootCK -?exprnP. - * by rewrite unitf_gt0 // ltr0n subn_gt0. - * rewrite unitf_gt0 // invr_gt0 ltr0n. - exact: (leq_trans Hapos). - + by rewrite exprn_gt0 // exp_quo_gt0 // divr_gt0 // ltr0n ?subn_gt0. - + by rewrite exprn_gt0 // exp_quo_gt0 // divr_gt0 // ltr0n. -rat_field. -rewrite /emb /emb0. -split. -suff : 0%:Q < (a i)%:Q by goal_to_lia; intlia. - by rewrite ltr_nat. -suff : 0%:Q < (n)%:Q by goal_to_lia; intlia. - by rewrite ltr_nat. +have {r} ->: (1 + 1 / r) = n%:Q / (n.+1 - a i)%N%:Q. (* automation missing...*) + have Hneq0: (Posz n.+1 - Posz (a i))%:~R != 0 :> rat. + by rewrite intq_eq0 subr_eq0 neq_ltn ltnS Hain orbT. + rewrite /r -!subzn //; last exact: leq_trans Hain _. + rewrite mul1r invfM invrK mulrC; apply: canRL (mulfK Hneq0) _. + by rewrite mulrDl mul1r divfK // !mulrzBr addrA subrK -mulrnBr ?subn1. +case: (a i) (a_pos i) Hain => // ai' _ Hain'. +rewrite subn1 subSS /= /exp_quo rmorphX 4!rmorphM 2!fmorphV /= !ratr_int. +rewrite 2!exprMn 2!exprVn ![_ ^+ _ ^+ ai'.+1]exprAC !rootCK //. +rewrite 3!exprMn 3!exprVn !exprnP -subzn; last exact: ltnW. +rewrite !expfzDr -?invr_expz ?intr_eq0 //; last first. +- by rewrite subr_eq0 neq_ltn Hain' orbT. +- by rewrite -lt0n; apply: leq_trans _ Hain'. +rewrite !invfM !invrK -!mulrA /exprz; congr (_ * _). +rewrite ![_ * ((_ - _)%:~R ^- n * _)]mulrCA; congr (_ * _). +rewrite ![_ * ((_ - _)%:~R ^+ ai' * _)]mulrCA; congr (_ * _). +rewrite !mulrA; congr (_ * _). +rewrite mulrC [RHS]mulrC !divff //. +by rewrite expf_eq0 negb_and intr_eq0 -!lt0n npos orbT. Qed. End PreliminaryRemarksLemma7. @@ -198,61 +112,53 @@ End PreliminaryRemarksLemma7. (* TODO rename + chainage avant *) Lemma l7 n i (Hain : (a i <= n)%N) : - exp_quo (n%:Q / (a i)%:Q) n (a i) / ((n %/ (a i)) ^ (n %/ (a i)))%N%:Q%:C < + exp_quo (n%:Q / (a i)%:Q) n (a i) / ((n %/ a i) ^ (n %/ a i))%N%:Q%:C < exp_quo (10%:Q * n%:Q / (a i)%:Q) (a i - 1) (a i). Proof. have Hapos := a_pos i. -have posai_rat : 0 < (a i)%:~R :> rat by rewrite ltr0n. +have posai_rat : 0 < (a i)%:Q by rewrite ltr0n. pose posai := PosNumDef posai_rat. -have -> : (a i)%:~R = num_of_pos posai by []. -have lt0n : (0 < n)%N by exact: (leq_trans Hapos). -have lt0n_rat : 0 < n%:~R :> rat by rewrite ltr0n. +have -> : (a i)%:Q = num_of_pos posai by []. +have lt0n : (0 < n)%N by exact: leq_trans Hapos _. +have lt0n_rat : 0 < n%:Q by rewrite ltr0n. pose posn := PosNumDef lt0n_rat. -have -> : n%:~R = num_of_pos posn by []. -apply: ler_lt_trans (remark_7_3 Hain) _. +have -> : n%:Q = num_of_pos posn by []. +apply: le_lt_trans (remark_7_3 Hain) _. set lhs := (X in X < _); set rhs := (X in _ < X). -suff : lhs ^+ (a i) < rhs ^+ (a i). - have lhs_ge0 : 0 <= lhs. +suff : lhs ^+ a i < rhs ^+ a i. + rewrite ltr_pexpn2r // nnegrE; last exact: exp_quo_ge0. (* roots, hence alg. numbers prevent using posnum based automation *) - by rewrite /lhs divr_ge0 // exp_quo_ge0 // divr_ge0 // ?ler0n // ler0q. - have rhs_ge0 : 0 <= rhs by rewrite /rhs exp_quo_ge0. - by rewrite ltr_pexpn2r. + by rewrite /lhs divr_ge0 // exp_quo_ge0 // divr_ge0 // ler0z. rewrite remark_7_4 // /rhs. -rewrite -mulrA -exp_quo_mult_distr // exprMn. -have -> : exp_quo 10%:~R (a i - 1) (a i) ^+ a i = exp_quo 10%:~R (a i - 1)%N 1. - by rewrite /exp_quo -exprM mulnC exprM rootCK // root1C. -have -> : exp_quo (n%:~R / (a i)%:~R) (a i - 1) (a i) ^+ a i = - ratr ((n%:~R / (a i)%:~R) ^ (a i - 1)%N). - by rewrite /exp_quo -exprM mulnC exprM rootCK // rmorphX. +rewrite -mulrA -exp_quo_mult_distr // exprMn. +have -> : exp_quo 10%:Q (a i - 1) (a i) ^+ a i = exp_quo 10%:Q (a i - 1)%N 1. + by rewrite /exp_quo exprAC rootCK // root1C. +have -> : exp_quo (n%:Q / (a i)%:Q) (a i - 1) (a i) ^+ a i = + ((n%:Q / (a i)%:Q) ^ (a i - 1)%N)%:C. + by rewrite /exp_quo exprAC rootCK // rmorphX. rewrite -lter_pdivr_mulr //; last first. - by rewrite ltr0q exprz_gt0 // divr_gt0 // ltr0n. + by rewrite ltr0q exprz_gt0 // divr_gt0. rewrite -mulrA divrr; last first. - by rewrite unitf_gt0 // ltr0q exprz_gt0 // divr_gt0 // ltr0n . -rewrite mulr1 -exp_quo_r_nat. -rewrite rmorphX /=. -repeat (rewrite CratrE /=). + by rewrite unitf_gt0 // ltr0q exprz_gt0 // divr_gt0. +rewrite mulr1 -exp_quo_r_nat rmorphX /= ratr_int. set x := (n.+1 - a i)%N. set y := (a i - 1)%N. -set z := (a i). +set z := a i. have Hx : (0 < x)%N by rewrite subn_gt0. -have Hy : (0 < y)%N by rewrite subn_gt0 a_gt1. -have Hxy : (0 < x * y)%N by rewrite muln_gt0 Hx Hy. -have Hzy : (0 < z * y)%N by rewrite muln_gt0 Hapos Hy. -have -> : exp_quo (1 + 1 / (x%:~R / y%:~R)) x z = - exp_quo (1 + 1 / (x%:~R / y%:~R)) (x*y)%N (z*y)%N. - apply: exp_quo_equiv => //; last by rewrite -mulnA [(y*z)%N]mulnC. - by rewrite -[0]addr0 ler_add // divr_ge0 // divr_ge0 // ?ler0n. -have side1 : 0 <= ratr (1 + 1 / (x%:~R / y%:~R)) :> algC. - by rewrite ler0q -[0]addr0 ler_add // divr_ge0 // divr_ge0 // ler0n. -rewrite /exp_quo prod_root // exprM -rootCX //; last by rewrite rootC_ge0. -rewrite -exprM mulnC exprM rootCK ?ltr_pexpn2r // ?nnegrE ?ler0n //; last first. -- by apply: exprn_ge0; rewrite rootC_ge0. -have -> : y.-root (ratr (1 + 1 / (x%:~R / y%:~R))) ^+ x = - exp_quo (1 + 1 / (x%:R / y%:R)) x y. - by rewrite /exp_quo //; repeat (rewrite CratrE /=). -apply: ler_lt_trans. apply one_plus_invx_expx => //. -- by rewrite divr_gt0 // ltr0n. -- do 2! (rewrite CratrE /=); exact: ltr_nat. +have Hy : (0 < y)%N by rewrite subn_gt0. +have Hxy : (0 < x * y)%N by rewrite muln_gt0 Hx. +have Hzy : (0 < z * y)%N by rewrite muln_gt0 Hapos. +have -> : exp_quo (1 + 1 / (x%:Q / y%:Q)) x z = + exp_quo (1 + 1 / (x%:Q / y%:Q)) (x * y)%N (z * y)%N. + apply: exp_quo_equiv => //; last by rewrite -mulnA [(y * z)%N]mulnC. + by rewrite addr_ge0 ?divr_ge0 ?ler0n. +have side1 : 0 <= (1 + 1 / (x%:Q / y%:Q))%:C. + by rewrite ler0q addr_ge0 ?divr_ge0 ?ler0n. +rewrite /exp_quo prod_root // exprM -rootCX ?rootC_ge0 // -exprAC rootCK //. +rewrite ltr_pexpn2r ?nnegrE //; last by apply/exprn_ge0; rewrite rootC_ge0. +apply: le_lt_trans. +- by apply: one_plus_invx_expx; rewrite // divr_gt0 ?ltr0n. +- by rewrite ratr_int ltr_nat. Qed. @@ -260,17 +166,17 @@ Qed. Lemma l10 n k (Hank : (a k <= n)%N) : (C n k.+1)%:Q%:C < (n ^ n)%N%:Q%:C * - \prod_(i < k.+1) (exp_quo (10%:Q * n%:Q / (a i)%:Q) ((a i).-1) (a i)) / - \prod_(i < k.+1) (exp_quo (n%:Q / (a i)%:Q) n (a i)). + \prod_(i < k.+1) exp_quo (10%:Q * n%:Q / (a i)%:Q) (a i).-1 (a i) / + \prod_(i < k.+1) exp_quo (n%:Q / (a i)%:Q) n (a i). Proof. -have lt0n : (0 < n)%N by exact: (leq_trans (a_pos k)). +have lt0n : (0 < n)%N by exact: leq_trans (a_pos k) _. suff Hinterm : ((n ^ n)%N%:Q / (\prod_(i < k.+1) (n %/ (a i)) ^ (n %/ a i))%N%:Q)%:C < (n ^ n)%N%:Q %:C * \prod_(i < k.+1) exp_quo (10%:Q * n%:Q / (a i)%:Q) (a i).-1 (a i) / \prod_(i < k.+1) exp_quo (n%:Q / (a i)%:Q) n (a i). - apply: ler_lt_trans Hinterm. - repeat (rewrite CratrE /=); rewrite ler_pdivl_mulr. + apply: le_lt_trans Hinterm. + rewrite !CratrE /= ler_pdivl_mulr. rewrite mulrC -natrM ler_nat. by move: (l8 n k.+1); rewrite big_mkord. rewrite ltr0n prodn_gt0 // => i; rewrite expn_gt0. @@ -280,36 +186,18 @@ rewrite ltr_pdivl_mulr; last first. by rewrite exp_quo_gt0 ?divr_ge0 ?divr_gt0 ?ltr0n ?a_pos. rewrite -lter_pdivr_mulr; last first. apply: prodr_gt0 => i _. - by rewrite exp_quo_gt0 ?divr_ge0 1?divr_gt0 1?mulr_gt0 ?ltr0n // ?a_pos. + by rewrite exp_quo_gt0 ?divr_ge0 1?divr_gt0 1?mulr_gt0 ?ltr0n. rewrite CratrE /= -2!mulrA. rewrite gtr_pmulr; last first. by rewrite ltr0q ltr0n expn_gt0 lt0n. rewrite mulrA lter_pdivr_mulr; last first. apply: prodr_gt0 => i _. - by rewrite exp_quo_gt0 ?divr_ge0 1?divr_gt0 1?mulr_gt0 ?ltr0n // ?a_pos. -rewrite mul1r mulrC. -rewrite CratrE /= CratrE /= CratrE /= . -have -> : - \prod_(i < k.+1) exp_quo (n%:~R / (a i)%:~R) n (a i) / - (\prod_(i < k.+1) (n %/ a i) ^ (n %/ a i))%:R = - \prod_(i < k.+1) - (exp_quo (n%:~R / (a i)%:~R) n (a i) / - ((n %/ a i) ^ (n %/ a i))%:R). - by rewrite natr_prod -prodf_div. -rewrite 2!big_ord_recr /= ltr_pmul_le_l // ?prodr_gt0 1?divr_gt0 // - 1?ltr0n 1?exp_quo_gt0 // 1?divr_gt0 ?ltr0n 1?a_pos // . -+ move => i H. - rewrite divr_gt0 ?lertn // ?exp_quo_gt0 ?divr_gt0 1?a_pos1 ?ltr0n ?a_pos //. - by rewrite expn_gt0; case: (posnP (n %/ a i)%N). -+ rewrite expn_gt0; by case: (posnP (n %/ a k)%N). -+ apply: ler_prod => i _; apply/andP. - split; first by rewrite divr_ge0 ?exp_quo_ge0 ?a_pos ?divr_ge0 ?ler0n. - (* rewrite ltrW // . *) - have Hain : (a i <= n)%N. - suff Hik : (a i <= a k)%N by apply: (leq_trans _ Hank). - by apply: a_grows; case: i => i /= Hi; exact: ltnW. - move: (l7 Hain); rewrite CratrE /= CratrE /= subn1; exact: ltrW. -+ by move: (l7 Hank); rewrite CratrE /= CratrE /= subn1. + by rewrite exp_quo_gt0 ?divr_ge0 1?divr_gt0 1?mulr_gt0 ?ltr0n. +rewrite mul1r mulrC !CratrE /= natr_prod -prodfV -big_split /=. +apply: ltr_prod; first by apply/hasP; exists ord0; rewrite // mem_index_enum. +move=> [i /= Hi] _; rewrite divr_ge0 ?exp_quo_ge0 ?a_pos ?divr_ge0 ?ler0n //=. +suff/l7: (a i <= n)%N by rewrite !CratrE subn1. +exact/leq_trans/Hank/a_grows. Qed. Section A'. @@ -318,129 +206,97 @@ Implicit Types i : nat. Definition a' i : algC := exp_quo (a i)%:Q 1%N (a i). -Lemma a'_ge0 i : 0 <= a' i. -Proof. by rewrite rootC_ge0 ?CratrE ?ler0n ?a_pos. Qed. -Hint Resolve a'_ge0. - -Lemma a'_gt0 i : 0 < a' i. -Proof. -by rewrite rootC_gt0 ?CratrE ?ltr0n ?a_pos. -Qed. +Lemma a'_gt0 i : 0 < a' i. Proof. by rewrite rootC_gt0 ?CratrE ?ltr0n. Qed. Hint Resolve a'_gt0. +Lemma a'_ge0 i : 0 <= a' i. Proof. exact: ltW. Qed. +Hint Resolve a'_ge0. + Lemma a'_gt1 i : 1 < a' i. -Proof. -by rewrite exprn_egte1 // rootC_gt1 ?ltr1q ?ltr1n ?a_gt1 ?a_pos. -Qed. +Proof. by rewrite exprn_egte1 // rootC_gt1 ?ltr1q ?ltr1n. Qed. Hint Resolve a'_gt1. Lemma a'_S i (Hi : (2 <= i)%N) : a' i.+1 <= sqrtC (a' i). Proof. -rewrite /a' /exp_quo !expr1. -case/andP: (Observation_compare_a_a i) => H1 H2. -repeat (rewrite CratrE /=); rewrite -/(a i.+1). -have Hinterm : (a i.+1).-root (a i.+1)%:R <= (a i.+1).-root (a i ^ 2)%:R :> algC. - by rewrite ler_rootC ?a_pos // ?nnegrE ?ler0n // ler_nat // ltnW. -apply: (ler_trans Hinterm) => {Hinterm}. -have Hinterm1 : (a i.+1).-root (a i ^ 2)%:R <= - (((a i).-1)^2)%N.-root ((a i) ^2)%N%:R :> algC. - rewrite rootC_leq // ?ler1n ?sqrn_gt0 -?subn1 ?subn_gt0 ?a_gt1 ?a_pos // . - by rewrite subn1 ltnW. -rewrite (ler_trans Hinterm1) // => {Hinterm1}. -rewrite -prod_root // ?a_pos ?ler0n ?ltnW // . -rewrite -[(a i)%:R](@rootCK _ 2%N) // -rootCX // ?ler0n // . -rewrite -[in X in (_ <= X)]prod_root //= ?muln_gt0 ?a_pos // ?GRing.natrX; - last first. - by rewrite -natrX ?ler0n. -rewrite rootC_leq // ?muln_gt0 ?a_pos -?natrX ?ler1n ?expn_gt0 ?a_pos // . -rewrite -lez_nat !PoszM -subn1 -subzn ?a_pos // . -rewrite -subr_ge0. +have /andP[H1 H2] := Observation_compare_a_a i. +rewrite /a' /exp_quo !expr1 !CratrE root_le_x -?rootCX ?rootC_ge0 ?ler0n //. +rewrite root_x_le ?rootC_ge0 ?root_x_le ?exprn_ge0 ?ler0n //. +rewrite -!natrX ler_nat -expnM. +have/leq_trans -> //: (a i.+1 ^ (2 * a i) <= a i ^ (2 * (2 * a i)))%N. + by rewrite [(a i ^ _)%N]expnM leq_exp2r ?(ltnW H2) // muln_gt0 /=. +rewrite leq_exp2l //; apply: leq_trans (ltnW H1). +rewrite -lez_nat -subr_ge0 -subn1 !PoszM -subzn //. set rhs := (X in 0 <= X). -have -> : rhs = (a i)%:Z * ((a i)%:Z - 6%:Z) + 1. - rewrite -eqr_int_prop !intrD !intrM !intrD !rmorphN !rmorphM /= . - by rat_field. +have -> : rhs = (a i)%:Z * ((a i)%:Z - 6%:Z) + 1 by intlia. rewrite addr_ge0 // mulr_ge0 // subr_ge0. -have Ha2 : (5 < a 2)%N by []. -apply: (leq_trans Ha2); exact: a_grows. +exact/leq_trans/a_grows/Hi. Qed. -Lemma a'_bound i j (Hi : (2 <= i)%N) : a' (i+j) <= (2^j%N).-root (a' i). +Lemma a'_bound i j (Hi : (2 <= i)%N) : a' (i + j) <= (2 ^ j).-root (a' i). Proof. elim: j => [|j HIj] //. by rewrite addn0 expn0 root1C. rewrite addnS. have /a'_S Ha : (2 <= i + j)%N by apply: (leq_trans Hi); rewrite leq_addr. -apply: (ler_trans Ha). -rewrite expnS prod_root // ?expn_gt0 // ?rootC_ge0 ?a_pos ?CratrE ?ler0n // . -rewrite ler_rootC ?nnegrE // . -by rewrite rootC_ge0 ?CratrE ?ler0n ?a_pos // ?expn_gt0. +apply: le_trans Ha _; rewrite expnS prod_root ?expn_gt0 //. +by rewrite ler_rootC ?nnegrE // rootC_ge0 ?expn_gt0. Qed. Section W_k. Definition w_seq k := \prod_(i < k) a' i. -Lemma w_seq_ge0 k : 0 <= w_seq k. -Proof. -by rewrite prodr_ge0 // => i _ ; exact:a'_ge0. -Qed. - Lemma w_seq_gt0 k : 0 < w_seq k. -Proof. -by rewrite prodr_gt0 // => i _ ; exact:a'_gt0. -Qed. +Proof. by rewrite prodr_gt0 // => i _ ; exact:a'_gt0. Qed. + +Lemma w_seq_ge0 k : 0 <= w_seq k. +Proof. exact/ltW/w_seq_gt0. Qed. Lemma w_seq_le_S k : w_seq k <= w_seq k.+1. Proof. - rewrite /w_seq big_ord_recr /= . - by rewrite ler_pmulr 1?ltrW ?a'_gt1 // prodr_gt0 // => i _ . +rewrite /w_seq big_ord_recr /= . +by rewrite ler_pmulr 1?ltW ?a'_gt1 // prodr_gt0 // => i _. Qed. Lemma w_seq_incr k l : (k <= l)%N -> w_seq k <= w_seq l. Proof. elim: l => [|l ihl]; first by rewrite leqn0 => /eqP->. -rewrite leq_eqVlt ltnS; case/orP => [/eqP-> // | /ihl hkl]. -exact: ler_trans (w_seq_le_S _). +rewrite leq_eqVlt ltnS; case/predU1P => [-> // | /ihl hkl]. +exact: le_trans (w_seq_le_S _). Qed. Lemma w_seq_bound k (Hk : (2 <= k)%N) l : - w_seq (k + l) <= w_seq k * exp_quo ((a k)%:Q) (2 ^ l.+1 - 2)%N (2 ^ l * (a k))%N. + w_seq (k + l) <= w_seq k * exp_quo (a k)%:Q (2 ^ l.+1 - 2) (2 ^ l * a k). Proof. elim: l => [|l HIl]. by rewrite addn0 /= expn1 subnn /= /exp_quo expr0 mulr1. rewrite addnS /w_seq big_ord_recr /=. -suff -> : exp_quo (a k)%:~R (2 ^ l.+2 - 2) (2 ^ l.+1 * a k) = - exp_quo (a k)%:~R (2 ^ l.+1 - 2) (2 ^ l * a k) * (2^l%N).-root (a' k). +suff -> : exp_quo (a k)%:Q (2 ^ l.+2 - 2) (2 ^ l.+1 * a k) = + exp_quo (a k)%:Q (2 ^ l.+1 - 2) (2 ^ l * a k) * (2 ^ l).-root (a' k). rewrite mulrA. apply: ler_pmul; rewrite ?a'_bound // ?rootC_ge0 ?CratrE ?a_pos ?ler0n // . by rewrite prodr_ge0 // => i _ ; exact: a'_ge0. rewrite -prod_root ?CratrE ?expn_gt0 ?a_pos ?ler0n // . have -> : (2 ^ l * a k).-root (a k)%:R = exp_quo (a k)%:R 1%N (2 ^ l * a k). - by rewrite /exp_quo expr1 CratrE /= CratrE. + by rewrite /exp_quo expr1 !CratrE. rewrite -exp_quo_plus ?ler0n // ?muln_gt0 ?a_pos ?expn_gt0 // . rewrite [(2^l.+1)%N]expnS -mulnA. set m := (2^l * a k)%N. have Hm : (0 < m)%N. by rewrite muln_gt0 a_pos expn_gt0. apply: exp_quo_equiv; last first. -- rewrite -mulnDl -expnS. - rewrite mulnAC !mulnA. - do 4 congr (_ * _)%N. - suff -> : (2 ^ l.+1 - 2 + 1 = 2 ^ l.+1 - 1)%N. - rewrite mulnBl expnS mulnC. - by congr (_ * 2 - _)%N. - rewrite addn1 -subSn ?subSS // . - by rewrite expnS -[2]muln1 leq_mul // ?expn_gt0 // . +- rewrite -mulnDl -subnA ?leq_pmulr ?expn_gt0 //= subn1 /=. + by rewrite mulnAC 2!mulnA [in RHS]mulnBl -expnS -expnSr. - by rewrite ler0n. - by rewrite muln_gt0 Hm. - by rewrite muln_gt0 Hm. Qed. Lemma w_seq_bound_tail k (Hk : (2 <= k)%N) l : - w_seq (k + l) <= w_seq k * (a' k) ^+ 2. + w_seq (k + l) <= w_seq k * a' k ^+ 2. Proof. -apply: (ler_trans (w_seq_bound Hk l)). +apply: (le_trans (w_seq_bound Hk l)). rewrite ler_pmul ?w_seq_ge0 ?exp_quo_ge0 ?ler0n ?muln_gt0 ?a_pos ?expn_gt0 // . have -> : a' k ^+ 2 = exp_quo (a k)%:Q 2%N (a k). by rewrite /a' /exp_quo -exprM mul1n. @@ -468,9 +324,10 @@ Definition a'4_ub : rat := rat_of_Z 201 / rat_of_Z 200. End A'. (* Reported to survive end of section *) -Hint Resolve a'_ge0. Hint Resolve a'_gt0. +Hint Resolve a'_ge0. Hint Resolve a'_gt1. +Hint Resolve w_seq_ge0. Module Computations. @@ -481,15 +338,15 @@ Hint Resolve rat_of_Z_Zpos. (* Missing from rat_of_Zpos *) Lemma rat_of_Z_ZposW z : 0 <= rat_of_Z (Zpos z). -Proof. exact: ltrW. Qed. +Proof. exact: ltW. Qed. -Lemma rat_of_Z_of_nat n : rat_of_Z (Z.of_nat n) = n%:~R. +Lemma rat_of_Z_of_nat n : rat_of_Z (Z.of_nat n) = n%:Q. Proof. rewrite rat_of_ZEdef /=; case: n => [| n] //=. -by rewrite /rat_of_Z_ /rat_of_Z_fun SuccNat2Pos.id_succ. +by rewrite /rat_of_Z_ SuccNat2Pos.id_succ. Qed. -Lemma rat_of_Z_pow z n : rat_of_Z (z ^ Z.of_nat n) = (rat_of_Z z) ^ n. +Lemma rat_of_Z_pow z n : rat_of_Z (z ^ Z.of_nat n) = rat_of_Z z ^ n. Proof. rewrite -Zpower_nat_Z; elim: n => [| n ihn]. - by rewrite expr0z Zpower_nat_0_r -rat_of_Z_1. @@ -501,66 +358,63 @@ Hint Resolve rat_of_Z_ZposW. Definition w : rat := a'0_ub * a'1_ub * a'2_ub * a'3_ub * a'4_ub ^ 2. -Lemma w_val : w = rat_of_Z (5949909309448377) / rat_of_Z (2 * (10 ^ 15))%coqZ. +Lemma w_val : w = rat_of_Z 5949909309448377 / rat_of_Z (2 * 10 ^ 15)%coqZ. Proof. rewrite /w /a'0_ub /a'1_ub /a'2_ub /a'3_ub /a'4_ub. rat_field. -by (do ! split); - apply/eqP; rewrite -rat_of_ZEdef extra_mathcomp.lt0r_neq0 //. +by do !split; apply/eqP; rewrite -rat_of_ZEdef lt0r_neq0. Qed. -Lemma w_gt0 : 0 < w. Proof. rewrite w_val divr_gt0 //; exact: rat_of_Z_Zpos. Qed. +Lemma w_gt0 : 0 < w. Proof. by rewrite w_val divr_gt0 // rat_of_Z_Zpos. Qed. -Lemma w_ge0 : 0 <= w. Proof. apply: ltrW; exact: w_gt0. Qed. +Lemma w_ge0 : 0 <= w. Proof. exact/ltW/w_gt0. Qed. -Lemma w_lt3 : w < 3%:~R. +Lemma w_lt3 : w < 3%:Q. Proof. rewrite w_val ltr_pdivr_mulr ?rat_of_Z_Zpos // -subr_gt0. -have -> : 3%:~R * rat_of_Z (2 * 10 ^ 15) - rat_of_Z 5949909309448377 = +have -> : 3%:Q * rat_of_Z (2 * 10 ^ 15) - rat_of_Z 5949909309448377 = rat_of_Z (3 * 2 * 10 ^ 15 - 5949909309448377). rat_field. -set p := (X in 0 < rat_of_Z X). -vm_compute in p; apply: rat_of_Z_Zpos. +by rewrite rat_of_ZEdef ltr0z. Qed. -Lemma w_gt1 : (1 < w). +Lemma w_gt1 : 1 < w. Proof. rewrite w_val ltr_pdivl_mulr ?rat_of_Z_Zpos // 1?mul1r -subr_gt0. set v := (X in rat_of_Z X - _). set w := (X in _ - rat_of_Z X). have ->: rat_of_Z v - rat_of_Z w = rat_of_Z (v - w) by rat_field. -set p := (X in 0 < rat_of_Z X). -vm_compute in p; apply: rat_of_Z_Zpos. +by rewrite rat_of_ZEdef ltr0z. Qed. -Hint Resolve w_gt1. +Lemma w_ge1 : 1 <= w. Proof. exact/ltW/w_gt1. Qed. Section PosNum. Context {R : numFieldType}. -Lemma posrat (r : {posnum rat}) : 0 < (ratr (num_of_pos r) : R). -Proof. by rewrite ltr0q; case:r. Qed. +Lemma posrat (r : {posnum rat}) : 0 < ratr (num_of_pos r) :> R. +Proof. by rewrite ltr0q. Qed. End PosNum. (* Computer-algebra aided proof. *) Lemma w_upper_bounded k : w_seq k <= w%:C. Proof. -wlog le4k : k / (4 <= k)%nat. +wlog le4k : k / (4 <= k)%N. move=> hwlog; case: (leqP 4 k) => [|ltk4]; first exact: hwlog. - apply: ler_trans (hwlog 4 _) => //; apply: w_seq_incr; exact: ltnW. -rewrite -(subnK le4k) addnC; apply: ler_trans (w_seq_bound_tail _ _) _ => //. + apply: le_trans (hwlog 4 _) => //; apply: w_seq_incr; exact: ltnW. +rewrite -(subnK le4k) addnC; apply: le_trans (w_seq_bound_tail _ _) _ => //. have -> : w_seq 4 = a' 0 * a' 1 * a' 2 * a' 3. by rewrite /w_seq !big_ord_recr /= big_ord0 mul1r. have a'0_ubP : a' 0 <= a'0_ub%:C. - have gt0a0 : (0 < a 0)%nat by apply: a_pos. + have gt0a0 : (0 < a 0)%N by apply: a_pos. have ge0a'0 : 0 <= a'0_ub%:C by rewrite ler0q divr_ge0. - apply: root_le_x => //. + rewrite root_le_x //. rewrite -rmorphX ler_rat /a'0_ub exprMn exprVn lter_pdivl_mulr ?exprn_gt0 //. - rewrite a0. - (*goal: 2%:~R * rat_of_Z 200 ^+ 2 <= rat_of_Z 283 ^+ 2: the length of + rewrite a0. + (*goal: 2%:Q * rat_of_Z 200 ^+ 2 <= rat_of_Z 283 ^+ 2: the length of the proof is ridiculous... *) - set aval := (X in (Posz X)%:~R * _ ^+ X <= _ ^+ X). - set p := (X in _ * (rat_of_Z X) ^+ _ <= _); + set aval := (X in (Posz X)%:Q * _ ^+ X <= _ ^+ X). + set p := (X in _ * rat_of_Z X ^+ _ <= _); set q := (X in _ * _ <= rat_of_Z X ^+ _). rewrite -subr_ge0 !exprnP; set rhs := (X in 0 <= X). pose pos := (q ^ Z.of_nat aval - Z.of_nat aval * p ^ Z.of_nat aval)%coqZ. @@ -571,12 +425,12 @@ have a'0_ubP : a' 0 <= a'0_ub%:C. suff -> : pos = 89%coqZ by exact: rat_of_Z_ZposW. done. have a'1_ubP : a' 1 <= a'1_ub%:C. - have gt0a0 : (0 < a 1)%nat by apply: a_pos. + have gt0a0 : (0 < a 1)%N by apply: a_pos. have ge0a'1 : 0 <= a'1_ub%:C by rewrite ler0q divr_ge0. - apply: root_le_x=> //. + rewrite root_le_x //. rewrite -rmorphX ler_rat /a'1_ub exprMn exprVn lter_pdivl_mulr ?exprn_gt0 //. rewrite a1. - set aval := (X in (Posz X)%:~R * _ ^+ X <= _ ^+ X). + set aval := (X in (Posz X)%:Q * _ ^+ X <= _ ^+ X). set p := (X in _ * (rat_of_Z X) ^+ _ <= _); set q := (X in _ * _ <= rat_of_Z X ^+ _). rewrite -subr_ge0 !exprnP; set rhs := (X in 0 <= X). @@ -589,13 +443,12 @@ have a'0_ubP : a' 0 <= a'0_ub%:C. done. have a'2_ubP : a' 2 <= a'2_ub%:C. have ge0a'1 : 0 <= a'2_ub%:C by rewrite ler0q divr_ge0. - have ge0a2 : 0 <= ratr (a 2)%:~R :> algC by rewrite ler0q. - suff step : ratr (a 2)%:~R <= ratr a'2_ub ^+ a 2 :> algC. - exact: root_le_x. + have ge0a2 : 0 <= (a 2)%:Q%:C by rewrite ler0q. + suff step : (a 2)%:Q%:C <= a'2_ub%:C ^+ a 2 by rewrite root_le_x. (* below to be improved *) rewrite -rmorphX ler_rat /a'1_ub exprMn exprVn lter_pdivl_mulr ?exprn_gt0 //. rewrite a2. - set aval := (X in (Posz X)%:~R * _ ^+ X <= _ ^+ X). + set aval := (X in (Posz X)%:Q * _ ^+ X <= _ ^+ X). set p := (X in _ * (rat_of_Z X) ^+ _ <= _); set q := (X in _ * _ <= rat_of_Z X ^+ _). rewrite -subr_ge0 !exprnP; set rhs := (X in 0 <= X). @@ -607,15 +460,14 @@ have a'2_ubP : a' 2 <= a'2_ub%:C. suff -> : pos = 19718930047012279641%coqZ by exact: rat_of_Z_ZposW. by vm_compute. have a'3_ubP : a' 3 <= a'3_ub%:C. - have gt0a0 : (0 < a 3)%nat by apply: a_pos. + have gt0a0 : (0 < a 3)%N by apply: a_pos. have ge0a'1 : 0 <= a'3_ub%:C by rewrite ler0q divr_ge0. - have ge0a3 : 0 <= ratr (a 3)%:~R :> algC by rewrite ler0q. - suff step : ratr (a 3)%:~R <= ratr a'3_ub ^+ a 3 :> algC. - exact: root_le_x. + have ge0a3 : 0 <= (a 3)%:Q%:C by rewrite ler0q. + suff step : (a 3)%:Q%:C <= a'3_ub%:C ^+ a 3 by rewrite root_le_x. rewrite -rmorphX ler_rat /a'1_ub exprMn exprVn lter_pdivl_mulr; last first. by rewrite exprn_gt0. rewrite a3. - set aval := (X in (Posz X)%:~R * _ ^+ X <= _ ^+ X). + set aval := (X in (Posz X)%:Q * _ ^+ X <= _ ^+ X). set p := (X in _ * (rat_of_Z X) ^+ _ <= _); set q := (X in _ * _ <= rat_of_Z X ^+ _). rewrite -subr_ge0 !exprnP; set rhs := (X in 0 <= X). @@ -627,217 +479,98 @@ have a'3_ubP : a' 3 <= a'3_ub%:C. suff -> : pos = 13082865684162319442059723917554130432970820125555268741037120404410598256687652105894050330796735063217%coqZ by exact: rat_of_Z_ZposW. by vm_compute. have a'4_ubP : a' 4 <= a'4_ub%:C. - have gt0a0 : (0 < a 4)%nat by apply: a_pos. + have gt0a0 : (0 < a 4)%N by apply: a_pos. have ge0a'1 : 0 <= a'4_ub%:C by rewrite ler0q divr_ge0. - have ge0a4 : 0 <= ratr (a 4)%:~R :> algC by rewrite ler0q ler0z. - suff step : ratr (a 4)%:~R <= ratr a'4_ub ^+ a 4 :> algC. - exact: root_le_x. + have ge0a4 : 0 <= (a 4)%:Q%:C by rewrite ler0q ler0z. + rewrite root_le_x //. pose t : rat := (rat_of_Z 200)^-1. - have t_gt0 : 0 < t by rewrite /t invr_gt0 rat_of_Z_Zpos. - have t_ge0 : 0 <= t by exact: ltrW. + have t_gt0 : 0 < t by rewrite /t invr_gt0 rat_of_Z_Zpos. + have t_ge0 : 0 <= t by exact: ltW. have -> : a'4_ub = 1 + t. by rewrite /a'4_ub /t; rat_field; move/eqP; rewrite rat_of_Z_eq0 //. rewrite -rmorphX ler_rat a4 exprDn. - suff step : 1807%:~R <= \sum_(i < 8) 1 ^+ (1807 - i) * t ^+ i *+ 'C(1807, i). + suff step : 1807%:Q <= \sum_(i < 8) 1 ^+ (1807 - i) * t ^+ i *+ 'C(1807, i). have -> : (1808 = 8 + 1800)%N by []. rewrite big_split_ord /=; apply: ler_paddr; last by []. apply: sumr_ge0 => [] [i hi] _ /=; rewrite expr1n mul1r pmulrn_lge0. by apply: exprn_ge0 => //. by rewrite bin_gt0 -[1807]/(1799 + 8)%N leq_add2l. pose f k := t ^+ k *+ 'C(1807, k). - have bump0n i : bump 0 i = i.+1 by rewrite /bump /= add1n. + have bump0n i : bump 0 i = i.+1 by []. do 8! (rewrite big_ord_recl /= expr1n mul1r -/(f _) ?bump0n). rewrite big_ord0. set lhs := (X in _ <= X). - suff -> : lhs = (rat_of_Z 34077892883014859211)/ rat_of_Z 12800000000000000. + suff -> : lhs = rat_of_Z 34077892883014859211 / rat_of_Z 12800000000000000. rewrite lter_pdivl_mulr; last exact: rat_of_Z_Zpos. rewrite -rat_of_Z_of_nat rat_of_ZEdef -rat_of_Z_mul -subr_ge0 -rat_of_Z_sub. set x := (X in rat_of_Z_ X). compute in x. rewrite -rat_of_ZEdef; exact: rat_of_Z_ZposW. rewrite /lhs /f bin0 mulr1n bin1 expr0 expr1. have -> : t ^+ 7 *+ 'C(1807, 7) = t ^+ 7 * rat_of_Z 12337390971384003811. - rewrite -mulr_natr. congr (_ * _). rewrite -mulrz_nat natz. - rewrite -binz_nat_nat binzE // 7!factS. - set x := 1800`!. - set d := (X in X / _). - suff -> : d = - (rat_of_Z (1807 * (1806 * (1805 * (1804 * (1803 * (1802 * (1801)))))))) * x%:~R. - have : x%:~R <> 0 :> rat. - move/eqP; apply/negP; rewrite intr_eq0 eqz_nat /x; apply: lt0n_neq0. - exact: fact_gt0. - move: x {d} => x hx. - set f7 := (X in _ / (X * _)). - have -> : f7 = rat_of_Z 5040 by rewrite /f7 -rat_of_Z_of_nat. - rat_field. split; first by []. move/eqP; rewrite rat_of_Z_eq0; done. - have {d}-> : d = (1807 * 1806 * 1805 * 1804 * 1803 * 1802 * 1801)%N%:~R * x%:~R. - rewrite -[_%:~R * x %:~R]intrM /d; apply/eqP; rewrite eqr_int. - by set u := 1801; move: u {d} x => u x; rewrite -PoszM -!mulnA. - congr (_ * x%:~R); rewrite -rat_of_Z_of_nat. - set l := (X in rat_of_Z X = _). - set r := (X in _ = rat_of_Z X). - suff -> : l = r by []. - by rewrite {}/l {}/r !Nat2Z.inj_mul. + rewrite -mulr_natr pmulrn -binz_nat_nat binzE_ffact -ffactnn ffactE /=. + rewrite -!rat_of_Z_of_nat !Nat2Z.inj_mul; congr (_ * _). + apply: canLR (mulfK _) _; first by rewrite rat_of_ZEdef rat_of_Z_eq0. + by rewrite (erefl : _ * _ = (_ * _)%Q); case: rat_morph_Z => _ _ _ _ <- _ _. have -> : t ^+ 6 *+ 'C(1807, 6) = t ^+ 6 * rat_of_Z 47952102609488077. - rewrite -mulr_natr. congr (_ * _). rewrite -mulrz_nat natz. - rewrite -binz_nat_nat binzE // 6!factS. - set x := 1801`!. - set d := (X in X / _). - suff -> : d = - (rat_of_Z (1807 * (1806 * (1805 * (1804 * (1803 * (1802))))))) * x%:~R. - have : x%:~R <> 0 :> rat. - move/eqP; apply/negP; rewrite intr_eq0 eqz_nat /x; apply: lt0n_neq0. - exact: fact_gt0. - move: x {d} => x hx. - set f6 := (X in _ / (X * _)). - have -> : f6 = rat_of_Z 720 by rewrite /f6 -rat_of_Z_of_nat. - rat_field. split; first by []. move/eqP; rewrite rat_of_Z_eq0; done. - have {d}-> : d = (1807 * 1806 * 1805 * 1804 * 1803 * 1802)%N%:~R * x%:~R. - rewrite -[_%:~R * x %:~R]intrM /d; apply/eqP; rewrite eqr_int. - by set u := 1802; move: u {d} x => u x; rewrite -PoszM -!mulnA. - congr (_ * x%:~R); rewrite -rat_of_Z_of_nat. - set l := (X in rat_of_Z X = _). - set r := (X in _ = rat_of_Z X). - suff -> : l = r by []. - by rewrite {}/l {}/r !Nat2Z.inj_mul. + rewrite -mulr_natr pmulrn -binz_nat_nat binzE_ffact -ffactnn ffactE /=. + rewrite -!rat_of_Z_of_nat !Nat2Z.inj_mul; congr (_ * _). + apply: canLR (mulfK _) _; first by rewrite rat_of_ZEdef rat_of_Z_eq0. + by rewrite (erefl : _ * _ = (_ * _)%Q); case: rat_morph_Z => _ _ _ _ <- _ _. have -> : t ^+ 5 *+ 'C(1807, 5) = t ^+ 5 * rat_of_Z 159662938766331. - rewrite -mulr_natr. congr (_ * _). rewrite -mulrz_nat natz. - rewrite -binz_nat_nat binzE // 5!factS. - set x := 1802`!. - set d := (X in X / _). - suff -> : d = - (rat_of_Z (1807 * (1806 * (1805 * (1804 * (1803)))))) * x%:~R. - have : x%:~R <> 0 :> rat. - move/eqP; apply/negP; rewrite intr_eq0 eqz_nat /x; apply: lt0n_neq0. - exact: fact_gt0. - move: x {d} => x hx. - set f5 := (X in _ / (X * _)). - have -> : f5 = rat_of_Z 120 by rewrite /f5 -rat_of_Z_of_nat. - rat_field. split; first by []. move/eqP; rewrite rat_of_Z_eq0; done. - have {d}-> : d = (1807 * 1806 * 1805 * 1804 * 1803)%N%:~R * x%:~R. - rewrite -[_%:~R * x %:~R]intrM /d; apply/eqP; rewrite eqr_int. - by set u := 1803; move: u {d} x => u x; rewrite -PoszM -!mulnA. - congr (_ * x%:~R); rewrite -rat_of_Z_of_nat. - set l := (X in rat_of_Z X = _). - set r := (X in _ = rat_of_Z X). - suff -> : l = r by []. - by rewrite {}/l {}/r !Nat2Z.inj_mul. + rewrite -mulr_natr pmulrn -binz_nat_nat binzE_ffact -ffactnn ffactE /=. + rewrite -!rat_of_Z_of_nat !Nat2Z.inj_mul; congr (_ * _). + apply: canLR (mulfK _) _; first by rewrite rat_of_ZEdef rat_of_Z_eq0. + by rewrite (erefl : _ * _ = (_ * _)%Q); case: rat_morph_Z => _ _ _ _ <- _ _. have -> : t ^+ 4 *+ 'C(1807, 4) = t ^+ 4 * rat_of_Z 442770212885. - rewrite -mulr_natr. congr (_ * _). rewrite -mulrz_nat natz. - rewrite -binz_nat_nat binzE // 4!factS. - set x := 1803`!. - set d := (X in X / _). - suff -> : d = - (rat_of_Z (1807 * (1806 * (1805 * (1804))))) * x%:~R. - have : x%:~R <> 0 :> rat. - move/eqP; apply/negP; rewrite intr_eq0 eqz_nat /x; apply: lt0n_neq0. - exact: fact_gt0. - move: x {d} => x hx. - set f4 := (X in _ / (X * _)). - have -> : f4 = rat_of_Z 24 by rewrite /f4 -rat_of_Z_of_nat. - rat_field. split; first by []. move/eqP; rewrite rat_of_Z_eq0; done. - have {d}-> : d = (1807 * 1806 * 1805 * 1804)%N%:~R * x%:~R. - rewrite -[_%:~R * x %:~R]intrM /d; apply/eqP; rewrite eqr_int. - by set u := 1804; move: u {d} x => u x; rewrite -PoszM -!mulnA. - congr (_ * x%:~R); rewrite -rat_of_Z_of_nat. - set l := (X in rat_of_Z X = _). - set r := (X in _ = rat_of_Z X). - suff -> : l = r by []. - by rewrite {}/l {}/r !Nat2Z.inj_mul. - have -> : t ^+ 3 *+ 'C(1807, 3) = - t ^+ 3 * rat_of_Z 981752135. - rewrite -mulr_natr. congr (_ * _). rewrite -mulrz_nat natz. - rewrite -binz_nat_nat binzE // 3!factS. - set x := 1804`!. - set d := (X in X / _). - suff -> : d = (rat_of_Z (1807 * (1806 * (1805)))) * x%:~R. - have : x%:~R <> 0 :> rat. - move/eqP; apply/negP; rewrite intr_eq0 eqz_nat /x; apply: lt0n_neq0. - exact: fact_gt0. - move: x {d} => x hx. - set f3 := (X in _ / (X * _)). - have -> : f3 = rat_of_Z 6 by rewrite /f3 -rat_of_Z_of_nat. - rat_field. split; first by []. move/eqP; rewrite rat_of_Z_eq0; done. - have {d}-> : d = (1807 * 1806 * 1805)%N%:~R * x%:~R. - rewrite -[_%:~R * x %:~R]intrM /d; apply/eqP; rewrite eqr_int. - by set u := 1805; move: u {d} x => u x; rewrite -PoszM -!mulnA. - congr (_ * x%:~R); rewrite -rat_of_Z_of_nat. - set l := (X in rat_of_Z X = _). - set r := (X in _ = rat_of_Z X). - suff -> : l = r by []. - by rewrite {}/l {}/r !Nat2Z.inj_mul. - have -> : t ^+ 2 *+ 'C(1807, 2) = - t ^+ 2 * rat_of_Z 1631721. - rewrite -mulr_natr. congr (_ * _). rewrite -mulrz_nat natz. - rewrite -binz_nat_nat binzE // 2!factS. - set x := 1805`!. - set d := (X in X / _). - suff -> : d = (rat_of_Z (1807 * (1806 ))) * x%:~R. - have : x%:~R <> 0 :> rat. - move/eqP; apply/negP; rewrite intr_eq0 eqz_nat /x; apply: lt0n_neq0. - exact: fact_gt0. - move: x {d} => x hx. - set f2 := (X in _ / (X * _)). - have -> : f2 = rat_of_Z 2 by rewrite /f2 -rat_of_Z_of_nat. - rat_field. split; first by []. move/eqP; rewrite rat_of_Z_eq0; done. - have {d}-> : d = (1807 * 1806)%N%:~R * x%:~R. - rewrite -[_%:~R * x %:~R]intrM /d; apply/eqP; rewrite eqr_int. - by set u := 1806; move: u {d} x => u x; rewrite -PoszM -!mulnA. - congr (_ * x%:~R); rewrite -rat_of_Z_of_nat. - set l := (X in rat_of_Z X = _). - set r := (X in _ = rat_of_Z X). - suff -> : l = r by []. - by rewrite {}/l {}/r !Nat2Z.inj_mul. - have -> : t *+ 1807 = t * rat_of_Z 1807. - rewrite -mulr_natr; congr (_ * _). - by rewrite -mulrz_nat natz -rat_of_Z_of_nat. + rewrite -mulr_natr pmulrn -binz_nat_nat binzE_ffact -ffactnn ffactE /=. + rewrite -!rat_of_Z_of_nat !Nat2Z.inj_mul; congr (_ * _). + apply: canLR (mulfK _) _; first by rewrite rat_of_ZEdef rat_of_Z_eq0. + by rewrite (erefl : _ * _ = (_ * _)%Q); case: rat_morph_Z => _ _ _ _ <- _ _. + have -> : t ^+ 3 *+ 'C(1807, 3) = t ^+ 3 * rat_of_Z 981752135. + rewrite -mulr_natr pmulrn -binz_nat_nat binzE_ffact -ffactnn ffactE /=. + rewrite -!rat_of_Z_of_nat !Nat2Z.inj_mul; congr (_ * _). + apply: canLR (mulfK _) _; first by rewrite rat_of_ZEdef rat_of_Z_eq0. + by rewrite (erefl : _ * _ = (_ * _)%Q); case: rat_morph_Z => _ _ _ _ <- _ _. + have -> : t ^+ 2 *+ 'C(1807, 2) = t ^+ 2 * rat_of_Z 1631721. + rewrite -mulr_natr pmulrn -binz_nat_nat binzE_ffact -ffactnn ffactE /=. + rewrite -!rat_of_Z_of_nat !Nat2Z.inj_mul; congr (_ * _). + apply: canLR (mulfK _) _; first by rewrite rat_of_ZEdef rat_of_Z_eq0. + by rewrite (erefl : _ * _ = (_ * _)%Q); case: rat_morph_Z => _ _ _ _ <- _ _. + have -> : t *+ 1807 = t * rat_of_Z 1807. + by rewrite -mulr_natr -mulrz_nat natz -rat_of_Z_of_nat. rewrite /t !exprnP. rat_field. by split; move/eqP; rewrite rat_of_Z_eq0. -have {a'4_ubP} a'4_ubP : a' 4 ^+ 2 <= (a'4_ub ^ 2)%:C. +have {}a'4_ubP : a' 4 ^+ 2 <= (a'4_ub ^ 2)%:C. by rewrite CratrE /= exprSr expr1 ler_pmul ?a'_ge0. rewrite /w 4!rmorphM /=; do 4! (rewrite ler_pmul ?mulr_ge0 ?a'_ge0 //). - Qed. End Computations. Import Computations. +Hint Resolve w_gt0. +Hint Resolve w_ge0. + (* change name to make it not seem general *) -Lemma prod_is_exp_sum (n k : nat) (tenn : rat := (10 * n)%nat%:~R) : +Lemma prod_is_exp_sum (n k : nat) (tenn := (10 * n)%N%:Q) : \prod_(i < k.+1) exp_quo tenn (a i).-1 (a i) = tenn%:C ^+ k * exp_quo tenn 1 (a k.+1 - 1). Proof. elim: k => [|k ihk]; first by rewrite expr0 big_ord_recr big_ord0 /= !mul1r. have pos_tenn : 0 <= tenn by rewrite /tenn ler0n. have h l : tenn%:C ^+ l = exp_quo tenn l 1. - by rewrite -exp_quo_r_nat; repeat (rewrite -CratrE /=). -rewrite h -exp_quo_plus 1?subn_gt0 ?a_gt1 //. -rewrite big_ord_recr [a _]lock /= -lock. -have side : (0 < a k.+1 - 1)%nat by rewrite subn_gt0. + by rewrite -exp_quo_r_nat -!CratrE. +rewrite h -exp_quo_plus 1?subn_gt0 ?a_gt1 // big_ord_recr /=. +have side : (0 < a k.+1 - 1)%N by rewrite subn_gt0. rewrite ihk h -!exp_quo_plus // mul1n // [a k.+1]aS !subn1 /=. congr exp_quo; ring. Qed. -Hint Resolve w_ge0. -Hint Resolve w_gt0. -Hint Resolve w_seq_ge0. - -Hint Resolve aS_gt2. - -Lemma aSpred_gt1 k : (1 < (a k.+1).-1)%nat. -by rewrite -subn1 ltn_subRL addn1. -Qed. +Lemma aR_gt0 i : 0 < (a i)%:~R :> algC. +Proof. by rewrite ltr0n. Qed. -Hint Resolve aSpred_gt1. - -Lemma aR_gt0 i : 0 < ((a i)%:~R : algC). -Proof. -by rewrite ltr0n. -Qed. - -Lemma aR_ge0 i : 0 <= ((a i)%:~R : algC). -Proof. -by rewrite ler0n. -Qed. +Lemma aR_ge0 i : 0 <= (a i)%:~R :> algC. +Proof. by rewrite ler0n. Qed. Hint Resolve aR_gt0. Hint Resolve aR_ge0. @@ -845,213 +578,170 @@ Hint Resolve aR_ge0. Section PreliminaryRemarksTheorem2. (* We lost the %N delimiter for ssrnat operations *) -Lemma remark_t2_1 n k (Hank : (a k <= n < (a k.+1))%nat) : +Lemma remark_t2_1 n k (Hank : (a k <= n < a k.+1)%N) : (expn n n)%:Q%:C <= n%:Q%:C * exp_quo n%:Q (n * (a k.+1).-2) ((a k.+1).-1). Proof. -have HnaSk : (n <= (a k.+1).-1)%nat. +have HnaSk : (n <= (a k.+1).-1)%N. by rewrite -ltnS; case/andP: Hank. -have n_ge1 : (1 <= n)%nat. - case/andP: Hank => H1 _. - apply: leq_trans; first exact (a_pos 0). - by apply: leq_trans H1; rewrite a_grows. -have lt1sSk : (0 < ((a k.+1).-1))%nat. - by rewrite -subn1 subn_gt0 a_gt1. -have lt2sSk : (0 < ((a k.+1).-2))%nat. - by rewrite -subn2 subn_gt0 aS_gt2. +have n_ge1 : (1 <= n)%N. + by case/andP: Hank => H1 _; exact: leq_trans (a_pos _) H1. +have lt1sSk : (0 < (a k.+1).-1)%N by rewrite -subn1 subn_gt0 a_gt1. +have lt2sSk : (0 < (a k.+1).-2)%N by rewrite -subn2 subn_gt0 aS_gt2. rewrite -{3}[n]expn1 !exp_quo_nat_nat. -rewrite -exp_quo_plus // ?ler0n //. -have -> : exp_quo n%:~R n 1 = exp_quo n%:~R (n * ((a k.+1).-1)) ((a k.+1).-1). +rewrite -exp_quo_plus // ?ler0n //. +have -> : exp_quo n%:Q n 1 = exp_quo n%:Q (n * (a k.+1).-1) ((a k.+1).-1). by apply: exp_quo_equiv; rewrite ?ler0n ?muln1. rewrite muln1 mul1n; apply: exp_quo_lessn; rewrite ?ler1n // . -suff Hinterm : - ((n + n * (a k.+1).-2) <= ((a k.+1).-1 + n * (a k.+1).-2))%nat. - apply: leq_mul => // . - have {1}-> : ((a k.+1).-1 = (a k.+1).-2 + 1)%nat. - by rewrite -[in RHS]subn1 subnK. - rewrite addnC mulnDr leq_add 1?muln1 //. -exact: leq_add. +by apply: leq_mul; rewrite // -{1}[_.-1]prednK // -add1n mulnDr leq_add ?muln1. Qed. -Lemma remark_t2_2 k1: - \prod_(i < k1) exp_quo (a i)%:~R (a i).-1 (a i) = - (\prod_(i < k1) (a i)%:~R) / w_seq k1. - elim: k1 => [|k1 HIk1]. - by rewrite /w_seq !big_ord0 invr1 mulr1. - rewrite /w_seq 3!big_ord_recr /= HIk1 -!mulrA -/(w_seq k1). - congr (_ * _). - rewrite invrM 1?unitf_gt0 ?w_seq_gt0 ?a'_gt0 // . - rewrite mulrA mulrAC -mulrA mulrC -!mulrA; congr (_ * _). - rewrite /a' /exp_quo -rootCV ?ler0q ?ler0n // . - rewrite -subn1 GRing.exprB 1?rootCK 1?mulrC 1?CratrE /= 1?CratrE /= - ?unitf_gt0 ?rootC_gt0 ?ltr0n ?a_pos // ; congr (_ * _). - by rewrite rootCV -1?exprVn ?ler0n; try (exact: isT). +Lemma remark_t2_2 k1: + \prod_(i < k1) exp_quo (a i)%:Q (a i).-1 (a i) = + (\prod_(i < k1) (a i)%:~R) / w_seq k1. +Proof. +rewrite -prodfV -big_split /=; apply: eq_bigr => i _. +by rewrite /a' /exp_quo -subn1 expfB ?a_gt1 // rootCK ?a_pos ?CratrE. Qed. End PreliminaryRemarksTheorem2. -Theorem t2 n k (Hank : (a k <= n < (a k.+1))%nat) : +Theorem t2 n k (Hank : (a k <= n < (a k.+1))%N) : (C n k.+1)%:Q%:C < exp_quo (10%:Q * n%:Q) (2*k.+1 - 1) 2 * (w%:C ^+ n.+1). Proof. -have n_ge1 : (1 <= n)%nat. - case/andP: Hank => H1 _. - apply: leq_trans; first exact (a_pos 0). - by apply: leq_trans H1; rewrite a_grows. +have n_ge1 : (1 <= n)%N. + by case/andP: Hank => + _; apply/leq_trans/a_pos. have lt0nC : 0 < n%:Q%:C. by rewrite ltr0q ltr0n. -have le0nR : 0 <= n%:~R :> rat. +have le0nR : 0 <= n%:Q. by rewrite ler0n. -have le0nC : 0 <= ratr n%:~R :> algC. +have le0nC : 0 <= n%:Q%:C. by rewrite ler0q le0nR. have n_unit : n%:Q%:C \is a GRing.unit. - by rewrite unitf_gt0 //. -have H10_ge1 : 1 <= 10%:Q * n%:~R. + by rewrite unitf_gt0. +have H10_ge1 : 1 <= 10%:Q * n%:Q. by rewrite mulr_ege1 ?ler1n. have Hprod := (prod_is_exp_sum n k). have l10 := (l10 (proj1 (andP Hank))). -move: 10%nat H10_ge1 Hprod l10 => ten H10_ge1 Hprod l10. +move: 10%N H10_ge1 Hprod l10 => ten H10_ge1 Hprod l10. have H10n_ge0 : 0 <= ten%:Q * n%:Q by rewrite mulr_ge0 ?ler0n. set cn := (C _ _)%:Q%:C; set t10n_to := exp_quo (ten%:Q * n%:Q). -have Hexp_1_aS_ge0 : 0 <= t10n_to 1%nat (a k.+1).-1. +have Hexp_1_aS_ge0 : 0 <= t10n_to 1%N (a k.+1).-1. by rewrite exp_quo_ge0. -have t_pos a b : (0 < b)%nat -> 0 <= t10n_to a b. +have t_pos a b : (0 < b)%N -> 0 <= t10n_to a b. by move=> hb; rewrite /t10n_to; apply: exp_quo_ge0. -have wq_ge0 m : 0 <= w%:C ^+ m by rewrite exprn_ge0 // ler0q. have wq_gt0 m : 0 < w%:C ^+ m by rewrite exprn_gt0 // ltr0q. -suff step1 : cn < t10n_to (2 * k.+1 - 1)%nat 2 * w%:C ^+ n * w_seq k.+1. -apply: ltr_le_trans step1 _; rewrite -mulrA; apply: ler_pmul => //. +have wq_ge0 m : 0 <= w%:C ^+ m by exact/ltW. +suff step1 : cn < t10n_to (2 * k.+1 - 1)%N 2 * w%:C ^+ n * w_seq k.+1. +apply: lt_le_trans step1 _; rewrite -mulrA; apply: ler_pmul => //. + exact: t_pos. + apply: mulr_ge0 => //; exact: wq_pos. + by rewrite exprSr ler_pmul // w_upper_bounded. rewrite -mulrA; set tw := (X in _ < _ * X). have tw_pos : 0 <= tw by rewrite /tw; apply: mulr_ge0. -have tenn_to_pos : (0 : algC) <= ratr ((ten%:~R * n%:~R) ^+ k). +have tenn_to_pos : 0 <= ((ten%:Q * n%:Q) ^+ k)%:C. by rewrite ler0q exprn_ge0. suff step2 : cn < ((ten%:Q * n%:Q) ^+ k)%:C * - t10n_to 1%nat ((a k.+1).-1)%nat * tw. - apply: ltr_le_trans step2 _; apply: ler_pmul => // . - - by apply: mulr_ge0 => //; apply: t_pos. - - have step2_1 : t10n_to 1%nat (a k.+1).-1 <= - t10n_to 1%nat 2. - by rewrite exp_quo_lessn // !mul1n. - have -> : t10n_to (2 * k.+1 - 1)%nat 2 = - t10n_to (k)%nat 1%nat * t10n_to (1)%nat 2. + t10n_to 1%N ((a k.+1).-1)%N * tw. + apply: lt_le_trans step2 _; apply: ler_pmul => // . + - exact/mulr_ge0/t_pos. + - have ->: t10n_to (2 * k.+1 - 1)%N 2 = t10n_to (k)%N 1%N * t10n_to (1)%N 2. rewrite -exp_quo_plus //; apply:exp_quo_equiv => // . - by rewrite -[k.+1]addn1 mulnDr addn2 subn1 /= [(k * 2)%nat]mulnC addn1. - by apply: ler_pmul => // ; rewrite exp_quo_r_nat. -have -> : tw = - ratr w ^+ n * n%:Q%:C * (w_seq k.+1 / n%:Q%:C). - by rewrite [_ / _]mulrC mulrA mulrC -mulrA divrr // /tw mulr1 mulrC. -have Helper0 : (0 : algC) < \prod_(i < k.+1) (a i)%:~R. - by rewrite prodr_gt0. -have Helper1 : (\prod_(i < k.+1) (a i)%:~R : algC) \is a GRing.unit. - by rewrite unitf_gt0 //. -have Helper2 : 0 < \prod_(i < k.+1) a' i. - by rewrite prodr_gt0. -have Helper3 : (\prod_(i < k.+1) a' i) \is a GRing.unit. - by rewrite unitf_gt0 //. -have Helper4 : (\prod_(i < k.+1) a' i)^-1 \is a GRing.unit. - by rewrite GRing.unitrV. -have step3 : (w_seq k.+1 / ratr n%:~R) >= - (\prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i))^-1. - rewrite remark_t2_2 /w_seq invrM // invrK . + by rewrite -[k.+1]addn1 mulnDr addn2 subn1 /= [(k * 2)%N]mulnC addn1. + apply/ler_pmul => //; first by rewrite exp_quo_r_nat. + by rewrite exp_quo_lessn // !mul1n. +have ->: tw = w%:C ^+ n * n%:Q%:C * (w_seq k.+1 / n%:Q%:C). + by rewrite mulrACA divrr // mulr1. +have Helper0 : 0 < \prod_(i < k.+1) (a i)%:~R :> algC by rewrite prodr_gt0. +have Helper1 : 0 < \prod_(i < k.+1) a' i by rewrite prodr_gt0. +have step3 : w_seq k.+1 / n%:Q%:C >= + (\prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i))^-1. + rewrite remark_t2_2 /w_seq invfM // invrK mulrC. rewrite ler_pdivr_mulr // -mulrA ler_pmulr // mulrC ler_pdivl_mulr // mul1r. - case/andP: Hank => _; rewrite a_rec => H; rewrite -prodMz. - rewrite CratrE /= CratrE /= ler_nat. - by rewrite big_mkord addn1 ltnS in H. -have ler0_10npow : 0 <= ratr ((ten%:~R * n%:~R) ^+ k) * - t10n_to 1%nat (a k.+1).-1. + case/andP: Hank => _; rewrite a_rec addn1 ltnS big_mkord => H. + by rewrite -prodMz 2!CratrE ler_nat. +have ler0_10npow : 0 <= ((ten%:Q * n%:Q) ^+ k)%:C * t10n_to 1%N (a k.+1).-1. by rewrite mulr_ge0. -have t_ge0_0 : 0 <= \prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i). +have t_ge0_0 : 0 <= \prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i). by rewrite prodr_ge0 // => i _; rewrite exp_quo_ge0 // ler0n. -have t_ge0_1 : 0 <= (\prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i))^-1. +have t_ge0_1 : 0 <= (\prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i))^-1. by rewrite invr_ge0. -have t_ge0_2 : (0 : algC) <= ratr w ^+ n * ratr n%:~R. - rewrite mulr_ge0 //. +have t_ge0_2 : 0 <= w%:C ^+ n * n%:Q%:C. + by rewrite mulr_ge0. have t_ge0_3 : 0 <= - ratr w ^+ n * ratr n%:~R / - \prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i). + w%:C ^+ n * n%:Q%:C / \prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i). by rewrite mulr_ge0 // invr_ge0. -have t_ge0_4 : 0 < exp_quo n%:~R (n * (a k.+1).-2) (a k.+1).-1. +have t_ge0_4 : 0 < exp_quo n%:Q (n * (a k.+1).-2) (a k.+1).-1. by rewrite exp_quo_gt0 // ltr0n. -have t_ge0_5 : 0 < (exp_quo n%:~R (n * (a k.+1).-2) (a k.+1).-1)^-1. +have t_ge0_5 : 0 < (exp_quo n%:Q (n * (a k.+1).-2) (a k.+1).-1)^-1. by rewrite invr_gt0. -have t_ge0_6 : (0 : algC) <= ratr (n ^ n)%nat%:~R. +have t_ge0_6 : 0 <= (n ^ n)%N%:Q%:C. by rewrite ler0q ler0n. -have t_ge0_7 : 0 <= ratr w ^+ n * - (ratr (n ^ n)%nat%:~R / exp_quo n%:~R (n * (a k.+1).-2) (a k.+1).-1) / - \prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i). - by rewrite mulr_ge0 // mulr_ge0 // mulr_ge0 // invr_ge0 // ltrW. +have t_ge0_7 : 0 <= w%:C ^+ n * + ((n ^ n)%N%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2) (a k.+1).-1) / + \prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i). + by rewrite mulr_ge0 // mulr_ge0 // mulr_ge0 // invr_ge0 // ltW. have t_ge0_8 : 0 <= (w_seq k.+1) ^+ n. by rewrite exprn_ge0. -have t_ge0_9 : 0 <= +have t_ge0_9 : 0 <= w_seq k.+1 ^+ n * - (ratr (n ^ n)%nat%:~R / exp_quo n%:~R (n * (a k.+1).-2) (a k.+1).-1). + ((n ^ n)%N%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2) (a k.+1).-1). by rewrite mulr_ge0 // divr_ge0 // exp_quo_ge0 // ler0n. -have t_ge0_10 : 0 <= +have t_ge0_10 : 0 <= w_seq k.+1 ^+ n * - (ratr (n ^ n)%nat%:~R / exp_quo n%:~R (n * (a k.+1).-2) (a k.+1).-1) / - \prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i). - by rewrite mulr_ge0 // mulr_ge0 // ltrW // . + ((n ^ n)%N%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2) (a k.+1).-1) / + \prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i). + by rewrite mulr_ge0 // mulr_ge0 // ltrW. have Hbound : - (expn n n)%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2)%nat ((a k.+1).-1) <= n%:Q%:C. + (expn n n)%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2)%N ((a k.+1).-1) <= n%:Q%:C. by rewrite ler_pdivr_mulr //; exact: (remark_t2_1 Hank). -suff step4 : cn < ratr ((ten%:~R * n%:~R) ^+ k) * t10n_to 1%nat (a k.+1).-1 * +suff step4 : cn < ((ten%:Q * n%:Q) ^+ k)%:C * t10n_to 1%N (a k.+1).-1 * ((w_seq k.+1) ^+ n * - ((n ^ n)%nat%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2)%nat ((a k.+1).-1)) / - (\prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i))). - apply: ltr_le_trans step4 _. apply: ler_pmul => // . - apply: ler_pmul => // . - apply: ler_pmul => // ; first by rewrite mulr_ge0 // ltrW . -rewrite ler_expn2r //. - by rewrite nnegrE. - by rewrite nnegrE ler0q. - exact: w_upper_bounded. -have other_prod_is_exp_sum k1 : \prod_(i < k1.+1) exp_quo (n%:~R) n (a i) - = exp_quo n%:~R (n * (a k1.+1).-2) (a k1.+1).-1. + ((n ^ n)%N%:Q%:C / exp_quo n%:Q (n * (a k.+1).-2)%N ((a k.+1).-1)) / + (\prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i))). + apply: lt_le_trans step4 _; apply/ler_pmul/ler_pmul/step3/ler_pmul => //. + by rewrite mulr_ge0 // ltW. + by apply/ler_expn2r/w_upper_bounded; rewrite nnegrE // ler0q. +have other_prod_is_exp_sum k1 : \prod_(i < k1.+1) exp_quo (n%:Q) n (a i) + = exp_quo n%:Q (n * (a k1.+1).-2) (a k1.+1).-1. elim: k1 => [|k1 HIk1]. by rewrite big_ord_recr big_ord0 /= mul1r muln1; congr exp_quo. - rewrite [a _.+1]lock big_ord_recr /= -lock HIk1 -exp_quo_plus //=; last first. + rewrite big_ord_recr /= HIk1 -exp_quo_plus //=; last first. by rewrite muln_gt0; apply/andP. apply: exp_quo_equiv => //=. - - by rewrite muln_gt0 andbT muln_gt0; apply /andP. + - by rewrite muln_gt0 andbT muln_gt0; apply/andP. - by rewrite muln_gt0 /= muln_gt0; apply/andP. - set x := (a k1 * (a k1).-1).-1%nat. - have -> : (a k1 * ((a k1).-1) = x.+1)%nat. + set x := (a k1 * (a k1).-1).-1%N. + have -> : (a k1 * ((a k1).-1) = x.+1)%N. by rewrite /x prednK // muln_gt0; apply/andP. - have -> /= : ((x.+2 * x.+1) = (x^2 + 3*x).+2)%nat by ring. - (* This call to ring fails if we do not confine the previous -'Import ZArith' in a module... *) - ring. + rewrite -mulnA -mulnDr; congr (_ * _ * _)%N; last by rewrite mulnC. + by apply/esym; rewrite mulnS addSn /= addnC mulnC. rewrite -other_prod_is_exp_sum. rewrite /t10n_to. -have -> : - ratr ((ten%:~R * n%:~R) ^+ k) * exp_quo (ten%:~R * n%:~R) 1 (a k.+1).-1 = - \prod_(i < k.+1) exp_quo (ten%:~R * n%:~R) (a i).-1 (a i). - rewrite -rmorphM /= Hprod; congr (_ * _). - by rewrite !CratrE /= . - by rewrite subn1. +have -> : ((ten%:Q * n%:Q) ^+ k)%:C * exp_quo (ten%:Q * n%:Q) 1 (a k.+1).-1 = + \prod_(i < k.+1) exp_quo (ten%:Q * n%:Q) (a i).-1 (a i). + by rewrite -rmorphM /= Hprod !CratrE subn1. set rhs := (X in _ < X). -suff Hfinal : rhs = (n ^ n)%nat%:Q %:C * +suff Hfinal : rhs = (n ^ n)%N%:Q %:C * \prod_(i < k.+1) exp_quo (ten%:Q * n%:Q / (a i)%:Q) (a i).-1 (a i) / \prod_(i < k.+1) exp_quo (n%:Q / (a i)%:Q) n (a i). rewrite Hfinal {Hfinal}. case/andP: Hank => Hle Hlt. exact: l10. rewrite /rhs /w_seq. -rewrite mulrAC [ratr (n ^ n)%nat%:~R / _]mulrC 2!mulrA. +rewrite mulrAC [ratr (n ^ n)%N%:Q / _]mulrC 2!mulrA. rewrite -[in RHS]mulrA [in RHS]mulrC . -congr (_ * ratr (n ^ n)%nat%:~R). +congr (_ * ratr (n ^ n)%N%:Q). rewrite [_ ^+ n / _]mulrC mulrA. -have ai_pos i : 0 < (a i)%:~R by rewrite ltr0n. -have ai_ge0 i : 0 <= (a i)%:~R by rewrite ler0n. -have ->: \prod_(i < k.+1) exp_quo (ten%:~R * n%:~R) (a i).-1 (a i) / - \prod_(i < k.+1) exp_quo (a i)%:~R (a i).-1 (a i) = - \prod_(i < k.+1) exp_quo (ten%:~R * n%:~R / (a i)%:~R) (a i).-1 (a i). +have ai_pos i : 0 < (a i)%:Q by rewrite ltr0n. +have ai_ge0 i : 0 <= (a i)%:Q by rewrite ler0n. +have ->: \prod_(i < k.+1) exp_quo (ten%:Q * n%:Q) (a i).-1 (a i) / + \prod_(i < k.+1) exp_quo (a i)%:Q (a i).-1 (a i) = + \prod_(i < k.+1) exp_quo (ten%:Q * n%:Q / (a i)%:Q) (a i).-1 (a i). rewrite -prodf_div; apply: eq_bigr => i _. - have en0 : exp_quo (a i)%:~R (a i).-1 (a i) != 0. - by rewrite eq_sym; apply: ltr_neq; apply: exp_quo_gt0. + have en0 : exp_quo (a i)%:Q (a i).-1 (a i) != 0. + by rewrite eq_sym; apply/ltr_neq/exp_quo_gt0. apply: (canLR (mulfK en0)). by rewrite exp_quo_mult_distr // mulfVK // eq_sym ltr_neq. rewrite -mulrA; congr (_ * _). @@ -1064,62 +754,52 @@ by rewrite CratrE /= -/x mulrC. Qed. -Theorem t2_rat n k (Hank : (a k <= n < (a k.+1))%nat) : +Theorem t2_rat n k (Hank : (a k <= n < (a k.+1))%N) : (C n k.+1)%:Q < (10%:Q * n%:Q) ^ k.+1 * (w ^+ n.+1). Proof. -suff : ratr (C n k.+1)%:~R < - exp_quo (10%:~R * n%:~R) (2 * k.+1) 2 * ratr w ^+ n.+1. +suff : (C n k.+1)%:Q%:C < exp_quo (10%:Q * n%:Q) (2 * k.+1) 2 * w%:C ^+ n.+1. by rewrite /exp_quo exprM sqrtCK -!rmorphX /= -rmorphM /= ltr_rat. have {Hank} t2 := t2 Hank. -apply: ltr_le_trans t2 _; apply: ler_pmul => //. -- apply: exp_quo_ge0; first by []. - by apply: mulr_ge0; exact:ler0z. +apply: lt_le_trans t2 _; apply: ler_pmul => //. +- by apply: exp_quo_ge0; last by exact/mulr_ge0/ler0z. - by apply: exprn_ge0; rewrite ler0q. case: n => [| n]; first by rewrite mulr0 !exp_quo_0 /= mulnC muln2. -apply: exp_quo_lessn=> //; first by rewrite -rmorphM /= -[1]/(1%:~R) ler_nat. +apply: exp_quo_lessn=> //; first by rewrite -rmorphM /= -[1]/(1%:Q) ler_nat. by rewrite leq_mul2r leq_subr orbT. Qed. -Lemma w_ge1 : (1 <= w). -Proof. apply: ltrW. exact: w_gt1. Qed. - -Hint Resolve w_ge1. - -Lemma better_k_bound n k (Hank : (a k <= n < (a k.+1))%nat) : - (k <= trunc_log 2 (trunc_log 2 n) + 2)%nat. +Lemma better_k_bound n k (Hank : (a k <= n < a k.+1)%N) : + (k <= trunc_log 2 (trunc_log 2 n) + 2)%N. Proof. case: k Hank => [| k] //; case: k => [| k Hank]; last exact: k_bound. by rewrite addn2. Qed. -Delimit Scope nat_scope with ssrN. - Theorem t3_nat : exists (K : nat), - (0 < K)%nat /\ forall n : nat, (iter_lcmn n <= K * 3 ^ n)%nat. + (0 < K)%N /\ forall n : nat, (iter_lcmn n <= K * 3 ^ n)%N. Proof. -pose cond n k := (a k <= n < (a k.+1))%nat. +pose cond n k := (a k <= n < a k.+1)%N. suff [K [Kpos KP]] : exists (K : nat), - (0 < K)%nat /\ (forall n k, cond n k -> C n k.+1 <= K * 3 ^ n)%nat. + (0 < K)%N /\ (forall n k, cond n k -> C n k.+1 <= K * 3 ^ n)%N. exists K; split => // n; case: (leqP n 1)=> hn; last first. apply: leq_trans (KP _ (f_k n) _); first exact: lcm_leq_Cnk. exact: n_between_a. case: n hn => [_ | n]; first by rewrite expn0 muln1 iter_lcmn0. by case: n => // _; rewrite iter_lcmn1 expn1 muln_gt0 Kpos. suff [K [Kpos KP]] : exists K : rat, - (0 < K) /\ forall n k, cond n k -> (C n k.+1)%:R <= K * 3%:R ^ n. + (0 < K) /\ forall n k, cond n k -> (C n k.+1)%:R <= K * 3%:R ^ n. have := floorQ_spec K. - move/floorQ_ge0: (ltrW Kpos); case: (floorQ K) => k // _ /andP[_ leKSn]. - exists k.+1; split=> // n m /KP {KP} KP. - suff: (C n m.+1)%:R <= (k%:~R + 1) * 3%:R ^ n :> rat. + move/floorQ_ge0: (ltW Kpos); case: (floorQ K) => k // _ /andP[_ leKSn]. + exists k.+1; split=> // n m {}/KP KP. + suff: (C n m.+1)%:R <= (k%:Q + 1) * 3%:R ^ n. by rewrite -[_ + 1%:R]natrD -[_ ^ n]natrX -natrM ler_nat addn1. - apply: ler_trans KP _. apply: ler_wpmul2r; (* booo *) first exact: exprz_ge0. - exact: ltrW. -pose m : rat := locked 10%:~R. + exact/le_trans/ler_wpmul2r/ltW/leKSn/exprz_ge0. +pose m : rat := locked 10%:Q. have lt0m : 0 < m by rewrite /m -lock. -have le0m : 0 <= m by exact: ltrW. +have le0m : 0 <= m by exact: ltW. have lt1m : 1 < m by rewrite /m -lock. -have le1m : 1 <= m by exact: ltrW. -have mE : m = 10%:~R by rewrite /m -lock. +have le1m : 1 <= m by exact: ltW. +have mE : m = 10%:Q by rewrite /m -lock. pose eps : rat := locked (w / 3%:R). have epsE : eps = w / 3%:R by rewrite /eps -lock. have lt0eps1 : 0 < eps < 1. @@ -1127,34 +807,33 @@ have lt0eps1 : 0 < eps < 1. pose u n k eps := (m * n%:R) ^ k.+1 * eps ^ n.+1 : rat. suff hloglog : exists (K : rat), (0 < K) /\ (forall n k, cond n k -> u n k eps < K). have [K [lt0K KP]] := hloglog. - exists (K * 3%:~R); split; first by exact: mulr_gt0. + exists (K * 3%:Q); split; first by exact: mulr_gt0. move=> n k hcond. - apply: ler_trans (ltrW (t2_rat hcond)) _; rewrite -mulrA -exprSz. + apply: le_trans (ltW (t2_rat hcond)) _; rewrite -mulrA -exprSz. rewrite -ler_pdivr_mulr; last by exact: exprz_gt0. - rewrite -mulrA -expr_div_n -mE -epsE; apply: ltrW; exact: KP. + rewrite -mulrA -expr_div_n -mE -epsE; apply: ltW; exact: KP. have [lt0eps lteps1] := andP lt0eps1. pose loglog n := trunc_log 2 (trunc_log 2 n). pose v n : rat := (m * n%:R) ^ (loglog n).+3 * eps ^ n.+1. have le0v n : 0 <= v n. by rewrite /v pmulr_lge0 ?exprz_gt0 // exprz_ge0 // mulr_ge0 // ler0n. suff {u} [K [Kpos KP]] : exists K : rat, 0 < K /\ forall n, v n < K. - exists K; split => // n k /better_k_bound hkn; apply: ler_lt_trans (KP n). + exists K; split => // n k /better_k_bound hkn; apply: le_lt_trans (KP n). rewrite /u /v ler_pmul2r; last by apply: exprz_gt0. case: n hkn => [| n] hkn; first by rewrite mulr0 !exp0rz. apply: exp_incr_expp; first by apply: mulr_ege1=> //; rewrite ler1n. by rewrite ltnS -addn2. -have h1 n : ((trunc_log 2 n).+1 <= 2 ^ (loglog n).+1)%nat by exact: trunc_log_ltn. -have {h1} h1 n : (n < 2 ^ (2 ^ (loglog n).+1))%nat. - have h : (n < 2 ^ (trunc_log 2 n).+1)%nat by exact: trunc_log_ltn. - have {h} h : (2 ^ (trunc_log 2 n).+1 <= 2 ^ (2 ^ (loglog n).+1))%nat by rewrite leq_exp2l. - apply: leq_trans h; exact: trunc_log_ltn. -have h2 n : (1 < n)%nat -> (2 ^ (2 ^ (loglog n)) <= n)%nat. +have h1 n : ((trunc_log 2 n).+1 <= 2 ^ (loglog n).+1)%N by exact: trunc_log_ltn. +have {}h1 n : (n < 2 ^ (2 ^ (loglog n).+1))%N. + have h : (n < 2 ^ (trunc_log 2 n).+1)%N by exact: trunc_log_ltn. + have {}h : (2 ^ (trunc_log 2 n).+1 <= 2 ^ (2 ^ (loglog n).+1))%N by rewrite leq_exp2l. + exact/leq_trans/h/trunc_log_ltn. +have h2 n : (1 < n)%N -> (2 ^ (2 ^ (loglog n)) <= n)%N. move=> lt1n. - have lt0n : (0 < n)%nat by apply: ltn_trans lt1n. - have h : (2 ^ (trunc_log 2 n) <= n)%nat by apply: trunc_logP. - apply: leq_trans h; rewrite leq_exp2l // /w; apply: trunc_logP=> //. - by apply: trunc_log_max. -pose y n := (2 ^ 2 ^ (loglog n).+1)%nat; pose x n := (2 ^ 2 ^ (loglog n))%nat. + have h: (2 ^ trunc_log 2 n <= n)%N by apply/trunc_logP/ltnW. + apply: leq_trans h; rewrite leq_exp2l; last by []. + exact/trunc_logP/trunc_log_max. +pose y n := (2 ^ 2 ^ (loglog n).+1)%N; pose x n := (2 ^ 2 ^ loglog n)%N. pose t n := (m * (y n)%:R) ^ (loglog n).+3 * eps ^ (x n).+1. have le0y n : 0 <= (y n)%:R :> rat by rewrite ler0n. suff {v le0v} [K [Kpos KP]] : exists K : rat, 0 < K /\ forall n, t n < K. @@ -1165,14 +844,13 @@ suff {v le0v} [K [Kpos KP]] : exists K : rat, 0 < K /\ forall n, t n < K. rewrite leq_eqVlt ltnS leqn0; case/orP=> /eqP->; rewrite /KK. - by rewrite cpr_add ltr_spaddl. - by rewrite addrAC cpr_add ltr_spaddl. - exists KK; split => // n. - case: (leqP n 1%N)=> [le1n | lt1n]; first exact: ltvKK. - apply: ltr_le_trans ltKKK. - apply: ler_lt_trans (KP n); rewrite /v /t. + exists KK; split => // n. + have [le1n | lt1n] := leqP n 1%N; first exact: ltvKK. + apply/lt_le_trans/ltKKK/le_lt_trans/(KP n); rewrite /v /t. (* use case for posreal-style automation... *) apply: ler_pmul. - apply: exprz_ge0; rewrite pmulr_rge0 //; exact: ler0n. - - by apply: exprz_ge0; apply: ltrW. + - by apply: exprz_ge0; apply: ltW. - apply: ler_expn2r; last first. apply: ler_wpmul2l=> //; rewrite ler_nat ltnW //; exact: h1. + by rewrite rpredM // rpred_nat. @@ -1180,147 +858,142 @@ suff {v le0v} [K [Kpos KP]] : exists K : rat, 0 < K /\ forall n, t n < K. - by apply: exp_incr_expn=> //; rewrite /x ltnS; apply: h2. pose u n := (m * (x n)%:R) ^+ (2 * (loglog n).+3) * eps ^ (x n). suff {t y le0y} [K [Kpos KP]] : exists K : rat, 0 < K /\ forall n, u n < K. - exists K; split => // n. apply: ler_lt_trans (KP n); rewrite {KP} /u /t. + exists K; split => // n. apply: le_lt_trans (KP n); rewrite {KP} /u /t. apply: ler_pmul. - by apply: exprz_ge0; rewrite pmulr_rge0 // ler0n. - - by apply: exprz_ge0; apply: ltrW. + - by apply: exprz_ge0; apply: ltW. - rewrite exprnP PoszM -exprz_exp; apply: ler_expn2r. + by apply: rpredM => //; apply: rpred_nat. + by apply: rpredX; apply: rpredM => //; apply: rpred_nat. - rewrite expfzMl; apply: ler_pmul=> //; first by apply: ler_eexpr. by rewrite -exprnP -natrX ler_nat /x /y expnS mulnC expnM. - - rewrite -exprnP exprSr; apply: ler_pimulr; last by apply: ltrW. - apply: exprn_ge0; exact: ltrW. -have {h2} h2 n : (1 < n)%N -> (x n <= n)%N by apply: h2. -pose alpha n := (2 ^ 2 ^ n)%nat. + - rewrite -exprnP exprSr; apply: ler_pimulr; last by apply: ltW. + apply: exprn_ge0; exact: ltW. +have {}h2 n : (1 < n)%N -> (x n <= n)%N by apply: h2. +pose alpha n := (2 ^ 2 ^ n)%N. have le0alpha n : 0 <= (alpha n)%:R :> rat by rewrite ler0n. -have lt_0_alpha n : (0 < alpha n)%nat by rewrite /alpha expn_gt0. +have lt_0_alpha n : (0 < alpha n)%N by rewrite /alpha expn_gt0. pose t n := (m * (alpha n)%:R) ^ (2 * n.+3)%:Z * eps ^ alpha n. have lt_0_t n : 0 < t n. - rewrite /t; apply: mulr_gt0; apply: exprz_gt0=> //. - by apply: mulr_gt0 => //; rewrite ltr0n. -have le_0_t n : 0 <= t n by exact: ltrW. + by apply/mulr_gt0/exprz_gt0/lt0eps/exprz_gt0/mulr_gt0; rewrite ?ltr0n. +have le_0_t n : 0 <= t n by exact: ltW. suff {x h1 h2 u} [K [Kpos KP]] : exists K : rat, 0 < K /\ forall n, t n < K. - by exists K; split => // n; apply: ler_lt_trans (KP (loglog n)). + by exists K; split => // n; apply: le_lt_trans (KP (loglog n)). pose l n := (alpha n)%:R ^ 4 * eps ^ ((alpha n)%:Z ^ 2 - 2%:Z * (alpha n)%:Z). -have alphaS n : (alpha n.+1 = (alpha n) ^ 2)%nat. +have alphaS n : (alpha n.+1 = (alpha n) ^ 2)%N. by rewrite /alpha expnS mulnC expnM. have le_0_alpham2 k : 0 <= (alpha k)%:Z - 2%:Z. - rewrite /alpha; apply: (@ler_trans _ ((2 ^ 2 ^ 0)%:Z - 2%:Z)) => //. + rewrite /alpha; apply: (@le_trans _ _ ((2 ^ 2 ^ 0)%:Z - 2%:Z)) => //. by apply: ler_sub=> //; rewrite lez_nat leq_exp2l // leq_exp2l. -have maj_t n : t n.+1 <= (t n) ^ 2 * (l n). +have maj_t n : t n.+1 <= t n ^ 2 * l n. rewrite /t 2!expfzMl !exprz_exp expfzMl -2!mulrA -[_ * _ * l n]mulrA. apply: ler_pmul; first exact: exprz_ge0. (* missing posreal... *) - - apply: mulr_ge0; apply: exprz_ge0 => //; exact: ltrW. + - apply: mulr_ge0; apply: exprz_ge0 => //; exact: ltW. - apply: exp_incr_expp => //. - by rewrite -mulnA leq_pmul2l -[X in (X < _)%nat]muln1 // ltn_pmul2l. + by rewrite -mulnA leq_pmul2l -[X in (X < _)%N]muln1 // ltn_pmul2l. rewrite /l mulrCA 2!mulrA -exprzD_nat -mulrA -expfzDr; last exact: lt0r_neq0. apply: ler_pmul; first exact: exprz_ge0. (* missing posreal... *) - - apply: exprz_ge0; exact: ltrW. + - apply: exprz_ge0; exact: ltW. - rewrite alphaS natrX exprnP exprz_exp; apply: exp_incr_expp. by rewrite -[1]/(1%:R) ler_nat /alpha expn_gt0. - have -> : (4 + 2 * n.+3 * 2 = 2 * (2 + n.+3 * 2))%nat by rewrite mulnDr mulnA. - by rewrite leq_mul2l //= -[_.+4]addn1 addnC mulnDr [(_ * _.+3)%nat]mulnC. + by rewrite mulnAC mulnA -mulnS. - set a := (X in _ <= eps ^ X). have -> : a = (alpha n ^ 2)%:Z by rewrite /a addrCA mulrC addrN addr0. by rewrite alphaS. have le_0_l n : 0 <= l n. rewrite /l; apply: mulr_ge0; first by apply/exprz_ge0/ler0n. - by apply/exprz_ge0/ltrW. + by apply/exprz_ge0/ltW. case: rat_morph_Z => m0 m1 madd msub mmul mopp _. -pose eps1 := locked (rat_of_Z 5949909309448377). -(* Import ZArith. *) -pose eps2 := locked (rat_of_Z ( 6 * (10 ^ 15))%coqZ). -have lt0eps2 : 0 < eps2 by rewrite /eps2 -lock; exact: rat_of_Z_Zpos. +pose eps1 := rat_of_Z 5949909309448377. +pose eps2 := rat_of_Z (6 * 10 ^ 15). +have lt0eps2 : 0 < eps2 by exact: rat_of_Z_Zpos. have eps2_val : eps2 = 3%:R * rat_of_Z (2 * 10 ^ 15). - rewrite /eps2 -lock -[6%coqZ]/(3%coqZ * 2%coqZ)%coqZ -Z.mul_assoc mmul. - by rewrite -[3%coqZ]/(Z.of_nat 3) rat_of_Z_of_nat. + rewrite /eps2 -[6%coqZ]/(3 * 2)%coqZ -Z.mul_assoc mmul. + by rewrite -[3%coqZ]/(Z.of_nat 3) rat_of_Z_of_nat. have epsF : eps = eps1 / eps2. - by rewrite /eps -lock eps2_val invfM [RHS]mulrA [RHS]mulrAC w_val /eps1 -lock. -have a3 : (alpha 3 = (expn 2 8)) by []. -have lt_l3_1 : l 3%ssrN <= 1. - have -> : l 3%nat = (2%:R * eps ^ (2%:R ^ 3 * ((alpha 3)%:R - 2%:R))) ^ (2 ^ 5)%ssrN%:R. + by rewrite /eps -lock eps2_val invfM [RHS]mulrA [RHS]mulrAC w_val. +have a3 : alpha 3 = expn 2 8 by []. +have lt_l3_1 : l 3%N <= 1. + have -> : l 3%N = (2%:R * eps ^ (2%:R ^ 3 * ((alpha 3)%:R - 2%:R))) ^ (2 ^ 5)%N%:R. rewrite expfzMl -exprnP -natrX. set x := _%:R ^ _%:R. have -> : x = (alpha 3)%:R ^ 4 :> rat. rewrite -exprnP -natrX {}/x natz -exprnP -natrX. set x := (X in X%:R = _). set y := (X in _ = X%:R). (* (* rewrite [x]lock; rewrite [y]lock. congr (_%:R). stack overflow *) *) suff -> : x = y by move: x y. - by rewrite {}/x {}/y a3 -expnM; congr (expn _ _). - by rewrite exprz_exp /l; congr (_ * eps ^ _). (* slow line *) - rewrite expr_le1 //; last by rewrite pmulr_rge0 // exprz_ge0 //; exact: ltrW. + by rewrite {}/x {}/y a3 -expnM; congr (expn _ _). + by rewrite [X in _ = _ * X]exprz_exp /l; congr (_ * eps ^ _). (* slow line *) + rewrite expr_le1 //; last by rewrite pmulr_rge0 // exprz_ge0 //; exact: ltW. have small_calc : 2%:R * eps ^ 90%N <= 1. - rewrite epsF expfzMl mulrA -expfV ler_pdivr_mulr; last exact: exprz_gt0. - rewrite mul1r -subr_ge0. - have -> : eps2 ^ 90%ssrN - 2%:R * eps1 ^ 90%N = rat_of_Z - ((BinInt.Z.pow (6 * 10 ^ 15) 90) - 2 * (BinInt.Z.pow 5949909309448377 90)). - rewrite msub mmul -[90%coqZ]/(Z.of_nat 90) !rat_of_Z_pow; congr (_ - _). - - by rewrite /eps2 -lock. - - by rewrite -[2%coqZ]/(Z.of_nat 2) rat_of_Z_of_nat /eps1 -lock. + rewrite epsF expfzMl mulrA -expfV ler_pdivr_mulr; last exact: exprz_gt0. + rewrite mul1r -subr_ge0. + have -> : eps2 ^ 90 - 2%:R * eps1 ^ 90 = + rat_of_Z ((6 * 10 ^ 15) ^ 90 - 2 * 5949909309448377 ^ 90). + rewrite msub mmul -[90%coqZ]/(Z.of_nat 90) !rat_of_Z_pow; congr (_ - _). + by rewrite -[2%coqZ]/(Z.of_nat 2) rat_of_Z_of_nat. vm_compute; exact: rat_of_Z_ZposW. - apply: ler_trans small_calc. rewrite ler_pmul2l; last by []. + apply: le_trans small_calc. rewrite ler_pmul2l; last by []. by rewrite ler_piexpz2l. rewrite [l]lock in lt_l3_1. -have lt_t4_1 : t 4%nat < 1. +have lt_t4_1 : t 4%N < 1. rewrite {l le_0_l lt_l3_1 maj_t loglog a3}. pose a4 := locked alpha 4. - have lt0a4 : (0 < a4)%ssrN by rewrite /a4 -lock. + have lt0a4 : (0 < a4)%N by rewrite /a4 -lock. have -> : t 4 = (m * a4%:R) ^ 14 * eps ^ alpha 4 by rewrite /t /a4 -lock. - suff [M hM]: exists2 M, (M * 14 <= alpha 4)%ssrN & (m * a4%:R) * eps ^ M < 1. + suff [M hM]: exists2 M, (M * 14 <= alpha 4)%N & (m * a4%:R) * eps ^ M < 1. move=> hm. - have {hm} : (m * a4%:R) ^14 * eps ^ (M * 14)%ssrN < 1. + have {hm} : (m * a4%:R) ^14 * eps ^ (M * 14)%N < 1. rewrite PoszM -exprz_exp -expfzMl; apply: exprn_ilt1=> //. - rewrite -mulrA pmulr_rge0 // pmulr_rge0 ?ltr0n //; apply: exprz_ge0; exact: ltrW. - apply: ler_lt_trans. rewrite ler_pmul2l; first by rewrite ler_piexpz2l. - by apply: exprz_gt0; rewrite pmulr_rgt0 // ltr0n. + rewrite -mulrA pmulr_rge0 // pmulr_rge0 ?ltr0n //; apply: exprz_ge0; exact: ltW. + apply: le_lt_trans. rewrite ler_pmul2l; first by rewrite ler_piexpz2l. + by apply: exprz_gt0; rewrite pmulr_rgt0 // ltr0n. pose e := rat_of_Z 992 / rat_of_Z (10 ^ 3). have ltepse : eps < e. rewrite epsF ltr_pdivr_mulr // /e mulrAC ltr_pdivl_mulr; last exact: rat_of_Z_Zpos. have -> : eps2 = rat_of_Z (6 * 10 ^ 12) * rat_of_Z (10 ^ 3). - by rewrite -[RHS]mmul /eps2 -Z.mul_assoc -Zpower_exp // mmul -lock. + by rewrite -[RHS]mmul. rewrite mulrA ltr_pmul2r ?rat_of_Z_Zpos // -[X in _ < X]mmul. - rewrite -subr_gt0 /eps1 -lock -[X in 0 < X]msub. + rewrite -subr_gt0 /eps1 -[X in 0 < X]msub. exact: rat_of_Z_Zpos. (* long *) - suff [M le14M]: exists2 M, (M * 14 <= alpha 4)%ssrN & (m * a4%:R) * (e ^ M) < 1. - move=> hm; exists M => //; apply: ler_lt_trans hm. rewrite ler_pmul2l; last first. + suff [M le14M]: exists2 M, (M * 14 <= alpha 4)%N & (m * a4%:R) * (e ^ M) < 1. + move=> hm; exists M => //; apply: le_lt_trans hm. rewrite ler_pmul2l; last first. by rewrite pmulr_rgt0 // ltr0n. - apply: ler_wpexpz2r=> //; apply: ltrW=> //. - rewrite /e divr_gt0 //; exact: rat_of_Z_Zpos. - suff [M le14M]: exists2 M, (M * 14 <= alpha 4)%ssrN & + apply: ler_wpexpz2r=> //; apply: ltW=> //. + rewrite /e divr_gt0 //; exact: rat_of_Z_Zpos. + suff [M le14M]: exists2 M, (M * 14 <= alpha 4)%N & 0 < (rat_of_Z (10 ^ 3)) ^ M - (m * a4%:R) * ((rat_of_Z 992) ^ M). - move=> hm; exists M => //. - rewrite /e expfzMl -expfV mulrA ltr_pdivr_mulr; last by rewrite exprz_gt0 // rat_of_Z_Zpos. - by rewrite mul1r -subr_gt0. - exists 2000. - rewrite /alpha. rewrite -subn_eq0. - rewrite -!NatTrec.trecE. - done. (* FIXME : compute in Z. *) - suff : 0 < rat_of_Z ((BinInt.Z.pow 1000 2000) - (10 * BinInt.Z.pow 2 (2 ^ 4)) * (BinInt.Z.pow 992 2000)). - set g := (X in _ -> X). - rewrite msub mmul -[2000%coqZ]/(Z.of_nat 2000) !rat_of_Z_pow mmul {}/g. - set x := (X in 0 < X -> _). set y := (X in _ -> 0 < X). - suff -> : x = y by []. - rewrite {}/x {}/y. set x := (X in _ - X = _). set y := (X in _ = _ - X). - suff -> : x = y by []. - rewrite {}/x {}/y. - suff [-> ->] : rat_of_Z (2 ^ 2 ^ 4) = a4%:R /\ rat_of_Z 10 = m by []. - rewrite -[10%coqZ]/(Z.of_nat 10) -[(2 ^ 4)%coqZ]/(Z.of_nat (2 ^4)) rat_of_Z_pow. - rewrite -[2%coqZ]/(Z.of_nat 2) !rat_of_Z_of_nat; split; last by []. - by rewrite /a4 -lock /alpha natrX; congr (_ ^+ _). + move=> hm; exists M => //. + rewrite /e expfzMl -expfV mulrA ltr_pdivr_mulr; last by rewrite exprz_gt0 // rat_of_Z_Zpos. + by rewrite mul1r -subr_gt0. + exists 2000. + rewrite /alpha. rewrite -subn_eq0. + rewrite -!NatTrec.trecE. + done. (* FIXME : compute in Z. *) + suff : 0 < rat_of_Z (1000 ^ 2000 - 10 * 2 ^ 2 ^ 4 * 992 ^ 2000). + set g := (X in _ -> X). + rewrite msub mmul -[2000%coqZ]/(Z.of_nat 2000) !rat_of_Z_pow mmul {}/g. + set x := (X in 0 < X -> _). set y := (X in _ -> 0 < X). + suff -> : x = y by []. + rewrite {}/x {}/y. set x := (X in _ - X = _). set y := (X in _ = _ - X). + suff -> : x = y by []. + rewrite {}/x {}/y. + suff [-> ->] : rat_of_Z (2 ^ 2 ^ 4) = a4%:R /\ rat_of_Z 10 = m by []. + rewrite -[10%coqZ]/(Z.of_nat 10) -[(2 ^ 4)%coqZ]/(Z.of_nat (2 ^4)) rat_of_Z_pow. + rewrite -[2%coqZ]/(Z.of_nat 2) !rat_of_Z_of_nat; split; last by []. + by rewrite /a4 -lock /alpha natrX; congr (_ ^+ _). vm_compute; exact: rat_of_Z_Zpos. rewrite [t]lock in lt_t4_1. -have lt_ln_1 (n : nat) : (3 <= n)%ssrN -> l n <= 1. +have lt_ln_1 (n : nat) : (3 <= n)%N -> l n <= 1. elim: n => [// | n ihn]. - rewrite leq_eqVlt; case/orP=> [/eqP<- | /ihn {ihn} ihn]; first by rewrite [l]lock. (* unlock does not work... *) - suff h : l n.+1 <= (l n) ^ 2 by apply: ler_trans h _; apply: mulr_ile1. + rewrite leq_eqVlt => /predU1P [<- | {}/ihn ihn]; first by rewrite [l]lock. (* unlock does not work... *) + suff h : l n.+1 <= (l n) ^ 2 by apply: le_trans h _; apply: mulr_ile1. rewrite /l expfzMl exprz_exp; apply: ler_pmul. - apply: exprz_ge0; exact: ler0n. - - - apply: exprz_ge0; exact: ltrW. + - apply: exprz_ge0; exact: ltW. - by rewrite alphaS natrX exprnP exprz_exp. rewrite exprz_exp; apply: ler_wpiexpz2l. - - exact: ltrW. - - exact: ltrW. + - exact: ltW. + - exact: ltW. - rewrite -topredE /= -mulrBl; apply: mulr_ge0; last by []. exact: le_0_alpham2. @@ -1330,27 +1003,25 @@ have lt_ln_1 (n : nat) : (3 <= n)%ssrN -> l n <= 1. have {x} -> : x = az ^+ 2 ^+ 2 - (2%:Z * az) ^+ 2 + 4%:Z * az. rewrite /x -!addrA; congr (_ + _); rewrite [_ * 2%:Z]mulrC. by rewrite mulrBr opprD opprK addrA -opprD -mulrDl exprMn mulrA. (* missing ring...*) - rewrite subr_sqr; apply: addr_ge0; last by apply: mulr_ge0. - apply: mulr_ge0; last by apply: addr_ge0. - rewrite expr2 -mulrBl; apply: mulr_ge0; last by []. - exact: le_0_alpham2. -suff [K [lt0K [N Pn]]] : exists K : rat, 0 < K /\ exists N : nat, (forall n, (N < n)%nat -> t n < K). + rewrite subr_sqr; apply: addr_ge0; apply: mulr_ge0 => //. + by rewrite expr2 -mulrBl; apply/mulr_ge0/isT/le_0_alpham2. +suff [K [lt0K [N Pn]]] : exists K : rat, 0 < K /\ exists N : nat, (forall n, (N < n)%N -> t n < K). (* a bigenough would be nice here *) pose KK := (K + \sum_(0 <= j < N.+1) t j). - have le0sum : 0 <= \sum_(0 <= j < N.+1) t j by apply: sumr_ge0=> n _; exact: ltrW. - have lt0KK : 0 < KK by rewrite /KK; apply: ltr_spaddl. + have le0sum : 0 <= \sum_(0 <= j < N.+1) t j by apply: sumr_ge0=> n _; exact: ltW. + have lt0KK : 0 < KK by rewrite /KK; apply: ltr_spaddl. have ltKK : K <= KK by rewrite /KK ler_addl. - have KKmaj j : (j <= N)%nat -> t j < KK. + have KKmaj j : (j <= N)%N -> t j < KK. move=> lej4; rewrite /KK (bigD1_seq j) //=; last by rewrite mem_iota iota_uniq. - - rewrite addrA addrAC cpr_add; apply: ltr_spaddl=> //; apply: sumr_ge0=> n _; exact: ltrW. + - rewrite addrA addrAC cpr_add; apply: ltr_spaddl=> //; apply: sumr_ge0=> n _; exact: ltW. by rewrite mem_index_iota. - exists KK; split => [|] //; elim=> [| n ihn]; first exact: KKmaj. + exists KK; split => //; elim=> [| n ihn]; first exact: KKmaj. case: (ltnP n.+1 N.+1) => [lenN | ltNn]; first exact: KKmaj. - by apply: ltr_le_trans ltKK; apply: Pn. -exists 1; split => //; exists 3; elim=> [| n ihn] //. -rewrite leq_eqVlt; case/orP=> [/eqP<- | lt3n]; first by rewrite [t]lock. -have {ihn} ihn := ihn lt3n. -apply: ler_lt_trans (maj_t _) _; apply: (@ler_lt_trans _ (t n ^ 2)); last first. + by apply: lt_le_trans ltKK; apply: Pn. +exists 1; split => //; exists 3; elim=> [| n ihn] //. +rewrite leq_eqVlt => /predU1P [<- | lt3n]; first by rewrite [t]lock. +have {}ihn := ihn lt3n. +apply: le_lt_trans (maj_t _) _; apply: (@le_lt_trans _ _ (t n ^ 2)); last first. by apply: mulr_ilt1. rewrite ger_pmulr; first by apply: lt_ln_1; rewrite ltnS in lt3n; apply: ltn_trans lt3n. exact: exprz_gt0. @@ -1359,8 +1030,8 @@ Qed. Theorem t3 : exists (K : nat), - (0 < K)%nat /\ - forall n, (iter_lcmn n)%:Q <= (K * expn 3 n)%nat%:Q. + (0 < K)%N /\ + forall n, (iter_lcmn n)%:Q <= (K * expn 3 n)%N%:Q. Proof. have [K [Kpos Kmaj]] := t3_nat. by exists K; split => // n; rewrite ler_nat. diff --git a/theories/hanson_elem_analysis.v b/theories/hanson_elem_analysis.v index 40957ba..4f8a6b0 100644 --- a/theories/hanson_elem_analysis.v +++ b/theories/hanson_elem_analysis.v @@ -1,164 +1,72 @@ From mathcomp Require Import all_ssreflect all_algebra all_field. -Require Import arithmetics multinomial floor posnum. +Require Import floor posnum. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Require Import field_tactics. -Require Import bigopz. -Require Import lia_tactics conj. -Require Import shift. Require Import extra_mathcomp. Require Import hanson_elem_arith. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. Local Open Scope ring_scope. -Section AlgCMissing. - -Implicit Types x y z : algC. - -Lemma root_le_x (n : nat) x y : - (0 < n)%N -> 0 <= x -> 0 <= y -> x <= y ^+ n -> n.-root x <= y. -Proof. -move => Hn Hx Hy Hxyn. -have: (n.-root x) ^+ n <= y ^+ n by rewrite rootCK. -rewrite ler_pexpn2r // nnegrE rootC_ge0 // rootCK. -Qed. - -Lemma root_x_le (n : nat) x y : - (0 < n)%N -> (0 <= x) -> (0 <= y) -> (x ^+ n <= y) -> (x <= n.-root y). -Proof. -move => Hn Hx Hy Hxyn. -have: x ^+ n <= (n.-root y) ^+ n by rewrite rootCK. -by rewrite ler_pexpn2r // nnegrE rootC_ge0 // rootCK. -Qed. - -Lemma rootC_leq (m n : nat) x : - 1 <= x -> (0 < n)%N -> (n <= m)%N -> m.-root x <= n.-root x. -Proof. -move=> Hx Hn Hmn. -have Hmgt0 : (0 < m)%N by rewrite (leq_trans _ Hmn). -have Heq p s q (Hp : (p <= q)%N) : - s.-root x ^+ q = s.-root x ^+ p * s.-root x ^+ (q - p). - by rewrite -GRing.exprD subnKC. -suff Hm : (m.-root x) ^+ m <= (n.-root x) ^+ m. - apply: root_x_le => // . - - by rewrite rootC_ge0 ?(ler_trans _ Hx). - - by rewrite ?(ler_trans _ Hx). - - suff Hinterm : m.-root x ^+ n <= m.-root x ^+ m. - by rewrite (ler_trans Hinterm) // rootCK ?lerr //. - rewrite (Heq n m m) // ler_pmulr // . - by rewrite exprn_ege1 // rootC_ge1. - by rewrite exprn_gt0 // rootC_gt0 // (ltr_le_trans _ Hx). -rewrite rootCK // (Heq n n m) // rootCK // ler_pmulr // ?(ltr_le_trans _ Hx) //. -by rewrite exprn_ege1 // rootC_ge1. -Qed. - -(* Not sure if actually needed in library, but this lemma is helpful -to prove one_plus_invx_expx below *) -Lemma le_mrootn_n (m n : nat) : m.+1.-root n.+1%:R <= n.+1%:R :> algC. -apply: root_le_x => //; rewrite ?ler0n //. -by apply lter_eexpr => //; rewrite ler1n. -Qed. - - -Lemma prod_root m n x : (0 < m)%N -> (0 < n)%N -> 0 <= x -> - (m * n)%N.-root x = m.-root (n.-root x). -Proof. -move => Hm Hn Hx. -have Hmnpos : (0 < m * n)%N. - by rewrite muln_gt0 Hm Hn. -have Hmn : (m * n).-root x \is Num.nneg. - by rewrite nnegrE rootC_ge0 //. -suff: ((m * n).-root x) ^+ (m*n)%N = (m.-root (n.-root x)) ^+ (m * n)%N. - apply: pexpIrn => // . - by rewrite nnegrE rootC_ge0 //; rewrite rootC_ge0 // . -by rewrite rootCK // GRing.exprM rootCK // rootCK. -Qed. - -End AlgCMissing. - Notation "r '%:C'" := (ratr r : algC) (at level 8). (* random level *) (* Section presenting the theory of exp_quo, which corresponds to taking a rational exponent of a complex algebraic number *) Section RationalPower. -Definition exp_quo r p q := (q.-root (r%:C)) ^+ p. +Definition exp_quo r p q := (q.-root r%:C) ^+ p. Arguments exp_quo r p%nat q%nat : simpl never. +Lemma exp_quo_0 p q : exp_quo 0 p q = (p == 0%N)%:R. +Proof. by rewrite /exp_quo /ratr mul0r rootC0 expr0n. Qed. + +Lemma exp_quo_1 p q : (0 < q)%N -> exp_quo 1 p q = 1. +Proof. by move => Hq; rewrite /exp_quo rmorph1 rootC1 // expr1n. Qed. + Lemma exp_quo_less r1 r2 p q : - (0 < q)%N -> 0 <= r1 -> 0 <= r2 -> r1 <= r2 -> exp_quo r1 p q <= exp_quo r2 p q. + (0 < q)%N -> 0 <= r1 -> 0 <= r2 -> r1 <= r2 -> + exp_quo r1 p q <= exp_quo r2 p q. Proof. -move => Hq H1 H2 Hleq. -apply: ler_expn2r; last first. -- rewrite ler_rootCl ?ler_rat // . - by rewrite nnegrE ler0q. +move => Hq H1 H2 Hleq; apply: ler_expn2r. - by rewrite nnegrE rootC_ge0 // ler0q. - by rewrite nnegrE rootC_ge0 // ler0q. -Qed. - -Lemma exp_quo_1 p q : (0 < q)%N -> exp_quo 1 p q = 1. -Proof. -move => Hq; rewrite /exp_quo. -suff -> : q.-root (ratr 1) = 1 :> algC by rewrite expr1n. -by rewrite rmorph1 rootC1. +- by rewrite ler_rootCl ?ler_rat // nnegrE ler0q. Qed. Lemma exp_quo_lessn r1 (p1 q1 p2 q2 : nat) : (0 < q1)%N -> (0 < q2)%N -> 1 <= r1 -> (p1 * q2 <= p2 * q1)%N -> - (exp_quo r1 p1 q1) <= (exp_quo r1 p2 q2). + exp_quo r1 p1 q1 <= exp_quo r1 p2 q2. Proof. move => Hq1 Hq2 H1r Hle. -have H0r : (0 <= r1). - by apply: (ler_trans _ H1r); exact: ler01. -have Hprodpos : (0 < q1 * q2)%N. - by rewrite muln_gt0 Hq1 Hq2. -suff : - (q1.-root (ratr r1) ^+ p1) ^+ (q1 * q2)%N <= - (q2.-root (ratr r1) ^+ p2) ^+ (q1 * q2)%N :> algC. -rewrite ler_pexpn2r //. -- by rewrite nnegrE; apply: exprn_ge0; rewrite rootC_ge0 // ?ler0q. -- by rewrite nnegrE; apply: exprn_ge0; rewrite rootC_ge0 // ?ler0q. -rewrite -exprM mulnCA exprM rootCK //. -rewrite -[in X in _ <= X]exprM. -have -> : (p2 * (q1 * q2) = q2 * (p2 * q1))%N. - by rewrite [(q1*q2)%N]mulnC -mulnCA. -rewrite !exprM ![in X in _ <= X]rootCK // -!exprM. -rewrite ler_eqVlt in H1r. -case/orP: H1r. -- case/eqP => <-; by rewrite rmorph1 !expr1n lerr. -- by move => H1r; rewrite ler_eexpn2l // ltr1q. +have H0r : 0 <= r1 by apply/le_trans/H1r/ler01. +have Hprodpos : (0 < q1 * q2)%N by rewrite muln_gt0 Hq1 Hq2. +suff : (q1.-root r1%:C ^+ p1) ^+ (q1 * q2) <= + (q2.-root r1%:C ^+ p2) ^+ (q1 * q2). + by rewrite ler_pexpn2r // nnegrE; apply: exprn_ge0; rewrite rootC_ge0 ?ler0q. +rewrite !exprM [_ ^+ _ ^+ q1]exprAC -exprM ![_ ^+ _ ^+ q2]exprAC !rootCK //. +by rewrite -exprM; apply: ler_weexpn2l; rewrite // ler1q. Qed. - Lemma exp_quo_r_nat r i : (r ^+ i)%:C = exp_quo r i 1. Proof. by rewrite /exp_quo root1C CratrE /=. Qed. -Lemma exp_quo_nat_nat i j : (i ^ j)%N%:R%:C = exp_quo (i%N%:Q) j 1. +Lemma exp_quo_nat_nat i j : (i ^ j)%:R%:C = exp_quo i%:Q j 1. Proof. by rewrite natrX exp_quo_r_nat. Qed. Lemma exp_quo_mult_distr r1 r2 p1 q1 (Hr2 : 0 <= r2) : exp_quo r1 p1 q1 * exp_quo r2 p1 q1 = exp_quo (r1 * r2) p1 q1. -Proof. -rewrite /exp_quo. -rewrite rmorphM /=. -by rewrite [in RHS] rootCMr ?GRing.exprMn ?ler0q. -Qed. - +Proof. by rewrite /exp_quo rmorphM /= [in RHS]rootCMr ?exprMn ?ler0q. Qed. Lemma exp_quo_plus r1 p1 q1 p2 q2 : - (0 < q1)%N -> - (0 < q2)%N -> - (0 <= r1) -> - exp_quo r1 (p1 * q2 + p2 * q1)%N (q1 * q2)%N = + (0 < q1)%N -> (0 < q2)%N -> 0 <= r1 -> + exp_quo r1 (p1 * q2 + p2 * q1) (q1 * q2) = exp_quo r1 p1 q1 * exp_quo r1 p2 q2. Proof. move => Hq1pos Hq2pos Hr1pos. @@ -167,69 +75,40 @@ have Hprodpos : (0 < q1 * q2)%N. rewrite /exp_quo. set t1 := LHS. set t2 := RHS. -suff: t1 ^+ (q1 * q2)%N = t2 ^+ (q1 * q2)%N. - rewrite /t1 /t2. - apply: pexpIrn => // . - + by rewrite nnegrE; apply: exprn_ge0; rewrite rootC_ge0 ?ler0q //. - + by rewrite nnegrE; apply mulr_ge0; apply: exprn_ge0; - rewrite rootC_ge0 // ler0q. -rewrite /t1 /t2 -exprM mulnDl exprD. -have -> : ((p1 * q2 * (q1 * q2)) = (q1 * q2 * (p1 * q2)))%N. - by rewrite mulnCA [(p1 * q2)%N]mulnC -!mulnA [(p1 * q2)%N]mulnC. -have -> : ((p2 * q1 * (q1 * q2)) = (q1 * q2 * (p2 * q1)))%N. - by rewrite mulnC. -rewrite prod_root ?ler0q // ![in LHS]exprM rootCK // rootCK // . -rewrite ![in RHS]exprMn. -rewrite -!exprM. rewrite [in RHS]mulnC -[(p2 * _)%N]mulnC. -rewrite [X in (p2* X)%N]mulnC [(p2* (_ * _))%N]mulnCA ![in RHS]exprM !rootCK //. -rewrite -![in RHS]exprM. rewrite {1}mulnC; congr (_ * _). -by rewrite mulnC. +suff: t1 ^+ (q1 * q2) = t2 ^+ (q1 * q2). + apply: pexpIrn; rewrite // nnegrE /t1 /t2. + + by apply: exprn_ge0; rewrite rootC_ge0 ?ler0q. + + by apply: mulr_ge0; apply: exprn_ge0; rewrite rootC_ge0 ?ler0q. +rewrite /t1 /t2 -exprM mulnDl exprD prod_root ?ler0q // exprMn !exprM. +rewrite ![_ ^+ _ ^+ q1]exprAC [_ ^+ p1 ^+ q2]exprAC !rootCK // -exprM. +rewrite [_ ^+ p2 ^+ q1]exprAC 2![_ ^+ _ ^+ q2]exprAC !rootCK // -exprM. +rewrite ![_ ^+ _ ^+ q1]exprAC rootCK // -exprM. +by rewrite ![_ ^+ _ ^+ q2]exprAC rootCK // -exprM [(p2 * _)%N]mulnC. Qed. Lemma exp_quo_equiv r1 p1 q1 p2 q2 : - (0 < q1)%N -> - (0 < q2)%N -> - (0 <= r1) -> - (p1 * q2 = p2 * q1)%N -> + (0 < q1)%N -> (0 < q2)%N -> 0 <= r1 -> (p1 * q2 = p2 * q1)%N -> exp_quo r1 p1 q1 = exp_quo r1 p2 q2. Proof. move => Hq1pos Hq2pos Hr1pos Heq. -have Hprodpos : (0 < q1 * q2)%N. - by rewrite muln_gt0 Hq1pos Hq2pos. -suff : - (q1.-root (ratr r1) ^+ p1) ^+ (q1 * q2)%N = - (q2.-root (ratr r1) ^+ p2) ^+ (q1 * q2)%N :> algC. -apply: pexpIrn => // . -- by rewrite nnegrE; apply: exprn_ge0; rewrite rootC_ge0 // ?ler0q // . -- by rewrite nnegrE; apply: exprn_ge0; rewrite rootC_ge0 // ?ler0q // . -rewrite -!exprM mulnC mulnA -Heq. -rewrite 2!exprM rootCK // . -by rewrite -mulnA -mulnCA 2!exprM rootCK // -!exprM mulnC. +have Hprodpos : (0 < q1 * q2)%N by rewrite muln_gt0 Hq1pos Hq2pos. +suff : q1.-root r1%:C ^+ p1 ^+ (q1 * q2) = q2.-root r1%:C ^+ p2 ^+ (q1 * q2). + by apply: pexpIrn; rewrite // nnegrE exprn_ge0 ?rootC_ge0 ?ler0q. +rewrite !exprM ![_ ^+ _ ^+ q1]exprAC -exprM ![_ ^+ _ ^+ q2]exprAC !rootCK //. +by rewrite -exprM Heq mulnC. Qed. Lemma exp_quo_ge0 r p q : (0 < q)%N -> 0 <= r -> 0 <= exp_quo r p q. -Proof. -by move => Hq Hr; rewrite exprn_gte0 // ?rootC_ge0 // ler0q. -Qed. +Proof. by move=> Hq Hr; rewrite exprn_gte0 ?rootC_ge0 ?ler0q. Qed. Lemma exp_quo_gt0 r p q : (0 < q)%N -> (0 < r) -> 0 < exp_quo r p q. -Proof. -by move => Hq Hr; rewrite exprn_gte0 // ?rootC_gt0 // ?ltr0q. -Qed. +Proof. by move => Hq Hr; rewrite exprn_gte0 ?rootC_gt0 ?ltr0q. Qed. Lemma exp_quo_ge1 r p q : (0 < q)%N -> (1 <= r) -> 1 <= exp_quo r p q. -Proof. -by move => Hq Hr; rewrite exprn_ege1 // ?rootC_ge1 // ler1q. -Qed. +Proof. by move => Hq Hr; rewrite exprn_ege1 ?rootC_ge1 ?ler1q. Qed. -Lemma exp_quo_gt1 r p q : - (0 < p)%N -> - (0 < q)%N -> - (1 < r) -> - 1 < exp_quo r p q. -Proof. -by move => Hp Hq Hr; rewrite exprn_egt1 // ?rootC_gt1 // ?ltr1q // -lt0n. -Qed. +Lemma exp_quo_gt1 r p q : (0 < p)%N -> (0 < q)%N -> 1 < r -> 1 < exp_quo r p q. +Proof. by move => Hp Hq Hr; rewrite exprn_egt1 ?rootC_gt1 ?ltr1q -?lt0n. Qed. Lemma sqrtC_exp_quo (r : rat) : sqrtC r%:C = exp_quo r 1%N 2%N. Proof. by rewrite /exp_quo expr1. Qed. @@ -237,59 +116,33 @@ Proof. by rewrite /exp_quo expr1. Qed. Lemma exp_quo_self_grows (p1 q1 p2 q2 : nat) r1 r2 : (0 < q1)%N -> (0 < q2)%N -> - (r1 = p1%:Q / q1%:Q) -> - (r2 = p2%:Q / q2%:Q) -> - (0 < r1) -> - (1 <= r2) -> - (r1 <= r2) -> + r1 = p1%:Q / q1%:Q -> + r2 = p2%:Q / q2%:Q -> + 0 < r1 -> + 1 <= r2 -> + r1 <= r2 -> exp_quo r1 p1 q1 <= exp_quo r2 p2 q2. Proof. move => Hq1 Hq2 Hr1 Hr2 Hr1gt0 Hle1r2 Hle12. -have Hr1pos : 0 <= r1. - exact: ltrW. -have Hr2pos : 0 <= r2. - by rewrite Hr2 divr_ge0 // ?ler0z. -have Hprodpos : (0 < q1 * q2)%N. - by rewrite muln_gt0 Hq1 Hq2. +have Hr1pos : 0 <= r1 by apply: ltW. +have Hr2pos : 0 <= r2 by rewrite Hr2 divr_ge0 // ?ler0z. +have Hprodpos : (0 < q1 * q2)%N by rewrite muln_gt0 Hq1 Hq2. have Hleq : (p1 * q2 <= p2 * q1)%N. - suff HQ : p1%:Q * q2%:Q <= p2%:Q * q1%:Q. - by rewrite -!intrM ler_int in HQ. - rewrite -ler_pdivl_mulr ?ltr0z //. - rewrite [p2%:~R * _]mulrC -mulrA -ler_pdivr_mull ?ltr0z // mulrC. - by move: Hle12; rewrite Hr1 Hr2. -have -> : - exp_quo r2 p2 q2 = - exp_quo r2 p1 q1 * exp_quo r2 (p2 * q1 - p1 * q2)%N (q1 * q2)%N. - rewrite -exp_quo_plus //. - apply: exp_quo_equiv => // . + rewrite -(ler_nat [numDomainType of rat]) !natrM -ler_pdivl_mulr ?ltr0n //. + by rewrite mulrAC -ler_pdivr_mulr ?ltr0n //; move: Hle12; rewrite Hr1 Hr2. +have -> : exp_quo r2 p2 q2 = + exp_quo r2 p1 q1 * exp_quo r2 (p2 * q1 - p1 * q2)%N (q1 * q2)%N. + rewrite -exp_quo_plus //; apply: exp_quo_equiv => //. (* TODO: lia *) by rewrite !muln_gt0 Hq1 Hq2. - rewrite !mulnA. - rewrite mulnBl mulnDl mulnBl //. - have -> : (p1 * q1 * q2 * q2 = p1 * q2 * q1 * q2)%N. - by congr muln; rewrite mulnAC. - rewrite subnKC // . - by rewrite -mulnA -[X in (_ <= X)%N]mulnA leq_mul. + by rewrite [in RHS]mulnA mulnAC -mulnDl subnKC // !mulnA. have -> : exp_quo r2 p1 q1 = exp_quo r1 p1 q1 * exp_quo (r2 / r1) p1 q1. - rewrite exp_quo_mult_distr ?divr_ge0 // . - congr exp_quo. - rewrite mulrCA divrr ?mulr1 //. - exact: unitf_gt0. -rewrite -{1}[exp_quo _ _ _]mulr1. -rewrite -mulrA. -apply: ler_pmul => // ; try rewrite ler01 // . - exact: exp_quo_ge0. -rewrite -[1]mulr1. -apply: ler_pmul => // ; try rewrite ler01 // . - apply: exprn_ege1; rewrite rootC_ge1 //. - rewrite rmorphM /= CratrE /=. - rewrite ler_pdivl_mulr ?ltr0q ?mul1r //. - by rewrite ler_rat. -apply: exprn_ege1. rewrite rootC_ge1 //. -suff -> : 1 = ratr (1%N%:Q). - by rewrite ler_rat. -move => t; by rewrite ratr_int. + by rewrite exp_quo_mult_distr ?divr_ge0 // mulrC divfK ?lt0r_neq0. +rewrite -mulrA; apply/ler_pemulr/mulr_ege1/exprn_ege1. +- exact: exp_quo_ge0. +- by apply: exprn_ege1; rewrite rootC_ge1 // ler1q ler_pdivl_mulr // mul1r. +- by rewrite rootC_ge1 // ler1q. Qed. - + End RationalPower. (* This Section contains a collection of four facts used in the proof @@ -299,212 +152,130 @@ x) ^ x *) Section FourFacts. (* A lemma comparing factorial to a geometric sequence *) -Lemma fact_greater_geom i : i.+1`!%:~R >= (3%:Q / 2%:~R) ^+ i. +Lemma fact_greater_geom i : i.+1`!%:R >= (3%:Q / 2%:Q) ^+ i. Proof. -elim: i => [|i HIi]; first by rewrite expr0. -rewrite exprS factS PoszM intrM. -have frac_ge0 : 0 <= 3%:Q / 2%:~R. - by apply: divr_ge0; rewrite ler0z. -have fracpow_ge0 : 0 <= (3%:Q / 2%:~R) ^+ i. - by rewrite exprn_ge0 ?frac_ge0. -suff : 0 <= 3%:~R / 2%:Q <= i.+2%:~R /\ 0 <= (3%:~R / 2%:Q) ^+ i <= (i.+1)`!%:~R. - case => [] /andP [H1 H2] /andP [H3 H4]; exact: ler_pmul. -split; apply/andP; split. - - exact: frac_ge0. - - rewrite ler_pdivr_mulr; last by rewrite ltr0n. - apply: (@ler_trans _ (2%:~R * 2%:~R)). - by rewrite -rmorphM /= ler_nat. - apply: ler_pmul; rewrite ?ler0n; try exact: isT. - rewrite -[i.+2]addn2 -{1}[2]add0n !PoszD !intrD . - apply: ler_add; rewrite ?ler_nat; try exact: isT. - - exact: fracpow_ge0. - - exact: HIi. +elim: i => // i IHi; rewrite exprS factS natrM; apply: ler_pmul IHi => //. +by rewrite ler_pdivr_mulr ?ltr0n // mulr_natr -mulrnA ler_nat. Qed. (* Formula for a geometric sum in a field *) Lemma geometric_sum (R : numFieldType) n (r : R) (Hr : r != 1) : \sum_(i < n) r ^+ i = (1 - r ^+ n) / (1 - r). Proof. -elim: n => [|n Hn]. - by rewrite big_ord0 expr0 subrr mul0r. -suff: (1 - r ^+ n) / (1 - r) + r ^+ n = (1 - r ^+ n.+1) / (1 - r). - by rewrite big_ord_recr /= Hn. +elim: n => [|n Hn]; first by rewrite big_ord0 expr0 subrr mul0r. have den_neq0 : 1 - r != 0 by rewrite subr_eq0 eq_sym. -rewrite -[r ^+ n]divr1 addf_div ?oner_neq0 // !mulr1 !divr1; congr (_ / _). -by rewrite mulrBr mulr1 subrKA exprSr. +rewrite big_ord_recr /= Hn; apply: canRL (mulfK den_neq0) _. +by rewrite [LHS]mulrDl divfK // mulrBr mulr1 addrA subrK exprSr. Qed. - - (* A bound on (1 + 1 / (n+1)) ^ (n+2) *) -Lemma one_plus_invn_expn (n : nat) : (1 + n.+1%:~R^-1) ^+ n.+2 <= 8%:Q. +(* A bound on (1 + 1 / (n+1)) ^ (n+2) *) +Lemma one_plus_invn_expn (n : nat) : (1 + n%:Q^-1) ^+ n.+1 <= 8%:Q. Proof. -have step : (1 + n.+1%:~R^-1) ^+ n.+1 <= \sum_(i < n.+2) (i`!)%:~R ^-1 :> rat. - rewrite exprDn; apply: ler_sum => i _; rewrite expr1n mul1r. - suff : n.+1%:~R^-1 ^+ i *+ 'C(n.+1, i) * i`!%:~R <= 1 :> rat. - by rewrite -lter_pdivl_mulr ?mul1r // ?ltr0z; apply: fact_gt0. (* issue with manifest pos *) - rewrite -mulr_natl mulrC mulrA -natrM mulnC bin_ffact exprVn ler_pdivr_mulr //. - rewrite mul1r -natrX ler_nat; exact: ffact_le_expn. -suff h: (1 + n.+1%:~R^-1 : rat) ^+ n.+2 <= 2%:~R * \sum_(i < n.+2) (i`!)%:~R ^-1. - apply: ler_trans h _. - suff He_leq_4 : \sum_(i < n.+2) i`!%:~R ^-1 <= 4%:Q. - by rewrite -[8%:~R]/(2%:~R* 4%:~R : rat) ler_pmul2l. - apply: (@ler_trans _ (1 + \sum_(i < n.+1) (2%:Q / 3%:Q) ^+ i)). - - rewrite big_ord_recl /= fact0 ler_add2l /=; apply: ler_sum => [] [i Hi] _. - rewrite /bump /=. - have -> : (2%:~R / 3%:~R) ^+ i = ((3%:~R / 2%:~R) ^+ i) ^-1 :> rat. - by rewrite -exprVn invf_div. - rewrite lef_pinv ?posrE ?add1n //; first by exact: fact_greater_geom. - by rewrite ltr0z; apply: fact_gt0. (* issue with manifest pos *) - - rewrite geometric_sum // -[4%:Q]/(1 + 3%:Q) ler_add2l. - have -> : 1 - 2%:~R / 3%:~R = 3%:~R^-1 :> rat by []. - by rewrite invrK ler_pimull // ler_subl_addr ler_addl. -suff majl : (1 + n.+1%:~R^-1) <= 2%:R :> rat. - by rewrite exprDn -exprDn exprS; apply: ler_pmul. -by rewrite -[2%:R]/(1 + 1) ler_add2l invf_le1 // ler1z. +case: n => // n. +have step: (1 + n.+1%:Q^-1) ^+ n.+1 <= \sum_(i < n.+2) i`!%:Q^-1. + rewrite exprDn; apply: ler_sum => i _; rewrite expr1n mul1r -mulr_natr exprVn. + rewrite ler_pdivr_mull ?ler_pdivl_mulr ?ltr0n ?expn_gt0 ?fact_gt0 //. + by rewrite -natrM bin_ffact -natrX ler_nat ffact_le_expn. +have {step}: (1 + n.+1%:Q^-1) ^+ n.+2 <= 2%:Q * \sum_(i < n.+2) i`!%:Q^-1. + rewrite exprS; apply: ler_pmul => //. + by rewrite -[2%:Q]/(1 + 1) ler_add2l invf_le1 // ler1z. +move/le_trans; apply; rewrite -[8%:Q]/(2%:Q * 4%:Q) ler_pmul2l //. +have: 1 + \sum_(i < n.+1) (2%:Q / 3%:Q) ^+ i <= 4%:Q. + rewrite geometric_sum // -[4%:Q]/(1 + 3%:Q) ler_add2l. + have -> : 1 - 2%:Q / 3%:Q = 3%:Q^-1 by []. + by rewrite invrK ler_pimull // ler_subl_addr ler_addl. +apply: le_trans; rewrite big_ord_recl ler_add2l; apply: ler_sum => i _ /=. +by rewrite -invf_div exprVn lef_pinv ?posrE ?ltr0n ?fact_gt0 ?fact_greater_geom. Qed. - (* TODO : clean up, use more ^-1 *) (* this proof is very long in big part because of exp_quo *) Lemma one_plus_invx_expx (p q : nat) (r : rat) (n : nat) : - (0 < r) -> (r = p%:Q / q%:Q) -> (exp_quo (1%:Q + 1 / r) p q <= (ratr 9%N%:Q)). + 0 < r -> r = p%:Q / q%:Q -> exp_quo (1 + 1 / r) p q <= ratr 9%:Q. Proof. -move => Hrpos Hrpq. +rewrite div1r => Hrpos Hrpq. + have Hp : (0 < p)%N. - apply: negbNE; apply/negP => Habs. - rewrite -eqn0Ngt in Habs. move/eqP in Habs. - rewrite Habs /= mul0r in Hrpq. - by rewrite Hrpq in Hrpos. + by apply/contraTT: Hrpos; rewrite Hrpq -eqn0Ngt => /eqP ->; rewrite mul0r. have Hq : (0 < q)%N. - apply: negbNE; apply/negP => Habs. - rewrite -eqn0Ngt in Habs. move/eqP in Habs. - rewrite Habs /= invr0 mulr0 in Hrpq. - by rewrite Hrpq in Hrpos. -have Hle01 : 0 <= 1 :> algC by exact: ler01. -have Hle0r : 0 <= ratr r :> algC by apply: ltrW; rewrite ltr0q. -case/orP: (ger_leVge Hle01 Hle0r) => [H1r|Hr1]. + apply/contraTT: Hrpos; rewrite Hrpq -eqn0Ngt => /eqP ->. + by rewrite invr0 mulr0. +have [H1r|Hr1] := leP 1 r. (* First part : 1 <= r *) -have := (floorQ_spec r). -set f := floorQ r => Hfloor. -have Hfnat : f \is a Znat. - by rewrite Znat_def; apply: floorQ_ge0; apply: ltrW. -move/ZnatP: Hfnat => [] m Hfm. -case/andP: Hfloor => [Hf1 Hf2]. -apply (@ler_trans _ (ratr 8%N%:Q)); last by rewrite ler_rat. -have Hle1m : (1 <= m)%N. - by rewrite ler1q in H1r; have := (floorQ_ge1 H1r); rewrite -/f Hfm. - -have Hfloor_inv : (1%:Q / (f%:Q+1)) < 1%:Q / r <= 1 / f%:Q. - apply/andP; split. - rewrite ltr_pdivr_mulr. - rewrite mulrC mulrA. - rewrite ltr_pdivl_mulr // mul1r mulr1. - exact: Hf2. - rewrite ltr_paddl // ler0z // . - by apply: floorQ_ge0; apply: ltrW. - rewrite ler_pdivr_mulr // . - rewrite mulrC mulrA. - rewrite ler_pdivl_mulr // ?mul1r ?mulr1 ?ltr0z // . - apply: ltr_le_trans; last first. - apply floorQ_ge1. (* apply: does not work *) - by rewrite ler1q in H1r. - exact: ltr01. +have := floorQ_spec r. +set f := floorQ r => /andP[Hf1 Hf2]. +have/ZnatP[m Hfm] : f \is a Znat by rewrite Znat_def; apply/floorQ_ge0/ltW. + +apply: (@le_trans _ _ (ratr 8%:Q)); last by rewrite ler_rat. +have Hle1m : (1 <= m)%N by have := floorQ_ge1 H1r; rewrite -/f Hfm. + +have Hfloor_inv : (f + 1)%:Q^-1 < r^-1 <= f%:Q^-1. + rewrite lef_pinv ?ltf_pinv //= ?posrE ?ltr0z. + - by rewrite andbC mulrzDl floorQ_spec. + - by rewrite gtz0_ge1 ler_addr floorQ_ge0 // ltW. + - by rewrite gtz0_ge1 floorQ_ge1. (* a few helpers which will be needed in the intermediate steps *) -have Helper1 : 0 <= r by exact: ltrW. -have Helper2 : 0 <= 1 / r by rewrite divr_ge0 // . -have Helper3 : 0 <= 1%:~R + 1 / r. - exact: addr_ge0 => // . -have Helper4 : 0 <= 1 / f%:Q. - by rewrite divr_ge0 // Hfm ler0n. -have Helper5 : 0 <= 1%:~R + 1 / f%:Q. - by rewrite addr_ge0. -have Helper6 : 1 <= 1%:~R + 1 / f%:Q. - by rewrite ler_addl. - -suff Hinterm : exp_quo (1%:~R + 1 / r) p q <= exp_quo (1%:Q + 1 / f%:Q) m.+1 1. - apply: (ler_trans Hinterm). - rewrite Hfm. - case: m Hfm Hinterm Hle1m => [| m] Hfm Hinterm // Hle1m. - rewrite -exp_quo_r_nat ler_rat mul1r. - exact: one_plus_invn_expn. -apply: ler_trans. - apply (@exp_quo_less _ (1%:~R + 1 / f%:~R)) => // . - apply: ler_add; first by rewrite lerr. - by case/andP: Hfloor_inv. -apply exp_quo_lessn => // . -rewrite muln1. +have Helper1 : 0 <= r by exact: ltW. +have Helper2 : 0 <= r^-1 by rewrite invr_ge0. +have Helper3 : 0 <= 1 + r^-1 by exact: addr_ge0. +have Helper4 : 0 <= f%:Q^-1 by rewrite invr_ge0 Hfm ler0n. +have Helper5 : 0 <= 1 + f%:Q^-1 by rewrite addr_ge0. +have Helper6 : 1 <= 1 + f%:Q^-1 by rewrite ler_addl. + +suff Hinterm : exp_quo (1 + r^-1) p q <= exp_quo (1 + f%:Q^-1) m.+1 1. + apply: (le_trans Hinterm). + by rewrite Hfm -exp_quo_r_nat ler_rat one_plus_invn_expn. +apply/le_trans. + apply: (@exp_quo_less _ (1 + f%:Q^-1)) => //. + by rewrite ler_add2l; case/andP: Hfloor_inv. +apply: exp_quo_lessn => //. move: Hf2. -have -> : (f%:~R + 1)%Q = (f + 1)%:Q. - by rewrite rmorphD /=. -rewrite Hrpq ltr_pdivr_mulr ?ltr0z // -intrM Hfm -PoszD -PoszM. -by rewrite ltr_nat addn1; exact: leqW. +rewrite muln1 Hfm -rat1 -natrD addn1 Hrpq ltr_pdivr_mulr ?ltr0z //. +by rewrite -natrM ltr_nat; exact: leqW. (* r <= 1 *) -have := (floorQ_spec (r^-1)). -set f := floorQ r^-1 => Hfloor. -have Hfnat : f \is a Znat. - rewrite Znat_def; apply: (@ler_trans _ 1); first by rewrite ler01. - apply: floorQ_ge1; rewrite invr_ge1 //. - by rewrite lerq1 in Hr1. - exact: unitf_gt0. +have := floorQ_spec r^-1. +set f := floorQ r^-1 => /andP[Hf1 Hf2]. +have Hfnat : f \is a Znat by rewrite Znat_def floorQ_ge0 // invr_ge0 ltW. move/ZnatP: Hfnat => [] m Hfm. -case/andP: Hfloor => [Hf1 Hf2]. have Helper0 : 0 < f%:Q. - apply: (@ltr_le_trans _ 1%:Q); last first. - rewrite /f ler_int; apply floorQ_ge1. rewrite invr_ge1; - rewrite lerq1 // in Hr1. - exact: unitf_gt0. - exact: ltr01. + by rewrite ltr0z gtz0_ge1 floorQ_ge1 // invf_ge1 // ltW. have Helper1 : (0 < m)%N. - suff: 0 < m%:Q by rewrite ltr0n. - by rewrite -Hfm. - + by move: Helper0; rewrite Hfm ltr0n. have Helper2 : 0 < f%:Q + 1. - apply: (ltr_le_trans (ltr01)). - by rewrite ler_addr Hfm ler0n. -have Helper3 : r <= 1 / f%:~R. - rewrite ler_pdivl_mulr // mulrC -ler_pdivl_mulr ?div1r //. -have Helper4 : 0 <= 1%:~R + 1 / r. - apply: (@ler_trans _ (1 + f%:~R)). - by rewrite addrC; apply: ltrW. - by apply: ler_add => // ; rewrite div1r. -have Helper5 : 0 <= 1%:~R + (1 + f%:~R)%Q. - by rewrite Hfm -{2}rat1 addrA -!intrD ler0n. -have Helper6 : 1%:~R + 1 / r <= 1%:~R + (1 + f%:~R)%Q. - rewrite Hfm -{2}rat1 ler_add // . - by rewrite div1r -Hfm; apply: ltrW; rewrite addqC. -have Helper7 : 1 <= 1%:~R + (1 + f%:~R)%Q. - by rewrite Hfm -{3}rat1 addrA -!intrD ler1n. -have Helper8 : (p * m <= q)%N. - move: Hf1; rewrite Hfm Hrpq invrM ?invrK. - + rewrite ler_pdivl_mulr. - by rewrite mulrC -intrM ler_int lez_nat. - by rewrite ltr0z. - + by rewrite unitf_gt0 // ltr0z. - + by rewrite unitf_gt0 // invr_gt0 ltr0z. - -have Hfloor_inv : (1%:Q / (f%:Q+1)) < r <= 1 / f%:Q. - apply/andP; split => // . - by rewrite ltr_pdivr_mulr // -ltr_pdivr_mull ?mulr1. -apply: (@ler_trans _ (exp_quo (1%:~R + (1 + f%:~R)%Q) p q)). + by rewrite ltr_paddr. +have Helper3 : r <= f%:Q^-1. + by rewrite -lef_pinv ?posrE ?invr_gt0 // invrK. +have Helper4 : 0 <= 1 + r^-1. + by rewrite ler_paddl //; apply/le_trans/Hf1/ltW. +have Helper5 : 0 <= 1 + (1 + f%:Q). + by rewrite Hfm -rat1 -!intrD ler0n. +have Helper6 : 1 + r^-1 <= 1 + (1 + f%:Q). + by rewrite ler_add2l addrC; apply: ltW. +have Helper7 : 1 <= 1 + (1 + f%:Q). + by rewrite Hfm -rat1 -!intrD ler1n. +have Helper8 : (p * m <= q)%N. + move: Hf1; rewrite Hfm Hrpq invfM invrK. + by rewrite ler_pdivl_mull ?ltr0z // -intrM ler_int. + +have Hfloor_inv : (f%:Q + 1)^-1 < r <= f%:Q^-1. + by rewrite -[r]invrK lef_pinv ?ltf_pinv ?Hf1 ?Hf2 // posrE invr_gt0. +apply: (@le_trans _ _ (exp_quo (1 + (1 + f%:Q)) p q)). exact: exp_quo_less. -apply: (@ler_trans _ (exp_quo (1%:~R + (1 + f%:~R)%Q) 1 m)); last first. -- apply: (@ler_trans _ (exp_quo (((3 ^ (m.+1))%N)%:Q) 1 m)). - * apply exp_quo_less => //; first exact: ler0n. - rewrite -{2}rat1 addrA Hfm -!intrD ler_nat -addnA [(1+m)%N]addnC addn1. - exact: (replace_exponential m.+1). - * rewrite /exp_quo expr1 !CratrE /= expnS natrM rootCMr ?ler0n //. - have -> : 9%:R = 3%:R * 3%:R :> algC by rewrite -natrM. - rewrite ler_pmul // . - + by rewrite rootC_ge0 // ler0n. - + by rewrite rootC_ge0 // ler0n. - + case: m Hfm Helper1 Helper8 => [|m]// _ _ _; exact: le_mrootn_n. - (* TODO: make a lemma out of this *) - rewrite natrX exprCK // ?CratrE // ler0n //. -by apply: exp_quo_lessn=> //; rewrite mul1n. +apply: (@le_trans _ _ (exp_quo (1 + (1 + f%:Q)) 1 m)). + by apply: exp_quo_lessn=> //; rewrite mul1n. +apply: (@le_trans _ _ (exp_quo (((3 ^ (m.+1))%N)%:Q) 1 m)). + apply: exp_quo_less => //; first exact: ler0n. + by rewrite -rat1 Hfm -!natrD ler_nat !add1n replace_exponential. +rewrite /exp_quo expr1 !CratrE /= expnS natrM rootCMr ?ler0n //. +have -> : 9%:R = 3%:R * 3%:R :> algC by rewrite -natrM. +rewrite ler_pmul ?rootC_ge0 ?ler0n //. + case: m Hfm Helper1 Helper8 => [|m]// _ _ _; exact: le_mrootn_n. + (* TODO: make a lemma out of this *) +by rewrite natrX exprCK // ?CratrE // ler0n. Qed. End FourFacts. diff --git a/theories/hanson_elem_arith.v b/theories/hanson_elem_arith.v index d7a7532..23bdc66 100644 --- a/theories/hanson_elem_arith.v +++ b/theories/hanson_elem_arith.v @@ -11,44 +11,14 @@ Require Import field_tactics. Require Import lia_tactics. Require Import extra_mathcomp. -Import GRing.Theory. -Import Num.Theory. - -Section BinomialMissing. - -Lemma ffact_le_expn : forall m p, (p ^_ m <= p ^ m)%N. -elim => [|m HIm] => p //. - rewrite ffactnSr expnS mulnC. - by rewrite leq_mul ?HIm // leq_subr. -Qed. - -End BinomialMissing. - -Section PrimeMissing. -Local Open Scope nat_scope. - -Lemma lognn p (Hp : prime p) : logn p p = 1. -Proof. -by rewrite -(pfactorK 1 Hp). -Qed. - -Lemma partp_dvdn p (Hprime : prime p) n m : - (0 < n) -> (p ^ m %| n) -> p ^ m %| n`_p . -Proof. -move => Hn Hdiv; rewrite -(pfactorK m Hprime) -p_part. -by rewrite partn_dvd //. -Qed. - -End PrimeMissing. +Import Order.TTheory GRing.Theory Num.Theory. Section DefinitionOfA. -Local Open Scope nat_scope. - Fixpoint a (n : nat) : nat := match n with | 0 => 2 - | k.+1 => ((a k) * ((a k).-1)).+1 + | k.+1 => (a k * (a k).-1).+1 end. Arguments a n : simpl never. @@ -64,17 +34,15 @@ Lemma a4 : a 4 = 1807. Proof. by []. Qed. (* We start with trivial facts, tagged in order to feed automation tools in further proofs *) -Lemma aS (n : nat) : a (n.+1) = ((a n) * ((a n).-1)).+1. +Lemma aS (n : nat) : a n.+1 = (a n * (a n).-1).+1. Proof. by []. Qed. Lemma a_pos n : 0 < a n. -Proof. by case: n => [| n]. Qed. +Proof. by case: n. Qed. Hint Resolve a_pos. Lemma a_gt1 n : 1 < a n. -Proof. -by elim: n => [| n ihn] //=; rewrite aS ltnS muln_gt0; case: (a n) ihn. -Qed. +Proof. by elim: n => // n ihn; rewrite aS ltnS muln_gt0; case: (a n) ihn. Qed. Hint Resolve a_gt1. Lemma pa_gt0 n : 0 < (a n).-1. @@ -82,7 +50,7 @@ Proof. by rewrite -ltnS prednK. Qed. Hint Resolve pa_gt0. Lemma a_grows1 n : a n < a n.+1. -Proof. by rewrite /= ltnS leq_pmulr //; case: (a n) (a_gt1 n). Qed. +Proof. by rewrite aS ltnS leq_pmulr. Qed. Lemma a_grows2 m n : a m < a (m + n.+1). Proof. @@ -93,15 +61,16 @@ Qed. Lemma a_grows m n : m <= n -> a m <= a n. Proof. move/subnK<-; rewrite addnC; case: (n - m) => [| k]; first by rewrite addn0. -apply: ltnW; apply: a_grows2. +exact/ltnW/a_grows2. Qed. -Lemma aS_gt2 k : (2 < a k.+1)%nat. -Proof. -suff H1 : (2 < a 1)%nat => // . -apply (leq_trans H1). -apply: a_grows => // . -Qed. +Lemma aS_gt2 k : 2 < a k.+1. +Proof. by suff H1 : (2 < a 1) by apply: leq_trans H1 (a_grows _). Qed. +Hint Resolve aS_gt2. + +Lemma aSpred_gt1 k : (1 < (a k.+1).-1)%N. +Proof. by rewrite -subn1 ltn_subRL addn1. Qed. +Hint Resolve aSpred_gt1. Lemma a_rec (n : nat) : a n = \prod_(0 <= i < n) a i + 1. Proof. @@ -127,10 +96,10 @@ Hint Resolve a_rat_gt1. Lemma a_rat_sub1_gt0 (n : nat) : 0 < (a n)%:Q - 1. by rewrite subr_gt0. Qed. Hint Resolve a_rat_sub1_gt0. -Lemma a_rat_pos (n : nat) : 0 < (a n)%:Q. Proof. by rewrite /a_rat ltr0n. Qed. +Lemma a_rat_pos (n : nat) : 0 < (a n)%:Q. Proof. by rewrite ltr0n. Qed. Hint Resolve a_rat_pos. -Lemma a_rat_ge0 (n : nat) : 0 <= (a n)%:Q. Proof. by rewrite /a_rat ler0n. Qed. +Lemma a_rat_ge0 (n : nat) : 0 <= (a n)%:Q. Proof. by rewrite ler0n. Qed. Hint Resolve a_rat_ge0. Lemma a_rat_rec1 (n : nat) : (a (n.+1))%:Q = (a n)%:Q * ((a n)%:Q - 1) + 1. @@ -150,6 +119,8 @@ End DefinitionOfA. Hint Resolve a_pos. Hint Resolve a_gt1. Hint Resolve pa_gt0. +Hint Resolve aS_gt2. +Hint Resolve aSpred_gt1. Hint Resolve a_rat_gt1. Hint Resolve a_rat_sub1_gt0. @@ -158,8 +129,6 @@ Hint Resolve a_rat_ge0. Section BoundsOnA. -Local Open Scope nat_scope. - Lemma a_lower_bound (k : nat) : 2 ^ (2 ^ k).+1 < a k.+2. Proof. elim: k => [| k ihk] //. @@ -185,8 +154,8 @@ move=> leaSSn; do 2! (apply: trunc_log_max => //); apply: leq_trans leaSSn. exact: a_lower_boundW. Qed. -Lemma k_bound n k (Hank : (a k <= n < (a k.+1))%nat) (le2k : (k >= 2)%nat) : - (k <= trunc_log 2 (trunc_log 2 n) + 2)%nat. +Lemma k_bound n k (Hank : a k <= n < a k.+1) (le2k : k >= 2) : + k <= trunc_log 2 (trunc_log 2 n) + 2. Proof. case/andP: Hank => lean lena. case: k lean lena le2k => // k lean lena le2k. @@ -214,7 +183,7 @@ Lemma n_between_a n (Hn : (2 <= n)) : (a (f_k n) <= n < a ((f_k n).+1)). Proof. elim: n Hn => // n; set k0 := f_k n => ihn. -rewrite leq_eqVlt; case/orP; first by move/eqP <-. +rewrite leq_eqVlt => /predU1P[<- //|]. have -> : f_k n.+1 = if n.+1 < a k0.+1 then k0 else k0.+1 by []. rewrite ltnS; move/ihn. case: ifP; first by move -> => /andP [Hn _]; rewrite ltnW. @@ -236,13 +205,13 @@ Lemma sum_aV (n : nat) : Proof. elim: n => [|n ihn]; first by rewrite big_mkord big_ord1. pose an1 := (a n.+1)%:Q; pose an2 := (a n.+2)%:Q. -suff step : (an1 - 2%:~R) / (an1 - 1) + an1 ^-1 = (an2 - 2%:~R) / (an2 - 1). +suff step : (an1 - 2%:Q) / (an1 - 1) + an1 ^-1 = (an2 - 2%:Q) / (an2 - 1). by rewrite big_nat_recr // ihn /= step. have -> : an2 = an1 * (an1 - 1) + 1 by exact: a_rat_rec1. -have for_field1 : an1 - 1 <> 0 by move/eqP; apply/negP; rewrite /an1 lt0r_neq0. -have for_field2 : an1 <> 0 by move/eqP; apply/negP; rewrite eq_sym /an1 ltr_neq. +have for_field1 : an1 - 1 <> 0 by apply/eqP; rewrite /an1 lt0r_neq0. +have for_field2 : an1 <> 0 by apply/eqP; rewrite eq_sym /an1 ltr_neq. have for_field3 : ((an1 * (an1 - 1)) + 1) - 1 <> 0. - by move/eqP; apply/negP; rewrite addrK mulf_neq0 => //; apply/negP; move/eqP. + by apply/eqP; rewrite addrK mulf_neq0 => //; apply/eqP. rat_field. done. Qed. @@ -256,13 +225,13 @@ Proof. by rewrite sum_aV ltr_pdivr_mulr // mul1r ltr_add2l. Qed. (* observation in lemma 5 from original Hanson paper *) Corollary sum_aV_bis (n : nat) : \sum_(0 <= i < n.+1) ((a i).-1)%:Q / (a_rat i) = - n.+1%:R - (a_rat n.+1 - 2%:~R) / (a_rat n.+1 - 1). + n.+1%:Q - (a_rat n.+1 - 2%:Q) / (a_rat n.+1 - 1). Proof. have -> : \sum_(0 <= i < n.+1) ((a i).-1)%:Q / a_rat i = \sum_(0 <= i < n.+1) (1 - (a_rat i) ^-1). apply: eq_bigr => i _; rewrite -subn1 -subzn ?a_pos // ?rmorphB /= . rewrite /a_rat // ; rat_field. rewrite /emb. - have -> : 0%Q = 0%:~R by []; rewrite eqr_int_prop. + have -> : 0%Q = 0%:Q by []; rewrite eqr_int_prop. have Hpos := (a_pos i); rewrite -ltz_nat in Hpos. by move => Habs; rewrite Habs in Hpos. by rewrite sumrB big_mkord sumr_const /= card_ord sum_aV. @@ -275,10 +244,10 @@ Local Open Scope nat_scope. Corollary suminv_lt1 i n : 0 < n -> \sum_(0 <= j < i) n %/ a j < n. Proof. case: n => [| n] // _; case: i => [| i]; first by rewrite big_nil. -suff : (((\sum_(0 <= j < i.+1) n.+1 %/ a j)%N)%:Q < n.+1%:Q)%R. +suff : ((\sum_(0 <= j < i.+1) n.+1 %/ a j)%N%:Q < n.+1%:Q)%R. by rewrite -ltz_nat ltr_int. suff hdiv : (\sum_(0 <= i0 < i.+1) (n.+1%:Q / (a i0)%:Q) < n.+1%:Q)%R. - apply: ler_lt_trans hdiv; rewrite sumMz; apply: ler_sum => j _. + apply: le_lt_trans hdiv; rewrite sumMz; apply: ler_sum => j _. rewrite ler_pdivl_mulr // -intrM ler_int; exact: leq_trunc_div. rewrite -mulr_sumr gtr_pmulr; last exact: ltr0z. exact: lt_sum_aV_1. @@ -288,7 +257,7 @@ Corollary sum_aV_leqn n k : \sum_(0 <= i < k) n %/ a i <= n. Proof. case: n => [|n]; first by rewrite big1 // => i _; exact: div0n. case: k => [| k]; first by rewrite big_nil. -apply: ltnW; exact: suminv_lt1. +exact/ltnW/suminv_lt1. Qed. @@ -302,8 +271,6 @@ End MajorationOfTheSumOfInversesOfA. Section DefinitionOfCandValuations. -Local Open Scope nat_scope. - (* Note that the formal definition and notations of multinomials is still a bit rough... *) Definition C_row n k := @@ -312,14 +279,13 @@ Definition C_row n k := Definition C n k : nat := 'C[C_row n k] * (n - \sum_(0 <= i < k) n %/ a i)`!. Lemma C_pos n k : 0 < C n k. - by rewrite muln_gt0 multi_gt0 fact_gt0. -Qed. +Proof. by rewrite muln_gt0 multi_gt0 fact_gt0. Qed. Hint Resolve C_pos. Lemma nth_C_row n k i : nth 0 (C_row n k) i = if i < k then n %/ a i - else if i == k then (n - (\sum_(0 <= i < k) n %/ a i)) + else if i == k then n - \sum_(0 <= i < k) n %/ a i else 0. Proof. by rewrite /C_row nth_rcons size_mkseq; case: ifP=> // ltik; rewrite nth_mkseq. @@ -349,6 +315,9 @@ have -> : \sum_(0 <= i < k) nth 0 (C_row n k) i = \sum_(0 <= i < k) n %/ a i. rewrite subnKC //; exact: sum_aV_leqn. Qed. +Lemma C_n0 n : C n 0 = n `!. +Proof. by have := C_multi n 0; rewrite big_nil mul1n. Qed. + Lemma C_0k k : C 0 k = 1. Proof. move: (C_multi 0 k). @@ -360,7 +329,7 @@ Qed. (* The p valuation of a natural number k is (logn p k). So here is a formula for the p-valuation of (C n k) *) Lemma betaE p n k : prime p -> - beta p n k = logn p (n`!) - logn p ((\prod_(0 <= i < k) ((n %/ a i)`!))). + beta p n k = logn p (n`!) - logn p (\prod_(0 <= i < k) (n %/ a i)`!). Proof. move => Hprime; rewrite -(logn_div p); last first. by rewrite -(C_multi n k) dvdn_mulr. @@ -376,20 +345,19 @@ rewrite betaE // logp_sum_floor // logn_prod; last by move=> i; exact: fact_gt0. have -> : \sum_(0 <= i < k) logn p (n %/ a i)`! = \sum_(0 <= i < k) \sum_(j < trunc_log p n) (n %/ a i) %/ p ^ j.+1. apply: eq_bigr => i _; apply: fact_logp_sum_small => //. - apply: (@leq_ltn_trans n); first exact: leq_div. - by apply: trunc_log_ltn; rewrite prime_gt1. + exact/leq_ltn_trans/trunc_log_ltn/prime_gt1/Hprime/leq_div. have -> : \sum_(0 <= i < k) \sum_(j < trunc_log p n) (n %/ a i) %/ p ^ j.+1 = \sum_(j < trunc_log p n) \sum_(0 <= i < k) (n %/ a i) %/ p ^ j.+1. exact: exchange_big_dep. suff maj j : j < trunc_log p n -> \sum_(0 <= i < k) (n %/ a i) %/ p ^ j.+1 < n %/ p ^ j.+1. - rewrite natsumrB; last by case=> i hi _ /=; apply: ltnW; apply: maj. + rewrite natsumrB; last by case=> i hi _ /=; apply/ltnW/maj. have {1}-> : trunc_log p n = \sum_(j < trunc_log p n) 1 by rewrite sum1_ord. by apply: leq_sum=> [] [i hi] _; rewrite subn_gt0; apply: maj. have {Hprime} lt1p : 1 < p by exact: prime_gt1. rewrite -(leq_exp2l j.+1 _ lt1p) => hj. -have {hj} hj : p ^ j.+1 <= n by apply: leq_trans hj _; apply: trunc_logP. +have {}hj : p ^ j.+1 <= n by apply: leq_trans hj (trunc_logP _ _). have -> : \sum_(0 <= i < k) (n %/ a i) %/ p ^ j.+1 = \sum_(0 <= i < k) (n %/ p ^ j.+1) %/ a i. by apply: eq_bigr=> i; rewrite divnAC. @@ -402,7 +370,7 @@ Proof. elim: n => [|n ihn]. by exists 0; rewrite leqnn iter_lcmn0 partn0 partn1. case: ihn => j /andP [lejn] /eqP ihn. -have H1 m : (iter_lcmn m)`_p = \big[lcmn/1%N]_(1 <= i < m.+1) i`_p. +have H1 m : (iter_lcmn m)`_p = \big[lcmn/1]_(1 <= i < m.+1) i`_p. by rewrite /iter_lcmn !big_add1 /= 2!big_mkord partn_biglcm. have {H1} H2 : (iter_lcmn n.+1)`_p = lcmn j`_p n.+1`_p. rewrite H1 big_add1 big_nat_recr // -ihn /=; congr lcmn. @@ -433,16 +401,9 @@ split. case: j lejn lcmnpj => [|j] lejn lcmnpj. by rewrite lcmnpj partn0 expn_gt0 p_gt0. rewrite lcmnpj p_part. - suff Hint : p ^ logn p j.+1 <= p ^ trunc_log p j.+1. - apply: leq_trans Hint _. apply: leq_pexp2l => // . - apply: trunc_log_max => // . - apply: (leq_trans (trunc_logP _ _) _) => // . - apply: leq_pexp2l => // ; exact: leq_logn_trunc. -- suff Hdiv : p ^ trunc_log p n %| (iter_lcmn n)`_p. - by apply: dvdn_leq; rewrite ?part_gt0 // . - apply: partp_dvdn => //. - apply: iter_lcmn_div; first by rewrite expn_gt0 p_gt0. - by rewrite trunc_logP //. + exact/leq_pexp2l/leq_logn_trunc. +- apply/dvdn_leq/partp_dvdn/iter_lcmn_div/trunc_logP => //. + by rewrite expn_gt0 p_gt0. Qed. Lemma lcm_leq_Cnk n k : iter_lcmn n <= C n k. @@ -459,11 +420,9 @@ suff lelogtrunc : logn p ln <= trunc_log p n.+1. exact: leq_trans (Hanson_2 _ _ _). apply: trunc_log_max; first by rewrite prime_gt1. suff Hj : {j | (j <= n.+1) && (ln`_p == j`_p)}. - case: Hj => j /andP [Hj1 Hj2]; rewrite -p_part; move/eqP: Hj2 => -> . + case: Hj => j /andP [Hj1 /eqP]; rewrite p_part => ->. case: j Hj1 => [|j Hj1]; first by rewrite partn0. - suff Hj' : j.+1`_p <= j.+1. - exact : leq_trans Hj1. - by apply: dvdn_leq => //; rewrite dvdn_part. + exact/leq_trans/Hj1/dvdn_leq/dvdn_part. exact: part_p_iter_lcmn. Qed. @@ -472,8 +431,6 @@ End DefinitionOfCandValuations. (* This section presents a first bound on C(n,k) *) Section BoundOnC. -Local Open Scope nat_scope. - (* Lemma 8 of "Hanson Summary" paper *) Lemma l8 n k : (\prod_(0 <= i < k) (n %/ a i) ^ (n %/ a i)) * C n k <= n ^ n. @@ -523,15 +480,12 @@ End BoundOnC. Section UsefulBound. -Local Open Scope nat_scope. - (* nat equivalent of 1 + x <= exp x *) -Lemma replace_exponential (n : nat) : 1 + n <= 3^n. +Lemma replace_exponential (n : nat) : 1 + n <= 3 ^ n. Proof. elim: n => [|n HIn] // . -rewrite expnS -(addn1 n) addnA; apply: (@leq_trans (3^n + 1)). - by apply: (leq_add HIn ). -by rewrite mulSn; apply: leq_add ; rewrite // muln_gt0 expn_gt0. +apply: (@leq_trans (1 + 3 ^ n)); first by rewrite leq_add2l. +by rewrite addnC expnS mulSn leq_add2l muln_gt0 expn_gt0. Qed. End UsefulBound. diff --git a/theories/harmonic_numbers.v b/theories/harmonic_numbers.v index 2fd1a6a..781c756 100644 --- a/theories/harmonic_numbers.v +++ b/theories/harmonic_numbers.v @@ -4,18 +4,17 @@ From mathcomp Require Import all_ssreflect all_algebra. Require Import shift bigopz. Require Import field_tactics. +Import Order.TTheory GRing.Theory Num.Theory. -Import GRing.Theory. -Import Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* Definition of the generalized harmonic numbers, indexed by ints. *) (* The first argument stays in nat. *) Definition ghn (m : nat) (n : int) : rat := - \sum_(1 <= k < n + 1 :> int) (k %:~R ^ m)^-1. + \sum_(1 <= k < n + 1 :> int) (k %:Q ^ m)^-1. Lemma ghn_Sn_inhom m n : n >= 0 -> - ghn m (int.shift 1 n) = ghn m n + ((n%:~R + 1)^m)^-1. + ghn m (int.shift 1 n) = ghn m n + ((n%:Q + 1)^m)^-1. Proof. move=> pn. rewrite /ghn int.shift2Z big_int_recr /= ?rmorphD //=. @@ -28,20 +27,20 @@ Proof. by move=> hn; rewrite /ghn big_geqz // ger_addr. Qed. Lemma ghn1 (m : nat) : ghn m 1 = 1. Proof. by rewrite /ghn big_int_recr //= big_nil add0r exp1rz. Qed. -Lemma ghn_Sn2 m (n_ : int) (n := n_%:~R) : n_ + 1 != 0 -> +Lemma ghn_Sn2 m (n_ : int) (n := n_%:Q) : n_ + 1 != 0 -> ghn m (int.shift 2 n_) = - ((n + 1) ^ m / (n + 2%:~R) ^ m + 1) * ghn m (int.shift 1 n_) - - (n + 1) ^ m / (n + 2%:~R) ^ m * ghn m n_. + ((n + 1) ^ m / (n + 2%:Q) ^ m + 1) * ghn m (int.shift 1 n_) + - (n + 1) ^ m / (n + 2%:Q) ^ m * ghn m n_. Proof. move=> pn2. -case: (lerP n_ 0) => hn. +case: (leP n_ 0) => hn. rewrite [in X in _ = _ - X]ghn_small // mulr0 subr0. rewrite {}/n; case: n_ pn2 hn => [ [] // _ _ | n hn2]. rewrite -[int.shift 2 0]/(int.shift 1 (int.shift 1 0)) [LHS]ghn_Sn_inhom //. by rewrite !int.shift2Z !add0r exp1rz mulrDl !mul1r addrC ghn1 mulr1. case: n hn2 => [| n] hn //. by rewrite !ghn_small ?mulr0 // NegzE int.shift2Z addrC !subzSS add0r oppr_le0. -rewrite ?ghn_Sn_inhom ?ltrW ?addr_gt0 //=. +rewrite ?ghn_Sn_inhom ?ltW ?addr_gt0 //=. rewrite int.shift2R -/n. move: (ghn m n_) => x. apply/eqP; rewrite -subr_eq0 -!addrA addr_eq0; apply/eqP. @@ -55,11 +54,11 @@ rat_field. rewrite /p1 /p2. (* These two lemmas could be handled by a lia tactic. *) -have hn01 : n + 2%:~R != 0 :> rat. +have hn01 : n + 2%:Q != 0. rewrite addr_eq0 -rmorphN /= -NegzE eqr_int. by apply/eqP => nD; move: hn; rewrite nD. -have hn02 : n + 1%:~R != 0 :> rat. +have hn02 : n + 1%:Q != 0. rewrite addr_eq0 -rmorphN /= -NegzE eqr_int. by apply/eqP => nD; move: hn; rewrite nD. by repeat split; apply/eqP; rewrite ?expfz_eq0 // negb_and ?hn01 ?hn02 orbT. diff --git a/theories/initial_conds.v b/theories/initial_conds.v index 730ff46..45e1b52 100644 --- a/theories/initial_conds.v +++ b/theories/initial_conds.v @@ -1,14 +1,11 @@ From mathcomp Require Import all_ssreflect all_algebra. -Require Import binomialz bigopz. -Require Import field_tactics lia_tactics shift. +Require Import binomialz. +Require Import field_tactics. Require Import seq_defs. Require harmonic_numbers. -Import GRing.Theory. -Import Num.Theory. - -Open Scope ring_scope. +Local Open Scope ring_scope. Set Implicit Arguments. Unset Strict Implicit. @@ -66,7 +63,7 @@ Import ZArith. Lemma b0_eq : b 0 = 0. Proof. solve_b_evaluation. Qed. -Lemma b1_eq : b 1 = 6%:~R. +Lemma b1_eq : b 1 = 6%:Q. Proof. solve_b_evaluation. Qed. Lemma b2_eq : b 2 = rat_of_Z 351 / rat_of_Z 4. diff --git a/theories/lia_tactics.v b/theories/lia_tactics.v index 436573a..d5b885a 100644 --- a/theories/lia_tactics.v +++ b/theories/lia_tactics.v @@ -9,8 +9,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. Local Open Scope ring_scope. Delimit Scope Z_scope with coqZ. @@ -42,22 +41,22 @@ Lemma Z_ltP (x y : int) : (x < y) <-> (Z.lt (Z_of_int x) (Z_of_int y)). Proof. split; case: x=> [[|xx]|xx]; case: y => [[|yy]|y] //. - move=> h; rewrite /= !Zpos_P_of_succ_nat; apply: Zsucc_lt_compat; apply: inj_lt. - exact: ltP. + exact: ssrnat.ltP. - rewrite /Z_of_int; rewrite !NegzE => h. - have {h} : (Z_of_nat y.+1 < Z_of_nat xx.+1)%coqZ by apply/inj_lt/ltP. + have {h} : (Z_of_nat y.+1 < Z_of_nat xx.+1)%coqZ by apply/inj_lt/ssrnat.ltP. by lia. -- by rewrite /= !Zpos_P_of_succ_nat; move/Zsucc_lt_reg/inj_lt_rev/ltP. +- by rewrite /= !Zpos_P_of_succ_nat; move/Zsucc_lt_reg/inj_lt_rev/ssrnat.ltP. - rewrite /Z_of_int !NegzE => h. - have {h} : (Z_of_nat y.+1 < Z_of_nat xx.+1)%coqZ by lia. - by move/inj_lt_rev/ltP. + by move/inj_lt_rev/ssrnat.ltP. Qed. Lemma Z_leP (x y : int) : (x <= y) <-> Z.le (Z_of_int x) (Z_of_int y). Proof. split. -- rewrite ler_eqVlt; case/orP; first by move/eqP->; exact: Z.le_refl. +- rewrite le_eqVlt; case/orP; first by move/eqP->; exact: Z.le_refl. move/Z_ltP; exact: Zlt_le_weak. -case/Z_le_lt_eq_dec; first by move/Z_ltP/ltrW. +case/Z_le_lt_eq_dec; first by move/Z_ltP/ltW. by move/Z_of_intP->. Qed. @@ -73,15 +72,15 @@ Ltac zify_int_rel := | H : context [ @eq _ ?a ?b ] |- _ => rewrite -> (Z_of_intP a b) in H | |- context [ @eq _ ?a ?b ] => rewrite -> (Z_of_intP a b) (* less than *) - | H : is_true (@Num.Def.ltr _ _ _) |- _ => move/Z_ltP: H => H - | |- is_true (@Num.Def.ltr _ _ _) => rewrite -> Z_ltP - | H : context [ is_true (@Num.Def.ltr _ ?a ?b) ] |- _ => rewrite -> (Z_ltP a b) in H - | |- context [ is_true (@Num.Def.ltr _ ?a ?b) ] => rewrite -> (Z_ltP a b) + | H : is_true (@Order.lt _ _ _ _) |- _ => move/Z_ltP: H => H + | |- is_true (@Order.lt _ _ _ _) => rewrite -> Z_ltP + | H : context [ is_true (@Order.lt _ _ ?a ?b) ] |- _ => rewrite -> (Z_ltP a b) in H + | |- context [ is_true (@Order.lt _ _ ?a ?b) ] => rewrite -> (Z_ltP a b) (* less or equal *) - | H : is_true (@Num.Def.ler _ _ _) |- _ => move/Z_leP: H => H - | |- is_true (@Num.Def.ler _ _ _) => rewrite -> Z_leP - | H : context [ is_true (@Num.Def.ler _ ?a ?b) ] |- _ => rewrite -> (Z_leP a b) in H - | |- context [ is_true (@Num.Def.ler _ ?a ?b) ] => rewrite -> (Z_leP a b) + | H : is_true (@Order.le _ _ _ _) |- _ => move/Z_leP: H => H + | |- is_true (@Order.le _ _ _ _) => rewrite -> Z_leP + | H : context [ is_true (@Order.le _ _ ?a ?b) ] |- _ => rewrite -> (Z_leP a b) in H + | |- context [ is_true (@Order.le _ _ ?a ?b) ] => rewrite -> (Z_leP a b) (* Boolean equality *) |H : is_true (@eq_op _ _ _) |- _ => rewrite -> Z_of_intbP in H | |- is_true (@eq_op _ _ _) => rewrite -> Z_of_intbP @@ -101,11 +100,11 @@ have aux (n m : nat) : Z_of_int (Posz n.+1 + Negz m) = (Z_of_int n.+1 + Z_of_int (Negz m))%coqZ. rewrite {2 3}/Z_of_int NegzE; case: (ltngtP m n)=> hmn. + rewrite subzn; last exact: ltn_trans hmn _. - rewrite subSn // /Z_of_int -subSn // inj_minus1 //; apply/leP. + rewrite subSn // /Z_of_int -subSn // inj_minus1 //; apply/ssrnat.leP. exact: ltn_trans hmn _. + rewrite -[_ - _]opprK opprB subzn; last exact: ltn_trans hmn _. rewrite subSn // -NegzE /Z_of_int -subSn // inj_minus1; first by lia. - apply/leP; exact: ltn_trans hmn _. + apply/ssrnat.leP; exact: ltn_trans hmn _. + by rewrite hmn subrr Zplus_opp_r. move=> x y /=; case: x=> [[|xx]|xx]; case: y => [[|yy]|y] //. - by rewrite /= subn0. @@ -212,7 +211,7 @@ repeat (match goal with | |- context [ is_true (andb _ _) ] => rewrite -(rwP andP) | H : context [ is_true (orb _ _) ] |- _ => rewrite -(rwP orP) in H | |- context [ is_true (orb _ _) ] => rewrite -(rwP orP) end); -rewrite ?(=^~ ltrNge, =^~ lerNgt). +rewrite ?(=^~ ltNge, =^~ leNgt). Ltac goal_to_lia := propify_bool_connectives; diff --git a/theories/multinomial.v b/theories/multinomial.v index 772962e..dc0823c 100644 --- a/theories/multinomial.v +++ b/theories/multinomial.v @@ -2,12 +2,7 @@ From mathcomp Require Import all_ssreflect all_algebra. Require Import extra_mathcomp. - - -Import GRing.Theory. -Import Num.Theory. - -Open Scope nat_scope. +Import Order.TTheory GRing.Theory Num.Theory. Local Notation "s `_ i" := (nth 0 s i) : nat_scope. @@ -83,18 +78,18 @@ Notation "'BIG_op_P' op" := (* For the sake of compatibility with hanson. Note that the sum and prod should be moved to a \sum_(j <- l)_ shape. *) Lemma eq_def_multiQ l : - 'C[l]%:Q = - (\sum_(0 <= i < size l) l`_i)`!%N%:Q / - (\prod_(0 <= i < size l) (l`_i)`!)%N%:Q. + ('C[l]%:Q = + (\sum_(0 <= i < size l) l`_i)`!%:Q / + (\prod_(0 <= i < size l) (l`_i)`!)%N%:Q)%R. Proof. -have dn0 : (\prod_(i <- l) i `!)%N%:Q != 0%:Q. +have dn0 : ((\prod_(i <- l) i `!)%N%:Q != 0)%R. rewrite pnatr_eq0 -lt0n prodn_gt0 // => i; exact: fact_gt0. rewrite -(big_nth 0 xpredT) -(big_nth 0 xpredT id). (* booh *) by rewrite -multi_prod_fact !PoszM !rmorphM /= mulfK. Qed. (* Because it is basically mulnK *) -Lemma whyIsThisNotProved (m d n : nat) : ((0 < d) -> m * d = n -> m = n %/ d)%N. +Lemma whyIsThisNotProved (m d n : nat) : 0 < d -> m * d = n -> m = n %/ d. Proof. by move=> d_gt0 <-; rewrite mulnK. Qed. (* Compatiblity again. *) @@ -105,8 +100,7 @@ rewrite -(big_nth 0 xpredT) -(big_nth 0 xpredT id). (* booh *) exact: multi_prod_fact. Qed. - -Open Scope ring_scope. +Local Open Scope ring_scope. Section Monomials. @@ -200,22 +194,11 @@ Qed. End GNewton. -Section SSRalgMissingInOldButPresentInNew. - -Local Open Scope ring_scope. - -Variable R : ringType. -Implicit Types x y : R. - - -End SSRalgMissingInOldButPresentInNew. - Section MultinomialIneq. Context {R : comUnitRingType}. -Open Scope nat_scope. - +Local Open Scope nat_scope. Lemma multinomial_ineq (l : seq nat) (p := \prod_(j <- l) j ^ j) (s := \sum_(j <- l) j) : 'C[l] * p <= s ^ s. @@ -233,7 +216,7 @@ Proof. pose tl := mktuple aux. have Heq : tmap_val tl = l. suff Heq1 (i : 'I_(size l)) : nth 0 (tmap_val tl) i = nth 0 l i. - apply: (@eq_from_nth nat 0 _ _ ); rewrite size_map size_tuple // . + apply: (@eq_from_nth nat 0 _ _); rewrite size_map size_tuple // . move => i Hisize. suff -> : nth 0 (tmap_val tl) (Ordinal Hisize) = nth 0 l (Ordinal Hisize) by []. exact: Heq1. diff --git a/theories/ops_for_a.v b/theories/ops_for_a.v index 053a5a8..fa94fdb 100644 --- a/theories/ops_for_a.v +++ b/theories/ops_for_a.v @@ -30,10 +30,10 @@ Qed. Let a (n : int) : rat := \sum_(0 <= k < n + 1 :> int) (c n k). -Theorem recAperyA (n : int) : n >= (2 : int) -> c.P_horner a n = 0. +Theorem recAperyA (n : int) : 2 <= n :> int -> c.P_horner a n = 0. Proof. move=> nge2. -have nge0 : n >= 0 by apply: ler_trans nge2. +have nge0 : n >= 0 by apply: le_trans nge2. rewrite /c.P_horner. rewrite (punk.sound_telescoping P_eq_Delta_Q) //; last exact: addr_ge0. set telQ := (X in X + _ + _). @@ -46,11 +46,11 @@ have onDE : onD = rewrite /onD /c.not_D big_int_cond /= int.shift2Z. rewrite (eq_bigl (fun i => i == n)); last first. move=> j /=; rewrite ltz_addr1; case: (altP (j =P n)). - - by move ->; rewrite ltrr andbF /= nge0 lerr. + - by move ->; rewrite ltxx andbF /= nge0 lexx. - move=> njn. - rewrite nge0 /=; case: (0 <= j) => //=; rewrite -lerNgt. - by rewrite -eqr_le (negPf njn). - by rewrite big_pred1_eqz ltz_addr1 nge0 lerr. + rewrite nge0 /=; case: (0 <= j) => //=; rewrite -leNgt. + by rewrite -eq_le (negPf njn). + by rewrite big_pred1_eqz ltz_addr1 nge0 lexx. (* We simplify using the cancellations of onD with telQ. *) (* This step is REQUIRED because terms in onD have potential divisions by 0. *) have {telQ} -> : diff --git a/theories/ops_for_b.v b/theories/ops_for_b.v index 87e14a5..37a15e1 100644 --- a/theories/ops_for_b.v +++ b/theories/ops_for_b.v @@ -19,11 +19,9 @@ Theorem P_eq_Delta_Q : v.CT v. Proof. rewrite /v.CT => n k; rewrite /v.not_D; andb_to_and => notD. rewrite /v.P_horner /v.P_seq /punk.horner_seqop /= /v.Q_flat. -do 5! (rewrite v_Sn2; - last by rewrite /v.precond.Sn2 ?int.shift2Z; intlia). -rewrite v_SnSk; - last by rewrite /v.precond.SnSk ?int.shift2Z; intlia. -rewrite v_Sk2; last by rewrite /v.precond.Sk2 ?int.shift2Z; intlia. +do 5! (rewrite v_Sn2; last by rewrite /v.precond.Sn2; intlia). +rewrite v_SnSk; last by rewrite /v.precond.SnSk; intlia. +rewrite v_Sk2; last by rewrite /v.precond.Sk2; intlia. (* Sanity check: at this point, we have a normal form wrt the Gröbner basis. *) set v1 := v _ _; set v2 := v _ _; set v3 := v _ _. (* set v4 := v _ _. *) (* This unfolding takes a dozen seconds if the Q_cf are unfolded first: *) @@ -48,7 +46,7 @@ Proof using v v_ann v_Sn2 v_SnSk v_Sk2 b. move=> nge2. rewrite /v.P_horner. rewrite (punk.sound_telescoping P_eq_Delta_Q) //; - last exact: (addr_ge0 (ler_trans _ nge2) _). + last exact: (addr_ge0 (le_trans _ nge2) _). set onD := (X in _ + X + _). set remP := (X in _ + _ + X). set F := BIG_F in onD *. @@ -114,32 +112,24 @@ have -> : around_n_0 = 0. Fail set c := v _ _. (* This one will be produced by the normalization *) pose c21 := v (int.shift 2 n) (int.shift 1 0). - rewrite [c40]v_Sn2; last first. - rewrite /v.precond.Sn2; goal_to_lia; intlia. + rewrite [c40]v_Sn2; last by rewrite /v.precond.Sn2; intlia. rewrite {c40} -/c30 -/c20 -/c21. - rewrite [c30]v_Sn2; last first. - rewrite /v.precond.Sn2; goal_to_lia; intlia. + rewrite [c30]v_Sn2; last by rewrite /v.precond.Sn2; intlia. rewrite {c30} -/c20 -/c11 -/c10. - rewrite [c21]v_SnSk; last first. - rewrite /v.precond.SnSk; goal_to_lia; intlia. + rewrite [c21]v_SnSk; last by rewrite /v.precond.SnSk; intlia. rewrite {c21} -/c11 -/c20 -/c10. - rewrite [c20]v_Sn2; last first. - by rewrite /v.precond.Sn2; goal_to_lia; intlia. + rewrite [c20]v_Sn2; last by rewrite /v.precond.Sn2; intlia. rewrite {c20} -/c00 -/c10 -/c01. - rewrite [c02]v_Sk2; last first. - rewrite /v.precond.Sk2; goal_to_lia; intlia. + rewrite [c02]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {c02} -/c00 -/c01. - rewrite [c11]v_SnSk; last first. - rewrite /v.precond.SnSk; goal_to_lia; intlia. + rewrite [c11]v_SnSk; last by rewrite /v.precond.SnSk; intlia. rewrite {c11} -/c00 -/c01 -/c10. (* See comments about the protocole in the second normalization. *) set n1 := int.shift 1 n. set n2 := int.shift 2 n. (* Now we are under the stairs. *) - have hn1 : n1%:~R = n%:~R + rat_of_Z 1. - by rewrite rat_of_ZEdef rmorphD. - have hn2 : n2%:~R = n%:~R + rat_of_Z 2. - rewrite !rmorphD /=; rat_field. + have hn1 : n1%:Q = n%:Q + rat_of_Z 1 by rewrite rat_of_ZEdef rmorphD. + have hn2 : n2%:Q = n%:Q + rat_of_Z 2 by rewrite !rmorphD /=; rat_field. rewrite /v.P_cf0 /v.P_cf1 /v.P_cf2 /v.P_cf3. rewrite /v.P_cf4 /v.Q_cf0_0 /v.Q_cf0_1. rewrite /v.Q_cf1_0 /v.Sk2_cf0_0 /v.Sk2_cf0_1. @@ -192,57 +182,40 @@ set v54 := v (int.shift 5 p) (int.shift 4 p). set v55 := v (int.shift 5 p) (int.shift 5 p). Fail set vvv := v _ _. (* Normalization modulo annulators of v. *) -rewrite [v55]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v55]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v55} -/v54 -/v53 -/v52 -/v51 -/v50. -rewrite [v54]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v54]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v54} -/v53 -/v52 -/v51 -/v50. -rewrite [v53]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v53]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v53} -/v52 -/v51 -/v50. -rewrite [v52]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v52]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v52} -/v51 -/v50. -rewrite [v44]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v44]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v44} -/v43 -/v42 -/v41 -/v40. -rewrite [v43]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v43]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v43} -/v42 -/v41 -/v40. -rewrite [v42]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v42]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v42} -/v41 -/v40. -rewrite [v33]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v33]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v33} -/v32 -/v31 -/v30. -rewrite [v32]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v32]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v32} -/v31 -/v30. -rewrite [v22]v_Sk2; last first. - by rewrite /v.precond.Sk2; goal_to_lia; intlia. +rewrite [v22]v_Sk2; last by rewrite /v.precond.Sk2; intlia. rewrite {v22} -/v21 -/v20. (* Use v_SnSk and v_Sn2 in alternation: *) -rewrite [v51]v_SnSk; last first. - by rewrite /v.precond.SnSk; goal_to_lia; intlia. +rewrite [v51]v_SnSk; last by rewrite /v.precond.SnSk; intlia. rewrite {v51} -/v50 -/v40 -/v41. -rewrite [v50]v_Sn2; last first. - by rewrite /v.precond.Sn2; goal_to_lia; intlia. +rewrite [v50]v_Sn2; last by rewrite /v.precond.Sn2; intlia. rewrite {v50} -/v40 -/v30 -/v31. -rewrite [v41]v_SnSk; last first. - by rewrite /v.precond.SnSk; goal_to_lia; intlia. +rewrite [v41]v_SnSk; last by rewrite /v.precond.SnSk; intlia. rewrite {v41} -/v40 -/v30 -/v31. -rewrite [v40]v_Sn2; last first. - by rewrite /v.precond.Sn2; goal_to_lia; intlia. +rewrite [v40]v_Sn2; last by rewrite /v.precond.Sn2; intlia. rewrite {v40} -/v30 -/v20 -/v21. -rewrite [v31]v_SnSk; last first. - by rewrite /v.precond.SnSk ; goal_to_lia; intlia. +rewrite [v31]v_SnSk; last by rewrite /v.precond.SnSk; intlia. rewrite {v31} -/v30 -/v20 -/v21. -rewrite [v30]v_Sn2; last first. - by rewrite /v.precond.Sn2; goal_to_lia; intlia. +rewrite [v30]v_Sn2; last by rewrite /v.precond.Sn2; intlia. rewrite {v30} -/v20 -/v10 -/v11. -rewrite [v21]v_SnSk; last first. - by rewrite /v.precond.SnSk; goal_to_lia; intlia. +rewrite [v21]v_SnSk; last by rewrite /v.precond.SnSk; intlia. (* Now we are under the stair, we unfold the coefficients of the operators *) (* and call field. *) rewrite {v21} -/v20 -/v10 -/v11. @@ -255,14 +228,14 @@ set p4 := int.shift 4 p. set p5 := int.shift 5 p. (* We pre-compute the desired expressions for the embeddings in rat of the p* *) (* that will occur after unfolding the operators. *) -have kp1 : p1%:~R = p%:~R + 1 :> rat by rewrite /p1 int.shift2R. -have kp2 : p2%:~R = p%:~R + rat_of_Z 2 :> rat. +have kp1 : p1%:Q = p%:Q + 1 by rewrite /p1 int.shift2R. +have kp2 : p2%:Q = p%:Q + rat_of_Z 2. by rewrite /p1 int.shift2R rat_of_ZEdef. -have kp3 : p3%:~R = p%:~R + rat_of_Z 3 :> rat. +have kp3 : p3%:Q = p%:Q + rat_of_Z 3. by rewrite /p1 int.shift2R rat_of_ZEdef. -have kp4 : p4%:~R = p%:~R + rat_of_Z 4 :> rat. +have kp4 : p4%:Q = p%:Q + rat_of_Z 4. by rewrite /p1 int.shift2R rat_of_ZEdef. -have kp5 : p5%:~R = p%:~R + rat_of_Z 5 :> rat. +have kp5 : p5%:Q = p%:Q + rat_of_Z 5. by rewrite /p1 int.shift2R rat_of_ZEdef. rewrite /v.P_cf0 /v.P_cf1 /v.P_cf2 /v.P_cf3. rewrite /v.P_cf4 /v.Q_cf0_0 /v.Q_cf0_1. diff --git a/theories/ops_for_s.v b/theories/ops_for_s.v index 789cd85..556e7e5 100644 --- a/theories/ops_for_s.v +++ b/theories/ops_for_s.v @@ -25,7 +25,7 @@ andb_to_and => ?; rewrite /d.P1_horner /d.P1_seq. rewrite /punk.biv_horner_seqop2 /punk.biv_horner_seqop. rewrite /punk.biv_horner_seqop_rec /punk.pfun2 /d.Q1_flat /=. do 4! (rewrite d_Sn; last by rewrite /d.precond.Sn; intlia). -do 2! (rewrite d_Sk; last by rewrite /d.precond.Sk). +do 2! rewrite d_Sk //. rewrite d_Sm; last by rewrite /d.precond.Sm; intlia. set d_nmk := d _ _ _. Fail set dtest := d _ _ _. @@ -63,7 +63,7 @@ move => n m k; rewrite (* /d.P_eq_Delta_Q_fmt *) /d.not_D3; andb_to_and => ?. rewrite /d.P3_horner /d.P3_seq /punk.biv_horner_seqop2 /punk.biv_horner_seqop. rewrite /punk.biv_horner_seqop_rec /punk.pfun2 /d.Q3_flat /=. do 2! (rewrite d_Sn; last by rewrite /d.precond.Sn; intlia). -rewrite d_Sk; last by rewrite /d.precond.Sk. +rewrite d_Sk //. rewrite d_Sm; last by rewrite /d.precond.Sm; intlia. set d_nmk := d _ _ _. Fail set dtest := d _ _ _. @@ -79,7 +79,7 @@ Proof. move => n m k; rewrite (* /d.P_eq_Delta_Q_fmt *) /d.not_D4; andb_to_and => ?. rewrite /d.P4_horner /d.P4_seq /punk.biv_horner_seqop2 /punk.biv_horner_seqop. rewrite /punk.biv_horner_seqop_rec /punk.pfun2 /d.Q4_flat /=. -do 2! (rewrite d_Sk; last by rewrite /d.precond.Sk ). +do 2! rewrite d_Sk //. rewrite d_Sm; last by rewrite /d.precond.Sm; intlia. set d_nmk := d _ _ _. Fail set dtest := d _ _ _. @@ -142,7 +142,6 @@ have -> : onD = 0. rewrite /d.not_D1. apply: negbTE. - rewrite negb_and negbK negb_and -lerNgt -ltrNge orb_andr. by goal_to_lia; intlia. rewrite {}/telQ {}/remP. @@ -188,7 +187,6 @@ have -> : onD = 0. rewrite /d.not_D2. apply: negbTE. - rewrite negb_and negbK negb_and -lerNgt -ltrNge orb_andr. by goal_to_lia; intlia. rewrite {}/telQ. @@ -235,7 +233,7 @@ have -> : onD = 0. rewrite /d.not_D3. apply: negbTE. - rewrite negb_and negbK negb_and -lerNgt -ltrNge orb_andr. + rewrite negb_and negbK negb_and -leNgt -ltNge orb_andr. by goal_to_lia; intlia. rewrite {}/telQ {}/remP. @@ -286,7 +284,7 @@ have -> : onD = 0. rewrite /d.not_D4. apply: negbTE. - rewrite negb_and negbK negb_and -lerNgt -ltrNge orb_andr. + rewrite negb_and negbK negb_and -leNgt -ltNge orb_andr. by goal_to_lia; intlia. rewrite {}/telQ {}/remP. @@ -359,8 +357,8 @@ Proof. rewrite /Sn2 /precond.Sn2 => n k [ltk0 ltkn]. have Sn2_lcomb_eq_0 : Sn2_lcomb s n k = 0. rewrite /Sn2_lcomb /Sn2_lcomb_cf2 /Sn2_lcomb_cf4 -rat_of_Z_0 !mul0r !addr0. - rewrite -/P1_flat recD1_flat recD1; try intlia. - rewrite -/P3_flat recD3_flat recD3; try intlia. + rewrite -/P1_flat recD1_flat recD1 //. + rewrite -/P3_flat recD3_flat recD3 //. by rewrite !mulr0 !addr0. apply/eqP. rewrite -subr_eq0. @@ -370,11 +368,11 @@ have nzero_n0 : nzero != 0. rewrite mulf_eq0 /Sn2_lcomb_cf1 /d.P1_cf2_0. rewrite negb_or expfz_neq0 ?andbT; last first. (* missing lemmas in Nums *) - suff aux : n%:~R + rat_of_Z 2 > 0 by rewrite -normr_gt0 gtr0_norm. - rewrite rat_of_ZEdef addr_gt0 // ltr0z. exact: ler_lt_trans ltkn. - suff aux : n%:~R + rat_of_Z 2 + k%:~R > 0 by rewrite -normr_gt0 gtr0_norm. + suff aux : n%:Q + rat_of_Z 2 > 0 by rewrite -normr_gt0 gtr0_norm. + rewrite rat_of_ZEdef addr_gt0 // ltr0z. exact: le_lt_trans ltkn. + suff aux : n%:Q + rat_of_Z 2 + k%:Q > 0 by rewrite -normr_gt0 gtr0_norm. apply: ltr_spaddl; last by rewrite ler0z. - rewrite rat_of_ZEdef addr_gt0 // ?ltr0z //. exact: ler_lt_trans ltkn. + rewrite rat_of_ZEdef addr_gt0 // ?ltr0z //. exact: le_lt_trans ltkn. rewrite -(mulrI_eq0 _ (lregP nzero_n0)) {nzero_n0}. rewrite -Sn2_lcomb_eq_0. apply/eqP. @@ -407,11 +405,11 @@ rewrite -subr_eq0. set nzero := d.P3_cf1_1 n k. have nzero_n0 : nzero != 0. rewrite /nzero /d.P3_cf1_1. - suff aux : n%:~R + rat_of_Z 2 + k%:~R > 0 by rewrite -normr_gt0 gtr0_norm. + suff aux : n%:Q + rat_of_Z 2 + k%:Q > 0 by rewrite -normr_gt0 gtr0_norm. rewrite rat_of_ZEdef -addrA addr_gt0 //. - by rewrite ltr0z; apply: ler_lt_trans ltkn. - have le0k : 0 <= k%:~R :> rat by rewrite ler0z. - by apply: ler_lt_trans le0k _; rewrite ltr_addr. + by rewrite ltr0z; apply: le_lt_trans ltkn. + have le0k : 0 <= k%:Q by rewrite ler0z. + by apply: le_lt_trans le0k _; rewrite ltr_addr. rewrite -(mulrI_eq0 _ (lregP nzero_n0)) // {nzero_n0}. rewrite -SnSk_lcomb_eq_0. apply/eqP. @@ -444,15 +442,15 @@ rewrite -subr_eq0. set nzero := d.P4_cf0_2 n k. have nzero_n0 : nzero != 0. rewrite /nzero /d.P4_cf0_2 mulf_neq0 //; last first. - suff aux : - n%:~R + k%:~R + rat_of_Z 1 < 0. + suff aux : - n%:Q + k%:Q + rat_of_Z 1 < 0. by rewrite -normr_gt0 // ltr0_norm // oppr_gt0. by rewrite rat_of_ZEdef -addrA addrC subr_lt0 -intrD ltr_int. - have kp2gt0 : k%:~R + rat_of_Z 2 > 0. + have kp2gt0 : k%:Q + rat_of_Z 2 > 0. by rewrite rat_of_ZEdef ltr_paddl // ler0z. rewrite mulf_neq0 //; first by rewrite -normr_gt0 gtr0_norm. - suff aux : n%:~R + rat_of_Z 2 + k%:~R > 0 by rewrite -normr_gt0 gtr0_norm. + suff aux : n%:Q + rat_of_Z 2 + k%:Q > 0 by rewrite -normr_gt0 gtr0_norm. rewrite -addrA [in X in _ + X]addrC addr_gt0 // ltr0z. - by apply: ler_lt_trans ltk0 _; apply: ltr_trans ltSkn; rewrite ltr_addl. + by apply: le_lt_trans ltk0 _; apply: lt_trans ltSkn; rewrite ltr_addl. rewrite -(mulrI_eq0 _ (lregP nzero_n0)) // {nzero_n0}. rewrite -Sk2_lcomb_eq_0. apply/eqP. diff --git a/theories/ops_for_u.v b/theories/ops_for_u.v index cbf88c9..f7193ad 100644 --- a/theories/ops_for_u.v +++ b/theories/ops_for_u.v @@ -36,7 +36,7 @@ have ? := z_ann. rewrite /s.Sk2 /s.precond.Sk2. move => n k ?. rewrite /u. -do 1! (rewrite s_Sk2 => //). +rewrite s_Sk2 //. set s1 := s _ _. set s2 := s _ _. set z1 := z _. @@ -52,7 +52,7 @@ have ? := z_ann. rewrite /s.SnSk /s.precond.SnSk. move => n k ?. rewrite /u. -do 1! (rewrite s_SnSk => //). +rewrite s_SnSk //. set s1 := s _ _. set s2 := s _ _. set s3 := s _ _. @@ -68,8 +68,8 @@ Proof. rewrite /s.Sn2 /s.precond.Sn2. move => n k ?. rewrite /u. -do 1! rewrite z_Sn2; last by (rewrite /z.precond.Sn2; intlia). -do 1! (rewrite s_Sn2 => //). +rewrite z_Sn2; last by rewrite /z.precond.Sn2; intlia. +rewrite s_Sn2 //. set s1 := s _ _. set s2 := s _ _. set s3 := s _ _. diff --git a/theories/ops_for_v.v b/theories/ops_for_v.v index 7a91f6c..990d2ac 100644 --- a/theories/ops_for_v.v +++ b/theories/ops_for_v.v @@ -94,4 +94,3 @@ rewrite /emb /emb0; goal_to_lia; intlia. Qed. End AnnOfV. - diff --git a/theories/posnum.v b/theories/posnum.v index bf1db2c..81ef889 100644 --- a/theories/posnum.v +++ b/theories/posnum.v @@ -33,14 +33,9 @@ From mathcomp Require Import all_ssreflect all_algebra all_field. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory Num.Def Num.Theory. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Delimit Scope R_scope with coqR. -Delimit Scope real_scope with real. -Close Scope R_scope. -Open Scope ring_scope. -(* Open Scope real_scope. *) -(* Bind Scope ring_scope with R. *) +Local Open Scope ring_scope. (* Enrico's trick for tc resolution in have *) (* Notation "!! x" := (ltac:(refine x)) (at level 100, only parsing). *) @@ -84,9 +79,9 @@ Implicit Types (x y : {posnum R}). Definition posnum_gt0_def x (phx : phantom R x) := posnum_gt0 x. -Lemma posnum_ge0 x : x >= 0 :> R. Proof. by apply: ltrW. Qed. -Lemma posnum_eq0 x : (x == 0 :> R) = false. Proof. by rewrite gtr_eqF. Qed. -Lemma posnum_neq0 x : (x != 0 :> R). Proof. by rewrite gtr_eqF. Qed. +Lemma posnum_ge0 x : x >= 0 :> R. Proof. by apply: ltW. Qed. +Lemma posnum_eq0 x : (x == 0 :> R) = false. Proof. by rewrite gt_eqF. Qed. +Lemma posnum_neq0 x : (x != 0 :> R). Proof. by rewrite gt_eqF. Qed. Lemma add_pos_gt0 x y : 0 < x%:num + y%:num. Proof. by rewrite addr_gt0. Qed. @@ -103,11 +98,11 @@ Canonical mulrn_posnum x n := PosNum (muln_pos_posnum x n). Lemma inv_pos_gt0 x : 0 < x%:num^-1. Proof. by rewrite invr_gt0. Qed. Canonical invr_posnum x := PosNum (inv_pos_gt0 x). -Lemma pos_Sn (n : nat) : 0 < (n.+1%:R : R). +Lemma pos_Sn (n : nat) : 0 < n.+1%:R :> R. Proof. by []. Qed. Canonical Sn_posnum n := PosNum (pos_Sn n). -Lemma posnumSz (n : nat) : 0 < ((n.+1)%:~R : R). +Lemma posnumSz (n : nat) : 0 < n.+1%:~R :> R. Proof. by rewrite ltr0z. Qed. Canonical intSn_posnum n := PosNum (posnumSz n). @@ -115,7 +110,7 @@ Lemma posnum_expn (n : nat) x : 0 < x%:num ^+ n. Proof. by rewrite exprn_gt0. Qed. Canonical posum_expn n x := PosNum (posnum_expn n x). -Lemma posnum_factn (n : nat) : 0 < ((n `!)%:~R : R). +Lemma posnum_factn (n : nat) : 0 < n`!%:~R :> R. Proof. rewrite ltr0z; exact: fact_gt0. Qed. Canonical posum_factn n := PosNum (posnum_factn n). @@ -132,17 +127,17 @@ Context {R : realDomainType}. Implicit Types (x y : {posnum R}). Lemma posnum_le0 x : (x%:num <= 0 :> R) = false. -Proof. by rewrite lerNgt posnum_gt0. Qed. +Proof. by rewrite leNgt posnum_gt0. Qed. Lemma posnum_lt0 x : (x%:num < 0 :> R) = false. -Proof. by rewrite ltrNge posnum_ge0. Qed. +Proof. by rewrite ltNge posnum_ge0. Qed. Lemma min_pos_gt0 x y : 0 < minr x%:num y%:num. -Proof. by rewrite ltr_minr !posnum_gt0. Qed. +Proof. by rewrite lt_minr !posnum_gt0. Qed. Canonical minr_posnum x y := PosNum (@min_pos_gt0 x y). End PosNumReal. -Lemma sqrt_pos_gt0 (R : rcfType) (x : {posnum R}) : 0 < Num.sqrt (x%:num). +Lemma sqrt_pos_gt0 (R : rcfType) (x : {posnum R}) : 0 < Num.sqrt x%:num. Proof. by rewrite sqrtr_gt0. Qed. Canonical sqrt_posnum (R : rcfType) (x : {posnum R}) := PosNum (sqrt_pos_gt0 x). @@ -153,7 +148,7 @@ CoInductive posnum_spec (R : numDomainType) (x : R) : Lemma posnumP (R : numDomainType) (x : R) : 0 < x -> posnum_spec x x (x == 0) (0 <= x) (0 < x). Proof. -move=> x_gt0; case: real_ltrgt0P (x_gt0) => []; rewrite ?gtr0_real // => _ _. +move=> x_gt0; case: real_ltgt0P (x_gt0) => []; rewrite ?gtr0_real // => _ _. by rewrite -[x]/(PosNum x_gt0)%:num; constructor. Qed. @@ -167,15 +162,15 @@ Notation "[gt0 'of' x ]" := (posnum_gt0_def (Phantom algC x)) Variable f : algC -> algC. Hypothesis H : forall x, f x > 0. -Lemma f_gt0 (x : {posnum algC}) : 0 < f (x%:num). +Lemma f_gt0 (x : {posnum algC}) : 0 < f x%:num. Proof. by rewrite H. Qed. Canonical f_posnum (x : {posnum algC}) := PosNum (f_gt0 x). -Lemma SnC_gt0 (n : nat) : 0 < (n.+1%:R : algC). +Lemma SnC_gt0 (n : nat) : 0 < n.+1%:R :> algC. Proof. by rewrite ltr0n. Qed. Canonical SnC_posnum n := PosNum (SnC_gt0 n). -Lemma Sz_gt0 (n : nat) : 0 < (n.+1%:~R : algC). +Lemma Sz_gt0 (n : nat) : 0 < n.+1%:~R :> algC. Proof. by rewrite ltr0n. Qed. Canonical Sz_posnum n := PosNum (@Sz_gt0 n). diff --git a/theories/punk.v b/theories/punk.v index c8dc4c9..2e77b19 100644 --- a/theories/punk.v +++ b/theories/punk.v @@ -1,8 +1,8 @@ From mathcomp Require Import all_ssreflect all_algebra. Require Import bigopz. Require Import shift. -Import GRing.Theory. -Import Num.Theory. + +Import Order.TTheory GRing.Theory Num.Theory. Set Implicit Arguments. Unset Strict Implicit. @@ -88,13 +88,13 @@ pose t2 := \sum_(0 <= i < r) \sum_(int.shift i n + b <= k < int.shift r n + b :> int) cf_P i n * u (int.shift i n) k. -have {step} step : P U n = t1 - t2. +have {}step : P U n = t1 - t2. apply/eqP; rewrite eq_sym subr_eq; apply/eqP; rewrite {}step -big_split /=. rewrite [LHS]big_seq_cond [RHS]big_seq_cond; apply: eq_bigr=> i; simpl in i. rewrite andbT mem_index_iota; case/andP=> _ hi. rewrite -big_cat_int //= !int.shift2Z. - - by apply: ler_trans range_correct _; rewrite ler_add2r ler_addl. - - by rewrite ler_add2r ler_add2l ltrW. + - by apply: le_trans range_correct _; rewrite ler_add2r ler_addl. + - by rewrite ler_add2r ler_add2l ltW. have t1_step : t1 = \sum_(a <= k < int.shift r n + b :> int) @@ -116,7 +116,7 @@ have t11_step : rewrite (bigID (fun k => not_D n k)) /=; congr (_ + _). rewrite [LHS]big_seq_cond [RHS]big_seq_cond; apply: eq_bigr=> i; simpl in i. by case/andP=> _ hi; rewrite -PeqDQ // /P horner_seqopP. -have {t11_step} t11_step : +have {}t11_step : t11 = Q u n (n + b) - Q u n a - \sum_(a <= k < n + b :> int | ~~ not_D n k) @@ -127,7 +127,7 @@ have {t11_step} t11_step : rewrite {}t11_step; congr (_ + _). rewrite -(telescopez (Q u n)) //. by rewrite [X in _ = X - _](bigID (fun k => not_D n k)) /= -addrA subrr addr0. -have {t1_step} t1_step : +have {}t1_step : t1 = t11 + \sum_(n + b <= k < int.shift r n + b :> int) \sum_(0 <= i < r) @@ -143,7 +143,7 @@ rewrite exchange_big /= -sumrN -big_split /=. rewrite [LHS]big_seq_cond [RHS]big_seq_cond; apply: eq_bigr=> i /andP []. rewrite mem_index_iota; case/andP=> _ hi _; rewrite !int.shift2Z. have hl : n + b <= n + i + b by rewrite ler_add2r ler_addl. -have hr : n + i + b <= n + r + b by rewrite ler_add2r ler_add2l ltrW. +have hr : n + i + b <= n + r + b by rewrite ler_add2r ler_add2l ltW. rewrite (big_cat_int _ _ _ hl hr) {hl hr} addrK [n + i + b]addrAC big_addz2l /=. rewrite eq_big_int_nat /=; apply: eq_bigr=> ? _. by rewrite int.shift2Z [n + b + _]addrC. @@ -276,7 +276,7 @@ have PUnk_value : rewrite -big_cat_int ?cpr_add //=. by rewrite !int.shift2Z addrAC. -have {PUnk_value} PUnk_value : +have {}PUnk_value : PUnk = \sum_(a <= m < k + b :> int) \sum_(0 <= i < s) diff --git a/theories/rat_of_Z.v b/theories/rat_of_Z.v index 7b5ece1..e7db3fc 100644 --- a/theories/rat_of_Z.v +++ b/theories/rat_of_Z.v @@ -6,9 +6,9 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. +Import GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* We define an *opaque* cast: *) @@ -25,14 +25,14 @@ Open Scope ring_scope. (* opaque, otherwise we cannot control when binary integers are converted *) (* to (unary) rationals.*) -Definition rat_of_Z_fun (z : Z) : rat := +Definition rat_of_Z_ (z : Z) : rat := match z with | Z0 => zeroq - | Zpos p => (Posz (nat_of_P p))%:~R - | Zneg p => - (Posz (nat_of_P p))%:~R + | Zpos p => (Posz (nat_of_P p))%:Q + | Zneg p => - (Posz (nat_of_P p))%:Q end. -Definition rat_of_Z_ := nosimpl rat_of_Z_fun. +Arguments rat_of_Z_ z : simpl never. (* Opacification of rat_of_Z. A mere 'locked' would not word for it is not *) (* fully opaque and would be actually harmeful in the hard-wired post *) @@ -44,7 +44,7 @@ Parameter rat_of_Z : Z -> rat. Axiom rat_of_ZEdef : rat_of_Z = rat_of_Z_. End RatOfZSig. Module rat_of_ZDef : RatOfZSig. -Definition rat_of_Z : Z -> rat := rat_of_Z_fun. +Definition rat_of_Z : Z -> rat := rat_of_Z_. Definition rat_of_ZEdef := erefl rat_of_Z. End rat_of_ZDef. @@ -121,20 +121,17 @@ involve constants *) Lemma rat_of_Z_eq0 x : (rat_of_Z_ x == 0) = Z.eqb x Z0. Proof. -suff pN0 p : ((Pos.to_nat p) == 0 :> int) = false. +suff pN0 p : (Pos.to_nat p == 0 :> int) = false. by case: x => [| p | p ] //; rewrite ?oppr_eq0 intq_eq0 pN0. rewrite eqz_nat nat_of_P_E; apply: negPf. elim: p => // p ihp. by rewrite nat_of_pos_x0 -muln2 muln_eq0 negb_or ihp. Qed. - (* Compatibility with order. This is a stub. *) -Import Num.Theory. - Lemma rat_of_Z_Zpos (z : positive) : 0 < rat_of_Z (Zpos z). Proof. rewrite rat_of_ZEdef /rat_of_Z_ /=; case: (Pos2Nat.is_succ z)=> n -> {z}. -by rewrite -[0]/(0%:~R) ltr_nat. +by rewrite -[0]/(0%:Q) ltr_nat. Qed. diff --git a/theories/rat_pos.v b/theories/rat_pos.v index b1e54be..2b8e081 100644 --- a/theories/rat_pos.v +++ b/theories/rat_pos.v @@ -3,16 +3,14 @@ them to concrete values that will be used in the rest of the formalization. *) -Require Import Psatz ZArith. -Require Import ssreflect ssrfun ssrbool eqtype ssrnat. -Require Import ssralg ssrint rat ssrnum. +Require Import ZArith. +From mathcomp Require Import all_ssreflect all_algebra. Require Import field_tactics lia_tactics. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. Set Implicit Arguments. Unset Strict Implicit. @@ -44,24 +42,24 @@ apply: (ltr_spsaddl bn_pos an_pos). Qed. Definition p4 (n_ : int) : rat := - let n := n_%:~R : rat in + let n : rat := n_%:Q in rat_of_Z 12 * n^4 + rat_of_Z 96 * n^3 + rat_of_Z 283 * n^2 + rat_of_Z 364 * n + rat_of_Z 173. Definition p3 (n_ : int) : rat := - let n := n_%:~R : rat in + let n : rat := n_%:Q in rat_of_Z 48 * n^3 + rat_of_Z 360 * n^2 + rat_of_Z 902 * n + rat_of_Z 755. Definition p2 (n_ : int) : rat := - let n := n_%:~R : rat in + let n : rat := n_%:Q in rat_of_Z 144 * n^2 + rat_of_Z 864 * n + rat_of_Z 1310. Definition p1 (n_ : int) : rat := - let n := n_%:~R : rat in + let n : rat := n_%:Q in rat_of_Z 288 * n + rat_of_Z 1008. Definition p0 (n_ : int) : rat := - let n := n_%:~R : rat in + let n : rat := n_%:Q in rat_of_Z 288. Lemma p3_is_fdiff_of_p4 : is_fdiff_of p3 p4. @@ -153,20 +151,20 @@ Proof. rewrite lt0r. case/andP. done. Qed. (* Move these and the previous one to rat_pos? *) Lemma affine_poly_pos (n : int) (a b : rat) : - 0 <= n -> a > 0 -> b > 0 -> 0 < a * n%:~R + b. + 0 <= n -> a > 0 -> b > 0 -> 0 < a * n%:Q + b. Proof. move=> le_0_n pos_a pos_b. -apply: (@ltr_le_trans _ b) => //. +apply: (@lt_le_trans _ _ b) => //. rewrite ler_addr mulr_ge0 //. by rewrite le0r pos_a orbT. by rewrite ler0z. Qed. Lemma affine_poly_pos_with_one (n : int) (b : rat) : - 0 <= n -> b > 0 -> 0 < n%:~R + b. + 0 <= n -> b > 0 -> 0 < n%:Q + b. Proof. move=> ? ?. -have <- : rat_of_Z 1 * n%:~R = n%:~R by rewrite rat_of_ZEdef mul1r. +have <- : rat_of_Z 1 * n%:Q = n%:Q by rewrite rat_of_ZEdef mul1r. apply: affine_poly_pos => //. by rewrite rat_of_ZEdef. Qed. diff --git a/theories/reduce_order.v b/theories/reduce_order.v index f7542eb..e39864f 100644 --- a/theories/reduce_order.v +++ b/theories/reduce_order.v @@ -1,4 +1,4 @@ -Require Import Psatz ZArith. +Require Import ZArith. From mathcomp Require Import all_ssreflect all_algebra. Require Import binomialz bigopz. @@ -12,10 +12,9 @@ Require (* rat_pos *) algo_closures initial_conds. Require annotated_recs_c. Require annotated_recs_v. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. Set Implicit Arguments. Unset Strict Implicit. @@ -69,7 +68,7 @@ Qed. Lemma b'0_eq : b' 0 = 0. Proof. by rewrite /= initial_conds.b0_eq. Qed. -Lemma b'1_eq : b' 1 = 6%:~R. +Lemma b'1_eq : b' 1 = 6%:Q. Proof. by rewrite /= initial_conds.b1_eq. Qed. Lemma b'2_eq : b' (2 : int) = rat_of_Z 351 / rat_of_Z 4. @@ -132,7 +131,7 @@ Lemma Sn4_flat_to_Sn4_rew (w : int -> rat) : annotated_recs_v.P_cf4 n). Proof. move=> horner_hyp n le_2_n. -have le_0_n : n >= 0 by apply: (ler_trans _ le_2_n). +have le_0_n : n >= 0 by apply: (le_trans _ le_2_n). set goal := (_ = _). move: {horner_hyp} (horner_hyp n le_2_n). rewrite /annotated_recs_v.P_horner /punk.horner_seqop /=. @@ -200,8 +199,8 @@ suff gen (n : int) : (0 : int) <= n -> n <= p -> b' (n + k) = b (n + k). by move=> p_pos; apply: (gen _ p_pos). move: n. elim/int_rect: p => [p h0p hp0 | p ihp n le0n hnp | p _ n hn hp]; last 1 first. -- by have := (ler_trans hn hp). -- have -> : p = 0 by apply/eqP; rewrite eqr_le h0p hp0. +- by have := (le_trans hn hp). +- have -> : p = 0 by apply/eqP; rewrite eq_le h0p hp0. by rewrite add0r. case: (altP (n =P 0)) => [-> | hn0]. by rewrite add0r. @@ -215,21 +214,19 @@ clear ebk0 ebk1 ebk2 ebk3. (* Again a variable change. *) pose m : int := n - (4 : int); simpl in m. have hm : n = m + 4 by rewrite /m addrK. -have le0m : m >= 0. - by move: le0n hn0 hn1 hn2 hn3; rewrite hm; clear; goal_to_lia; intlia. -have hmp : m + 3 <= p. - move: hnp; rewrite -addn1 PoszD hm; clear; goal_to_lia; intlia. +have le0m : m >= 0 by move: le0n hn0 hn1 hn2 hn3; rewrite hm; clear; intlia. +have hmp : m + 3 <= p by move: hnp; rewrite -addn1 PoszD hm; clear; intlia. rewrite hm; clearbody m; clear le0n hnp hn0 hn1 hn2 hn3 hm n. have -> : m + 4 + k = int.shift 4 (m + k). by rewrite int.shift2Z addrAC. have b'_Sn4_from2 (n : int) : (2 : int) <= n -> annotated_recs_v.P_horner b' n = 0. - by move=> hn; apply: b'_Sn4; apply: ler_trans hn. + by move=> hn; apply: b'_Sn4; apply: le_trans hn. have hmk2 : (2 : int) <= m + k by move: kpos le0m; clear; intlia. rewrite (Sn4_flat_to_Sn4_rew b'_Sn4_from2 hmk2); clear b'_Sn4_from2. rewrite (Sn4_flat_to_Sn4_rew algo_closures.b_Sn4 hmk2); clear hmk2. rewrite !int.shift2Z ![m + k + _]addrAC. -by do 4! (rewrite ihp; [ | (goal_to_lia; intlia) ..]). +by do 4! (rewrite ihp; [ | intlia ..]). Qed. (* Maybe should part of this go to initial_conds. *) @@ -256,19 +253,16 @@ apply: b'_eq_b_reduction => //. by rewrite rat_of_Z_eq0. Qed. -Lemma b_Sn2_almost (n : int) : n >= (2 : int) -> - annotated_recs_c.P_horner b n = 0. +Lemma b_Sn2_almost (n : int) : + n >= 2 :> int -> annotated_recs_c.P_horner b n = 0. Proof. move=> h. rewrite /annotated_recs_c.P_horner/punk.horner_seqop [LHS]/=. -rewrite -!b'_eq_b; [ | (goal_to_lia; intlia) ..]. +rewrite -!b'_eq_b; [ | intlia ..]. have h' : 0 <= n by intlia. rewrite b'_Sn2_rew //. rat_field. -rewrite /annotated_recs_c.P_cf2. -apply/eqP. -apply: expfz_neq0. -by apply: lt0r_neq0; affine_poly_intlia. +by apply/eqP/expfz_neq0/lt0r_neq0; affine_poly_intlia. Qed. Lemma b_Sn2_at_0 : annotated_recs_c.P_horner b 0 = 0. @@ -298,10 +292,8 @@ case: (altP (n =P 0)) => [-> | h0]; first exact: b_Sn2_at_0. case: (altP (n =P 1)) => [-> | h1]; first exact: b_Sn2_at_1. pose p : int := n - (2 : int); simpl in p. have hnp : n = p + (2 : int) by rewrite /p addrNK. -have {hn h0 h1} le0p : 0 <= p. - by move: hn h0 h1; rewrite hnp; clear; goal_to_lia; intlia. -have {le0p hnp p} h : (2 : int) <= n. - by rewrite hnp ler_addr. +have {hn h0 h1} le0p : 0 <= p by move: hn h0 h1; rewrite hnp; clear; intlia. +have {le0p hnp p} h : 2 <= n :> int by rewrite hnp ler_addr. exact: b_Sn2_almost. Qed. diff --git a/theories/rho_computations.v b/theories/rho_computations.v index 619c3a0..d47802f 100644 --- a/theories/rho_computations.v +++ b/theories/rho_computations.v @@ -1,5 +1,4 @@ Require Import BinInt. -Require Import NArith. From mathcomp Require Import all_ssreflect all_algebra. Require Import rat_of_Z. @@ -11,18 +10,17 @@ Unset Printing Implicit Defensive. From CoqEAL Require Import hrel param refinements. From CoqEAL Require Import pos binnat binint rational. -Import Refinements (* AlgOp *). +Import Refinements (* AlgOp *). -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* You don't really need Z here but positive *) -Definition rat_of_positive_fun (p : positive) : rat := - (pos_to_int (Op.spec p))%:~R. +Definition rat_of_positive_ (p : positive) : rat := + (pos_to_int (Op.spec p))%:Q. -Definition rat_of_positive_ := nosimpl rat_of_positive_fun. +Arguments rat_of_positive_ p : simpl never. Module Type RatOfZSig. Parameter rat_of_positive : positive -> rat. @@ -30,7 +28,7 @@ Axiom rat_of_positiveEdef : rat_of_positive = rat_of_positive_. End RatOfZSig. Module rat_of_positiveDef : RatOfZSig. -Definition rat_of_positive : positive -> rat := rat_of_positive_fun. +Definition rat_of_positive : positive -> rat := rat_of_positive_. Definition rat_of_positiveEdef := erefl rat_of_positive. End rat_of_positiveDef. @@ -42,18 +40,17 @@ Export rat_of_positiveDef. Lemma rat_of_Z_rat_of_positive (p : positive) : rat_of_Z (Z.pos p)%Z = rat_of_positive p. Proof. -rewrite rat_of_positiveEdef rat_of_ZEdef /rat_of_Z_ /rat_of_Z_fun. -rewrite /rat_of_positive_ /rat_of_positive_fun /pos_to_int /=. -by rewrite val_insubd to_nat_gt0 natz. +rewrite rat_of_positiveEdef rat_of_ZEdef /rat_of_Z_ /rat_of_positive_. +by rewrite /pos_to_int val_insubd to_nat_gt0 natz. Qed. -Lemma rat_of_positiveE (p : positive) : - rat_of_positive p = (Posz (nat_of_P p))%:~R. +Lemma rat_of_positiveE (p : positive) : + rat_of_positive p = (Posz (nat_of_P p))%:Q. Proof. by rewrite -rat_of_Z_rat_of_positive rat_of_ZEdef. Qed. Fact lt_0_rat_of_positive (p : positive) : 0 < rat_of_positive p. Proof. -rewrite rat_of_positiveEdef /rat_of_positive_ /rat_of_positive_fun /pos_to_int. +rewrite rat_of_positiveEdef /rat_of_positive_ /pos_to_int. by rewrite val_insubd to_nat_gt0 natz ltr0n to_nat_gt0. Qed. @@ -178,7 +175,7 @@ Global Instance Q_of_nat : Op.cast_of nat Q := Global Instance RQ_of_nat : refines (Logic.eq ==> RQ)%rel natr cast. Proof. -eapply refines_abstr => n b; rewrite refinesE => <- {b}. +apply: refines_abstr => n b; rewrite refinesE => <- {b}. rewrite /natr /cast /Q_of_nat /=. elim: n => [|n ihn] //=; first by rewrite mulr0n; tc. by rewrite mulrS; tc. @@ -187,9 +184,8 @@ Qed. Global Instance RQ_of_pos : refines (Logic.eq ==> RQ)%rel rat_of_positive cast. Proof. -eapply refines_abstr => n b; rewrite refinesE => <- {b}. -rewrite rat_of_positiveEdef /rat_of_positive_ /rat_of_positive_fun. -by rewrite /cast /cast_PQ; tc. +apply: refines_abstr => n b; rewrite refinesE => <- {b}. +by rewrite rat_of_positiveEdef /rat_of_positive_ /cast /cast_PQ; tc. Qed. Global Instance positive_refines_eq (x : positive) : refines Logic.eq x x. diff --git a/theories/s_props.v b/theories/s_props.v index 065de13..ae8964a 100644 --- a/theories/s_props.v +++ b/theories/s_props.v @@ -7,56 +7,42 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (*** Properties of the sequence s: majorization of its values. ***) (* FIXME : to be cleaned up *) -Lemma s_maj (i i0 : nat) : 0 < i%:~R :> rat -> (i0 <= i)%N -> - `|s i i0| <= i0%:~R / (2%:~R * i%:~R ^ 2) :> rat. +Lemma s_maj (i i0 : nat) : + 0 < i%:Q -> (i0 <= i)%N -> `|s i i0| <= i0%:Q / (2%:Q * i%:Q ^ 2). Proof. - move=> bigi1 lei0i; apply: ler_trans (ler_norm_sum _ _ _) _. - rewrite -PoszD eq_big_int_nat /=. - pose U (i1 : nat) := i1%:~R ^ 3 * binomialz i i1 * binomialz (Posz i + i1) i1. - suff philippe (i1 : nat) : (0 < i1)%N -> (i1 <= i)%N -> i%:~R ^ 2 <= U i1. - have -> : i0%:~R / (2%:~R * i%:~R ^ 2) = - \sum_(1 <= i1 < i0 + 1) 1 / (2%:~R * i%:~R ^ 2) :> rat. - rewrite -mulr_suml big_const_nat; congr (_ / _). - rewrite addnK; elim: i0 {lei0i} => // n ihn /=. - by rewrite -ihn -addn1 PoszD rmorphD /= addrC. - rewrite [X in X <= _]big_nat_cond [in X in _ <= X]big_nat_cond. - apply: ler_sum=> j; rewrite andbT; case/andP=> h0j; rewrite addn1 => hji. - have dpos : 0 < 2%:~R * j%:~R ^ 3 * binomialz i j * binomialz (Posz i + j) j. - rewrite mulr_gt0 //; last by rewrite binz_gt0 // cpr_add. - rewrite mulr_gt0 // ?binz_gt0 //; last exact: leq_trans lei0i. - by rewrite mulr_gt0 // exprz_gt0 // -[0]/(0%:~R) ltr_nat. - rewrite /d normrM normfV normrX expr1n !div1r gtr0_norm //. - rewrite lef_pinv //; last by rewrite posrE mulr_gt0 // mulr_gt0. - rewrite -2!mulrA ler_pmul2l // mulrA; apply: philippe => //. - exact: leq_trans lei0i. - move=> lt0i1; rewrite {}/U leq_eqVlt; case/orP=> [/eqP-> | hii1]. - rewrite !binz_nat_nat binn mulr1 -!mulrA mulrA ler_pmulr ?mulr_gt0 //. - rewrite -rmorphM /= -[1]/(1%:~R) ler_nat muln_gt0. - by move: bigi1; rewrite -[0]/(0%:~R) ltr_nat=> ->; rewrite bin_gt0 leq_addl. - suff h : i1%:~R ^ 3 * i%:~R * i%:~R <= - i1%:~R ^ 3 * binomialz i i1 * binomialz (Posz i + i1) i1. - apply: ler_trans h; rewrite -mulrA ler_pmull; last exact: mulr_gt0. - rewrite [_ ^ _.+1]exprS expr2 -!rmorphM /= -[Z in Z <= _]/(1%:~R). - by rewrite ler_nat !muln_gt0 !andbb. - rewrite -2!mulrA ler_pmul2l; last first. - by apply: exprz_gt0; rewrite -[0]/(0%:~R) ltr_nat. - suff maj : i%:~R <= binomialz i i1. - apply: ler_pmul; [exact: ltrW | exact: ltrW | exact: maj |]. - apply: ler_trans maj _; rewrite !binz_nat_nat ler_nat; apply: leq_bin2l. - by rewrite leq_addr. - rewrite binz_nat_nat ler_nat. - (* FIXME : n <= 'C(n, m) should be a lemma *) - elim: i {bigi1 lei0i} hii1 => // n ihn; rewrite ltnS. - rewrite leq_eqVlt; case/orP=> [/eqP -> | hi1n]; first by rewrite binSn. - apply: leq_ltn_trans (ihn hi1n) _; case: i1 hi1n lt0i1 {ihn} => // i1 hi1n _. - rewrite binS -[X in (X < _)%N]addn0 ltn_add2l bin_gt0; apply: leq_trans hi1n. - exact: leq_trans (leqnSn _). +move=> bigi1 lei0i; apply: le_trans (ler_norm_sum _ _ _) _. +rewrite -PoszD eq_big_int_nat /=. +pose U (i1 : nat) := i1%:Q ^+ 3 * binomialz i i1 * binomialz (Posz i + i1) i1. +suff philippe (i1 : nat) : (0 < i1)%N -> (i1 <= i)%N -> i%:Q ^+ 2 <= U i1. + have ->: i0%:Q = \sum_(1 <= i1 < i0 + 1) 1. + by rewrite big_const_nat addnK iter_addr_0. + rewrite mulr_suml [X in X <= _]big_nat_cond [in X in _ <= X]big_nat_cond. + apply: ler_sum => j; rewrite andbT addn1 ltnS => /andP [h0j hji]. + have dpos : 0 < 2%:Q * j%:Q ^+ 3 * binomialz i j * binomialz (Posz i + j) j. + by rewrite !mulr_gt0 ?ltr0z // binz_gt0 ?cpr_add //; exact: leq_trans lei0i. + rewrite /d normrM normfV normrX expr1n !div1r gtr0_norm //. + rewrite lef_pinv //; last by rewrite posrE mulr_gt0 // mulr_gt0. + by rewrite -2!mulrA ler_pmul2l // mulrA; apply/philippe/leq_trans/lei0i. +move=> lt0i1; rewrite {}/U leq_eqVlt => /predU1P[->|hii1]. + rewrite !binz_nat_nat binn mulr1 -!mulrA mulrA ler_pmulr ?mulr_gt0 //. + by move: bigi1; rewrite -rmorphM ler1n muln_gt0 ltr0n bin_gt0 leq_addl andbT. +have: i%:Q ^+ 2 <= i1%:Q ^+ 3 * i%:Q ^+ 2. + by rewrite ler_pmull ?exprn_gt0 // exprn_ege1 ?ler1z. +move/le_trans; apply; rewrite -mulrA ler_pmul2l; last first. + by rewrite exprn_gt0 ?ltr0n. +suff maj : i%:Q <= binomialz i i1. + apply: ler_pmul; rewrite ?ler0n //; apply: le_trans maj _. + by rewrite !binz_nat_nat ler_nat leq_bin2l ?leq_addr. +rewrite binz_nat_nat ler_nat. +(* FIXME : n <= 'C(n, m) should be a lemma *) +case: i1 lt0i1 hii1 {lei0i bigi1} => // i1 _. +elim: i i1 => [|i ihi] [|i1] //; rewrite ltnS ?bin1 // => hii1. +by rewrite binS -add1n leq_add ?bin_gt0 ?ihi. Qed. diff --git a/theories/seq_defs.v b/theories/seq_defs.v index 830d55d..83bd145 100644 --- a/theories/seq_defs.v +++ b/theories/seq_defs.v @@ -12,14 +12,13 @@ Require harmonic_numbers. (* Partial sum of zeta(3). *) Definition ghn3 : int -> rat := harmonic_numbers.ghn 3. -Definition c (n k : int) : rat := - (binomialz n k) ^ 2 * (binomialz (n + k) k) ^ 2. +Definition c (n k : int) : rat := binomialz n k ^ 2 * binomialz (n + k) k ^ 2. (* Sequence a of the Maple session: sum of c's. *) Definition a (n : int) : rat := \sum_(0 <= k < n + 1 :> int) (c n k). Definition d (n k m : int) : rat := - (-1) ^ (m + 1) / (2%:Q * m%:~R ^ 3 * binomialz n m * binomialz (n + m) m). + (-1) ^ (m + 1) / (2%:Q * m%:Q ^ 3 * binomialz n m * binomialz (n + m) m). Definition s (n k : int) : rat := \sum_(1 <= m < k + 1 :> int) d n k m. diff --git a/theories/shift.v b/theories/shift.v index 60a7927..3acb573 100644 --- a/theories/shift.v +++ b/theories/shift.v @@ -11,9 +11,8 @@ Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. -Import Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. Module int. @@ -25,7 +24,6 @@ Definition shift_ n := iter n shift1. Definition shift := nosimpl shift_. - Lemma shiftE : shift = shift_. by []. Qed. (* Rewriting lemmas to get rid of the shifts in rational fractions. @@ -65,4 +63,3 @@ Proof. by rewrite shiftE /=. Qed. End shift. End int. - diff --git a/theories/test_field_tactics.v b/theories/test_field_tactics.v index 7a5dee6..d3f80b7 100644 --- a/theories/test_field_tactics.v +++ b/theories/test_field_tactics.v @@ -8,11 +8,9 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. - Import GRing.Theory. -Import Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (* rat_of_Z being locked, we cannot prove this with prefield only *) Lemma testZ0 : ((rat_of_Z Z0) + (rat_of_Z 0)) = 0. diff --git a/theories/z3irrational.v b/theories/z3irrational.v index aa1cb65..ce6b4ac 100644 --- a/theories/z3irrational.v +++ b/theories/z3irrational.v @@ -15,11 +15,9 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. -Import BigEnough. +Import Order.TTheory GRing.Theory Num.Theory BigEnough. -Open Scope ring_scope. +Local Open Scope ring_scope. (******************************************************************************) (* In this file we define the real number zeta(3) and prove that it is *) @@ -44,14 +42,14 @@ Ltac raise_big_enough := solve [big_enough_trans]. Lemma creal_z3seq : creal_axiom z3seq. Proof. rewrite /creal_axiom. -pose n_inv_seq (n : nat) := n%:~R^-1 : rat. +pose n_inv_seq (n : nat) := n%:Q^-1. have [/= modulus_n_inv modulus_n_inv_P] : {asympt e : i / n_inv_seq i < e}. exists_big_modulus M rat => /=. move=> eps i lt_eps0 hMi. rewrite /n_inv_seq -div1r ltr_pdivr_mulr; last by rewrite ltr0n; raise_big_enough. rewrite -ltr_pdivr_mull // mulr1. - apply: (ltr_trans (archi_boundP _) _); first by rewrite ger0E ltrW. + apply: (lt_trans (archi_boundP _) _); first by rewrite ger0E ltW. rewrite ltr_nat; raise_big_enough. by close. exists_big_modulus m rat. @@ -61,24 +59,24 @@ exists_big_modulus m rat. - rewrite distrC; exact/hwlog. - exact/hwlog. rewrite gtr0_norm; last exact: lt_0_Dz3seq. - pose v (n : nat) := (n%:~R ^ 2) ^-1 : rat. + pose v (n : nat) := (n%:Q ^ 2) ^-1. have vpos (n : nat) : (0 < n)%N -> 0 < v n. by move=> ?; rewrite /v invr_gt0; apply: exprz_gt0; rewrite ltr0n. have maj : z3seq i - z3seq j <= - - 2%:~R^-1 * \sum_(j <= k < i) (v (k + 1)%N - v k). + - 2%:Q^-1 * \sum_(j <= k < i) (v (k + 1)%N - v k). rewrite Dz3seqE // big_add1 /= mulr_sumr. rewrite [X in X <= _]big_nat [X in _ <= X]big_nat. apply: ler_sum => k; case/andP=> hjk hki; rewrite /v addn1. apply: z3seq_smd_maj; rewrite ltr0n; apply: leq_trans _ hjk. raise_big_enough. - apply: (ler_lt_trans maj) => {maj}; rewrite telescope_nat //. - suff maj : v j < 2%:~R * eps. + apply: (le_lt_trans maj) => {maj}; rewrite telescope_nat //. + suff maj : v j < 2%:Q * eps. rewrite mulNr -mulrN opprB ltr_pdivr_mull // ltr_subl_addr. - apply: (ltr_trans maj); rewrite ltr_addl; apply: vpos; exact: ltn_trans ltij. - have maj : v j < j%:~R ^-1. + apply: (lt_trans maj); rewrite ltr_addl; apply: vpos; exact: ltn_trans ltij. + have maj : v j < j%:Q^-1. rewrite /v -div1r ltr_pdivr_mulr; last by rewrite exprz_gt0 // ltr0n. by rewrite mulKf ?ltr1n // lt0r_neq0 // ltr0n. - by apply: (ltr_trans maj); apply: modulus_n_inv_P => //; rewrite pmulr_rgt0. + by apply: (lt_trans maj); apply: modulus_n_inv_P => //; rewrite pmulr_rgt0. by close. Qed. @@ -97,7 +95,7 @@ exists_big_modulus M rat. z3seq i + (\sum_(0 <= k < Posz i + 1 :> int) c i k * s i k) / a i. rewrite opprD addNKr normrN normrM normfV. rewrite [X in _ / X](gtr0_norm (lt_0_a _)) // ltr_pdivr_mulr ?lt_0_a //. - exact: ler_lt_trans (ler_norm_sum _ _ _) _. + exact: le_lt_trans (ler_norm_sum _ _ _) _. have -> : b_over_a_seq i = (\sum_(0 <= k < Posz i + 1 :> int) (c i k * ghn3 i + c i k * s i k)) / a i. rewrite /b_over_a_seq; congr (_ / a i); apply: eq_bigr => j _. @@ -106,16 +104,16 @@ exists_big_modulus M rat. rewrite mulfV ?mul1r //; exact: a_neq0. rewrite -PoszD !eq_big_int_nat /=. have step2 (i0 : nat) : (0 <= i0 <= i)%N -> - `|c i i0 * s i i0| <= c i i0 * i0%:~R / (2%:~R * (Posz i)%:~R ^ 2). + `|c i i0 * s i i0| <= c i i0 * i0%:Q / (2%:Q * i%:Q ^ 2). case/andP=> _ hi0; rewrite normrM [`|c i i0|]gtr0_norm ?lt_0_c //. rewrite -mulrA ler_pmul2l //; last exact: lt_0_c. apply: s_maj => //; rewrite ltr0n; raise_big_enough. - apply: (@ler_lt_trans _ (\sum_(0 <= i0 < i + 1) - c i i0 * i0%:~R / (2%:~R * i%:~R ^ 2))). + apply: (@le_lt_trans _ _ (\sum_(0 <= i0 < i + 1) + c i i0 * i0%:Q / (2%:Q * i%:Q ^ 2))). rewrite [X in X <= _]big_nat [X in _ <= X]big_nat. apply: ler_sum => j; case/andP=> h0j. rewrite addn1 ltnS => hji; exact: step2. - apply:(@ler_lt_trans _ ((\sum_(0 <= i0 < i + 1) c i i0) / (2%:~R * i%:~R))). + apply:(@le_lt_trans _ _ ((\sum_(0 <= i0 < i + 1) c i i0) / (2%:Q * i%:Q))). rewrite [X in X <= _]big_nat [in X in _ <= X]big_nat. rewrite mulr_suml; apply: ler_sum => j; case/andP=> h0j. rewrite addn1 ltnS => hji; rewrite -mulrA ler_pmul2l ?lt_0_c //. @@ -125,8 +123,8 @@ exists_big_modulus M rat. rewrite -/(a i); exact: lt_0_a. rewrite -div1r ltr_pdivr_mulr; last by apply: mulr_gt0; rewrite ltr0n. rewrite mulrA mulrC -ltr_pdivr_mulr; last by apply: mulr_gt0. - apply: ltr_trans (archi_boundP _) _; last by rewrite ltr_nat; raise_big_enough. - by rewrite mulr_ge0 // invr_ge0 mulr_ge0 // ltrW. + apply: lt_trans (archi_boundP _) _; last by rewrite ltr_nat; raise_big_enough. + by rewrite mulr_ge0 // invr_ge0 mulr_ge0 // ltW. by close. Qed. @@ -155,10 +153,10 @@ pose_big_enough m. move=> ltkn lt1k; rewrite Db_over_a_casoratian //. rewrite (big_cat_nat _ _ _ (leqnSn _) ltkn) big_nat1 /=. have aux (i : nat) : - 0 < 6%:~R / (i%:~R + 1%:~R) ^ 3 / (a (int.shift 1 i) * a i). + 0 < 6%:Q / (i%:Q + 1%:Q) ^ 3 / (a (int.shift 1 i) * a i). apply: divr_gt0; first by apply: lt_0_ba_casoratian. apply:mulr_gt0; exact: lt_0_a. - apply: ltr_spaddl => //; apply: sumr_ge0 => i _; exact: ltrW. + apply: ltr_spaddl => //; apply: sumr_ge0 => i _; exact: ltW. suff diff_pos2 : (0 <= b_over_a - (b_over_a_seq m)%:CR)%CR. have ->: b_over_a_seq n = b_over_a_seq m + (b_over_a_seq n - b_over_a_seq m). by rewrite addrCA subrr addr0. @@ -167,7 +165,7 @@ pose_big_enough m. by apply: eq_creal_ext=> i /=; rewrite -addrA opprD opprB. rewrite z3_eq_b_over_a; apply: ltcr_spaddr=> //; apply: lt_creal_cst. apply: diff_pos1; raise_big_enough. - apply: (@le_crealP _ m.+1) => *; apply: ltrW. + apply: (@le_crealP _ m.+1) => *; apply: ltW. apply: diff_pos1; raise_big_enough. by close. Qed. @@ -175,7 +173,7 @@ Qed. (* Again using the properties of the casoratian, we can prove that *) (* delta n := a(n)zeta3(n) - b(n) is dominated by O(1 / a(n)^2). An easy *) (* constant is (a "nearby" rational number equal or greater than) 6 * zeta(3).*) -Definition Kdelta := ubound (6%:~R%:CR * z3)%CR. +Definition Kdelta := ubound (6%:Q%:CR * z3)%CR. (* Later in the study of sequence sigma we'll need the fact that this constant *) (* is non zero. *) @@ -188,30 +186,30 @@ Proof. pose_big_enough large. exists large => n hlarge. suff step1 i : (n <= i)%N -> - a n * b_over_a_seq i - b n <= 6%:~R * z3seq i * (1 / a n). - apply: (@lecr_trans _ (6%:~R%:CR * z3 * (1 / a n)%:CR))%CR; last first. + a n * b_over_a_seq i - b n <= 6%:Q * z3seq i * (1 / a n). + apply: (@lecr_trans _ (6%:Q%:CR * z3 * (1 / a n)%:CR))%CR; last first. rewrite cst_crealM; apply: lecr_mulf2r; first by apply: le_ubound. - apply: divr_ge0=> //; apply: ltrW; exact: lt_0_a. + apply: divr_ge0=> //; apply: ltW; exact: lt_0_a. rewrite {1}z3_eq_b_over_a; apply: (@le_crealP _ n) => j hj //=; exact: step1. move=> leni. - suff step2 : b_over_a_seq i - b_over_a_seq n <= 6%:~R * z3seq i / a n ^ 2. + suff step2 : b_over_a_seq i - b_over_a_seq n <= 6%:Q * z3seq i / a n ^ 2. have lt_0_anV : 0 < (1 / a n) by apply: divr_gt0 => //; apply: lt_0_a. have an_neq0 : a n != 0 by apply: lt0r_neq0; apply: lt_0_a. rewrite -(ler_pmul2r lt_0_anV) mulrDl mulrAC div1r mulfV // mul1r mulNr. by set z := (X in _ <= X / _ / _); rewrite -mulrA -invrM. have step3 : b_over_a_seq i - b_over_a_seq n <= - (\sum_(n <= k < i) 6%:~R / (k%:~R + 1%:~R) ^ 3) / a n ^ 2. + (\sum_(n <= k < i) 6%:Q / (k%:Q + 1) ^ 3) / a n ^ 2. rewrite Db_over_a_casoratian; [ | raise_big_enough | exact: leni]. rewrite [X in X <= _]big_nat_cond [in X in _ <= X]big_nat_cond. rewrite mulr_suml; apply: ler_sum => j; rewrite andbT; case/andP=> hnj hji. have lt0j : (0 < j)%N by apply: leq_trans hnj; raise_big_enough. rewrite ler_pmul2l ; last exact: lt_0_ba_casoratian. rewrite exprSz expr1z lef_pinv; [| (apply: mulr_gt0; exact: lt_0_a)..]. - apply: ler_pmul; rewrite ?(ltrW (lt_0_a _)) //; apply: a_incr => //. + apply: ler_pmul; rewrite ?(ltW (lt_0_a _)) //; apply: a_incr => //. by rewrite int.shift2Z lez_nat; apply: leq_trans hnj _; rewrite addn1. - apply: ler_trans step3 _; rewrite ler_pmul2r; last by rewrite !gtr0E // lt_0_a. + apply: le_trans step3 _; rewrite ler_pmul2r; last by rewrite !gtr0E // lt_0_a. rewrite -mulr_sumr ler_pmul2l //; set lhs := (X in X <= _). - have {lhs} -> : lhs = \sum_(n.+1 <= i0 < i.+1) (i0%:~R ^ 3)^-1. + have {lhs} -> : lhs = \sum_(n.+1 <= i0 < i.+1) (i0%:Q ^ 3)^-1. rewrite {}/lhs big_add1 /=; apply: eq_bigr => k _. by rewrite -[k.+1]addn1 PoszD rmorphD /=. rewrite z3seqE; have leSnSi : (n.+1 <= i.+1)%N by []. @@ -234,7 +232,7 @@ Proof. by rewrite /Ndelta; case: delta_asympt => /= ?; exact. Qed. Local Notation l := iter_lcmn. Definition sigma (n : nat) := - (2%:~R%:CR * ((l n)%:~R ^ 3)%:CR * ((a n)%:CR * z3 - (b n)%:CR))%CR. + (2%:Q%:CR * ((l n)%:Q ^ 3)%:CR * ((a n)%:CR * z3 - (b n)%:CR))%CR. (* Sequence sigma has positive terms. *) Lemma lt_0_sigma (n : nat) : (2 <= n)%N -> (0%CR < sigma n)%CR. @@ -270,8 +268,8 @@ Section SigmaGoesToZero. Lemma hanson : exists K2 : rat, exists K3 : rat, exists N : nat, [/\ 0 < K2, 0 < K3, - K2 ^ 3 < 33%:~R & - forall n : nat, (N <= n)%N -> (l n)%:~R < K3 * K2 ^ n]. + K2 ^ 3 < 33%:Q & + forall n : nat, (N <= n)%N -> (l n)%:Q < K3 * K2 ^ n]. Proof. exists 3%:Q. case: hanson.Hanson.t3 => K [Hpos H]. @@ -280,7 +278,7 @@ split. - by rewrite ltr0n. - by rewrite ltr0n. - by rewrite -exprnP -natrX ltr_nat. -- move => n _. apply: ler_lt_trans (H n) _. +- move => n _. apply: le_lt_trans (H n) _. by rewrite -exprnP -natrX -natrM ltr_nat ltn_mul2r expn_gt0 /=. (* funny: does not work without the /= *) Qed. @@ -289,42 +287,42 @@ Lemma sigma_goes_to_0 (eps : rat) : 0 < eps -> Proof. move=> eps_pos. have [K2 [K3 [large [K2pos K3pos K2_maj hanson]]]] := hanson. -pose C := 2%:~R * (K3 ^ 3) * Kdelta * Ka ^-1. +pose C := 2%:Q * (K3 ^ 3) * Kdelta * Ka ^-1. have Cpos : 0 < C. rewrite /C pmulr_rgt0; first by rewrite invr_gt0; exact: lt_0_Ka. rewrite pmulr_rgt0; first exact: lt_0_Kdelta. apply: mulr_gt0; [by [] | by apply: exprz_gt0]. have heps : 0 < eps / C by apply: divr_gt0. -have hr : 0 < K2 ^ 3 / 33%:~R < 1. +have hr : 0 < K2 ^ 3 / 33%:Q < 1. by rewrite andbC -ltr_pdivl_mulr // invrK mul1r K2_maj divr_gt0 // exprn_gt0. have [N hN] := Gseqlt1 heps hr. pose_big_enough M. exists M => n hn. have aux : (sigma n < - (2%:~R * (K3 * K2 ^ n) ^ 3 * Kdelta * Ka^-1 / 33%:~R ^ n)%:CR)%CR. + (2%:Q * (K3 * K2 ^ n) ^ 3 * Kdelta * Ka^-1 / 33%:Q ^ n)%:CR)%CR. rewrite /sigma -mulcrA -3!mulrA [in X in (_ < X)%CR]cst_crealM. apply: ltcr_mul2l; last by apply/lt_creal_cst. - have Dn_pos : 0 < (l n)%:~R :> rat. - rewrite -[0]/(0%:~R) ltr_nat iter_lcmn_gt0; raise_big_enough. + have Dn_pos : 0 < (l n)%:Q. + rewrite -[0]/(0%:Q) ltr_nat iter_lcmn_gt0; raise_big_enough. rewrite [in X in (_ < X)%CR]cst_crealM. apply: ltcr_pmul; first by apply/lt_creal_cst; apply: exprn_gt0. - apply/lt_creal_cst; apply: mulr_gt0; first exact: lt_0_Kdelta. apply: divr_gt0; last by apply: exprn_gt0; rewrite ltr0n. rewrite invr_gt0; exact: lt_0_Ka. - - apply/lt_creal_cst; rewrite ltr_expn2r //; first exact: ltrW. + - apply/lt_creal_cst; rewrite ltr_expn2r //; first exact: ltW. apply: hanson; raise_big_enough. - apply: lecr_lt_trans (NdeltaP _) _; first by raise_big_enough. apply/lt_creal_cst; rewrite ltr_pmul2l; last exact: lt_0_Kdelta. apply: a_asympt; raise_big_enough. apply: lt_creal_trans aux _; apply/lt_creal_cst; set lhs := (X in (X < _)). - have -> : lhs = C * (K2 ^ 3 / 33%:~R) ^ n. + have -> : lhs = C * (K2 ^ 3 / 33%:Q) ^ n. (* what an ugly script... rat_field is bad with _ ^ n *) rewrite {}/lhs /C expfzMl [(_ / _) ^ n]expfzMl. - have h : 33%:~R^-1 ^ n = (33%:~R ^ n) ^-1 :> rat by rewrite -exprnP -exprVn. + have h : 33%:Q^-1 ^ n = (33%:Q ^ n) ^-1 by rewrite -exprnP -exprVn. rewrite {}[X in _ = _ * _ * _ * (_ * X)]h exprzAC. set x := _ ^ n; set y := _ ^ _ n; rat_field. - split; first by apply/eqP; apply: expfz_neq0; rewrite intr_eq0. - apply/eqP; apply: lt0r_neq0; exact: lt_0_Ka. + split; first by apply/eqP/expfz_neq0; rewrite intr_eq0. + exact/eqP/lt0r_neq0/lt_0_Ka. rewrite -ltr_pdivl_mull -[X in _ < X]mulrC; last by rewrite mulrC; exact: Cpos. apply: hN; raise_big_enough. by close. @@ -340,28 +338,24 @@ Section AperyConstantIsIrrational. Theorem zeta_3_irrational : ~ exists (r : rat), (z3 == r%:CR)%CR. Proof. case=> z3_rat z3_ratP; case: (denqP z3_rat) z3_ratP => d dP z3_ratP. -have heps : 0 < 1 / 2%:~R :> rat by []. +have heps : 0 < 1 / 2%:Q by []. have [M MP] := sigma_goes_to_0 heps. -pose sigma_Q (n : nat) : rat := 2%:~R * (l n)%:~R ^ 3 * (a n * z3_rat - b n). +pose sigma_Q (n : nat) := 2%:Q * (l n)%:Q ^ 3 * (a n * z3_rat - b n). have sigma_QP (n : nat) : ((sigma_Q n)%:CR == sigma n)%CR. by rewrite /sigma z3_ratP -!cst_crealM -cst_crealB -cst_crealM. pose_big_enough n. have h_pos : 0 < sigma_Q n. apply/lt_creal_cst; rewrite sigma_QP; apply: lt_0_sigma; raise_big_enough. - have h_lt1 : sigma_Q n < 1 / 2%:~R. + have h_lt1 : sigma_Q n < 1 / 2%:Q. apply/lt_creal_cst; rewrite sigma_QP; apply: MP; raise_big_enough. - suff : 1 <= sigma_Q n by apply/negP; rewrite -ltrNge; apply: ltr_trans h_lt1 _. + suff : 1 <= sigma_Q n by apply/negP; rewrite -ltNge; apply: lt_trans h_lt1 _. suff /QintP [z zP] : sigma_Q n \is a Qint. by move: h_pos; rewrite zP ler1z -gtz0_ge1 ltr0z; apply. - suff hr : 2%:~R * (l n)%:~R ^ 3 * (a n * z3_rat) \is a Qint. - rewrite /sigma_Q mulrDr mulrN; apply: rpredD; first exact: hr. - rewrite rpredN; apply: Qint_l3b. - have Qint_lz3 : (l n)%:~R * z3_rat \is a Qint. - apply: iter_lcmn_mul_rat; rewrite normr_denq dP lez_nat; raise_big_enough. - have -> : 2%:~R * (l n)%:~R ^ 3 * (a n * z3_rat) = - ((l n)%:~R * z3_rat) * (2%:~R * (l n)%:~R ^ 2 * a n) by rat_field. - apply: rpredM; [exact: Qint_lz3|]; apply: rpredM; [|exact: Qint_a]. - apply: rpredM; [|apply: rpredX]; exact: rpred_int. + rewrite /sigma_Q mulrDr mulrN; apply/rpredB/Qint_l3b. + rewrite -mulrA; apply: rpredM (rpred_int _ _) _. + rewrite /exprz exprSr mulrACA mulrC. + apply/rpredM/rpredM/Qint_a/rpredX/rpred_int/iter_lcmn_mul_rat. + rewrite normr_denq dP lez_nat; raise_big_enough. by close. Qed. diff --git a/theories/z3seq_props.v b/theories/z3seq_props.v index 725b221..9ce4956 100644 --- a/theories/z3seq_props.v +++ b/theories/z3seq_props.v @@ -3,16 +3,13 @@ From mathcomp Require Import all_ssreflect all_algebra. Require Import field_tactics lia_tactics bigopz. Require Import harmonic_numbers seq_defs. -Require Import extra_mathcomp. - Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. -Import Num.Theory. +Import Order.TTheory GRing.Theory Num.Theory. -Open Scope ring_scope. +Local Open Scope ring_scope. (*** Properties of the sequence ghn3 ***) @@ -20,22 +17,22 @@ Open Scope ring_scope. (* ghn3, indexed by a natural number *) Definition z3seq (n : nat) := ghn3 (Posz n). -Fact z3seqE (n : nat) : z3seq n = \sum_(1 <= k < n.+1)((Posz k)%:~R ^ 3)^-1. +Fact z3seqE (n : nat) : z3seq n = \sum_(1 <= k < n.+1)(k%:Q ^ 3)^-1. Proof. by rewrite /z3seq /ghn3 /ghn -PoszD eq_big_int_nat /= addn1. Qed. Fact Dz3seqE (i j : nat) : (j <= i)%N -> - z3seq i - z3seq j = \sum_(j.+1 <= k < i.+1) (k %:~R ^ 3)^-1. + z3seq i - z3seq j = \sum_(j.+1 <= k < i.+1) (k%:Q ^ 3)^-1. Proof. -move=>leji; rewrite !z3seqE (big_cat_nat _ _ _ _ (leji : (j.+1 <= i.+1)%N)) //=. +rewrite -ltnS => leji; rewrite !z3seqE (big_cat_nat _ _ _ _ leji) //=. by rewrite addrAC addrN add0r. Qed. Fact lt_0_Dz3seq (i j : nat) : (j < i)%N -> 0 < z3seq i - z3seq j. Proof. move=> ltji; rewrite Dz3seqE; last exact: ltnW. -rewrite big_nat_recr_alt //=; apply: ltr_paddl; last first. +rewrite big_nat_recr //=; apply: ltr_paddl; last first. by rewrite invr_gt0 exprn_gt0 // ltr0n; apply: leq_trans ltji. by apply: sumr_ge0 => *; rewrite invr_ge0 exprn_ge0 // ler0n. Qed. @@ -49,26 +46,23 @@ Qed. (* FIXME: problem with intlia preprocessing : lt1r is badly converted and the hypothesis is not taken into account by lia if not generalized beforehand. *) -Lemma z3seq_smd_maj (k : nat) : (0 < k%:~R :> rat) -> - (k.+1%:~R ^ 3)^-1 <= - - (2%:~R^-1) * ((k.+1%:~R ^ 2) ^-1 - (k%:~R ^ 2) ^-1) :> rat. +Lemma z3seq_smd_maj (k : nat) : 0 < k%:Q -> + (k.+1%:Q ^ 3)^-1 <= - 2%:Q^-1 * ((k.+1%:Q ^ 2) ^-1 - (k%:Q ^ 2) ^-1). Proof. -move=> hr; set r := k.+1%:~R. -have hkr : k%:~R = r - 1 :> rat by rewrite /r -addn1 PoszD rmorphD addrK. -have hrk : r = k%:~R + 1 by rewrite hkr addrK. +move=> hr; set r := k.+1%:Q. +have hkr : k%:Q = r - 1 by rewrite /r -addn1 PoszD rmorphD addrK. +have hrk : r = k%:Q + 1 by rewrite hkr addrK. have lt1r : (1 < r)%Q by rewrite hrk ltr_addr. rewrite hkr; set rhs := (X in _ <= X). -have {rhs} -> : rhs = 2%:~R^-1 * (2%:~R * r - 1) / (r - 1) ^ 2 * (r ^ 2 )^-1. +have {rhs} -> : rhs = 2%:Q^-1 * (2%:Q * r - 1) / (r - 1) ^ 2 * (r ^ 2)^-1. by rewrite /rhs; rat_field; rewrite /r; move: lt1r; goal_to_lia; intlia. -have -> : (r ^ 3)^-1 = r ^-1 * (r ^ 2 )^-1. - by rat_field; rewrite /r; move: lt1r; goal_to_lia; intlia. -have le0r : 0 <= r by apply: ltrW; apply: ltr_trans lt1r. +have -> : (r ^ 3)^-1 = r ^-1 * (r ^ 2)^-1 by rat_field; goal_to_lia; intlia. +have le0r : 0 <= r by apply: ltW; apply: lt_trans lt1r. apply: ler_pmul; rewrite ?invr_ge0 ?exprn_ge0 //. rewrite ler_pdivl_mulr; last first. by apply: exprz_gt0; rewrite subr_gt0. -rewrite ler_pdivr_mull; last by apply: ltr_trans lt1r. +rewrite ler_pdivr_mull; last by apply: lt_trans lt1r. rewrite -subr_ge0; set rhs := (X in _ <= X). -have {rhs} -> : rhs = 3%:~R / 2%:~R * r - 1 by rewrite /rhs; rat_field. -rewrite subr_ge0; apply: mulr_ege1 => //; exact: ltrW. +have {rhs} -> : rhs = 3%:Q / 2%:Q * r - 1 by rewrite /rhs; rat_field. +by rewrite subr_ge0; apply/mulr_ege1/ltW. Qed. -