1 (**************************************************************************)
4 (* ||A|| A project by Andrea Asperti *)
6 (* ||I|| Developers: *)
7 (* ||T|| The HELM team. *)
8 (* ||A|| http://helm.cs.unibo.it *)
10 (* \ / This file is distributed under the terms of the *)
11 (* v GNU General Public License Version 2 *)
13 (**************************************************************************)
15 include "arithmetics/nat.ma".
18 naxiom nat_to_Q: nat → Q.
19 ncoercion nat_to_Q : ∀x:nat.Q ≝ nat_to_Q on _x:nat to Q.
20 ndefinition bool_to_nat ≝ λb. match b with [ true ⇒ 1 | false ⇒ 0 ].
21 ncoercion bool_to_nat : ∀b:bool.nat ≝ bool_to_nat on _b:bool to nat.
22 naxiom Qplus: Q → Q → Q.
23 naxiom Qminus: Q → Q → Q.
24 naxiom Qtimes: Q → Q → Q.
25 naxiom Qdivides: Q → Q → Q.
26 naxiom Qle : Q → Q → Prop.
27 naxiom Qlt: Q → Q → Prop.
28 interpretation "Q plus" 'plus x y = (Qplus x y).
29 interpretation "Q minus" 'minus x y = (Qminus x y).
30 interpretation "Q times" 'times x y = (Qtimes x y).
31 interpretation "Q divides" 'divide x y = (Qdivides x y).
32 interpretation "Q le" 'leq x y = (Qle x y).
33 interpretation "Q lt" 'lt x y = (Qlt x y).
34 naxiom Qtimes_plus: ∀n,m:nat.∀q:Q. (n * q + m * q) = (plus n m) * q.
35 naxiom Qmult_one: ∀q:Q. 1 * q = q.
36 naxiom Qdivides_mult: ∀q1,q2. (q1 * q2) / q1 = q2.
37 naxiom Qtimes_distr: ∀q1,q2,q3:Q.(q3 * q1 + q3 * q2) = q3 * (q1 + q2).
38 naxiom Qdivides_distr: ∀q1,q2,q3:Q.(q1 / q3 + q2 / q3) = (q1 + q2) / q3.
39 naxiom Qplus_comm: ∀q1,q2. q1 + q2 = q2 + q1.
40 naxiom Qplus_assoc: ∀q1,q2,q3. q1 + q2 + q3 = q1 + (q2 + q3).
41 ntheorem Qplus_assoc1: ∀q1,q2,q3. q1 + q2 + q3 = q3 + q2 + q1.
43 naxiom Qle_refl: ∀q1. q1≤q1.
44 naxiom Qle_trans: ∀x,y,z. x≤y → y≤z → x≤z.
45 naxiom Qle_plus_compat: ∀x,y,z,t. x≤y → z≤t → x+z ≤ y+t.
46 naxiom Qmult_zero: ∀q:Q. 0 * q = 0.
48 naxiom phi: Q. (* the golden number *)
49 naxiom golden: phi = phi * phi + phi * phi * phi.
51 (* naxiom Ndivides_mult: ∀n:nat.∀q. (n * q) / n = q. *)
53 ntheorem lem1: ∀n:nat.∀q:Q. (n * q + q) = (S n) * q.
54 #n; #q; ncut (plus n 1 = S n);##[//##]
57 ntheorem Qplus_zero: ∀q:Q. 0 + q = q. //. nqed.
59 ncoinductive locate : Q → Q → Prop ≝
60 L: ∀l,u. locate l ((1 - phi) * l + phi * u) → locate l u
61 | H: ∀l,u. locate (phi * l + (1 - phi) * u) u → locate l u.
63 ndefinition locate_inv_ind':
64 ∀l,u:Q.∀P:Q → Q → Prop.
65 ∀H1: locate l ((1 - phi) * l + phi * u) → P l u.
66 ∀H2: locate (phi * l + (1 - phi) * u) u → P l u.
68 #l; #u; #P; #H1; #H2; #p; ninversion p; #l; #u; #H; #E1; #E2;
72 ndefinition R ≝ ∃l,u:Q. locate l u.
75 nlet corec Q_to_locate q : locate q q ≝ L q q … (Q_to_locate q).
76 //; nrewrite < (Qdivides_mult 3 q) in ⊢ (? % ?); //.
79 ndefinition Q_to_R : Q → R.
84 nlemma help_auto1: ∀q:Q. false * q = 0. #q; nnormalize; //. nqed.
87 nlet corec locate_add (l,u:?) (r1,r2: locate l u) (c1,c2:bool) :
88 locate (l + l + c1 * phi + c2 * phi * phi) (u + u + c1 * phi + c2 * phi * phi) ≝ ?.
89 napply (locate_inv_ind' … r1); napply (locate_inv_ind' … r2);
90 #r2'; #r1'; ncases c1; ncases c2
91 [ ##4: nnormalize; @1;
92 nlapply (locate_add … r1' r2' false false); nnormalize;
93 nrewrite > (Qmult_zero …); nrewrite > (Qmult_zero …); #K; nauto demod;
95 nnormalize in K; nrewrite > (Qmult_zero …) in K; nnormalize; #K;
101 [ ##1,4: ##[ @1 ? (l1'+l2') (u1'+u2') | @2 ? (l1'+l2') (u1'+u2') ]
102 ##[ ##1,5: /2/ | napplyS (Qle_plus_compat …leq1u leq2u) |
103 ##4: napplyS (Qle_plus_compat …leq1l leq2l)
105 ##| ninversion r2; #l2''; #u2''; #leq2l'; #leq2u'; #r2';
106 ninversion r1; #l1''; #u1''; #leq1l'; #leq1u'; #r1';
107 ##[ @1 ? (l1''+l2'') (u1''+u2'');
108 ##[ napply Qle_plus_compat; /3/;
110 ##| napplyS (Qle_plus_compat …leq1u' leq2u');
113 nlet corec locate_add (l1,u1:?) (r1: locate l1 u1) (l2,u2:?) (r2: locate l2 u2) :
114 locate (l1 + l2) (u1 + u2) ≝ ?.
115 napply (locate_inv_ind' … r1); napply (locate_inv_ind' … r2); #l2'; #u2'; #leq2l; #leq2u; #r2;
116 #l1'; #u1'; #leq1l; #leq1u; #r1
117 [ ##1,4: ##[ @1 ? (l1'+l2') (u1'+u2') | @2 ? (l1'+l2') (u1'+u2') ]
118 ##[ ##1,5: /2/ | napplyS (Qle_plus_compat …leq1u leq2u) |
119 ##4: napplyS (Qle_plus_compat …leq1l leq2l)
121 ##| ninversion r2; #l2''; #u2''; #leq2l'; #leq2u'; #r2';
122 ninversion r1; #l1''; #u1''; #leq1l'; #leq1u'; #r1';
123 ##[ @1 ? (l1''+l2'') (u1''+u2'');
124 ##[ napply Qle_plus_compat; /3/;
126 ##| napplyS (Qle_plus_compat …leq1u' leq2u');
129 nlet corec apart (l1,u1) (r1: locate l1 u1) (l2,u2) (r2: locate l2 u2) : CProp[0] ≝
130 match disjoint l1 u1 l2 u2 with
136 include "topology/igft.ma".
137 include "datatypes/pairs.ma".
138 include "datatypes/sums.ma".
140 nrecord pre_order (A: Type[0]) : Type[1] ≝
141 { pre_r :2> A → A → CProp[0];
142 pre_sym: reflexive … pre_r;
143 pre_trans: transitive … pre_r
146 nrecord Ax_pro : Type[1] ≝
151 interpretation "Ax_pro leq" 'leq x y = (pre_r ? (Aleq ?) x y).
153 (*CSC: per auto per sotto, ma non sembra aiutare *)
154 nlemma And_elim1: ∀A,B. A ∧ B → A.
158 nlemma And_elim2: ∀A,B. A ∧ B → B.
161 (*CSC: /fine per auto per sotto *)
163 ndefinition Rax : Ax_pro.
166 [ #p; napply (unit + sigma … (λc. fst … p < fst … c ∧ fst … c < snd … c ∧ snd … c < snd … p))
168 [ #_; napply {c' | fst … c < fst … c' ∧ snd … c' < snd … c}
169 | *; #c'; #_; napply {d' | fst … d' = fst … c ∧ snd … d' = fst … c'
170 ∨ fst … d' = snd … c' ∧ snd … d' = snd … c } ]##]
171 ##| @ (λc,d. fst … d ≤ fst … c ∧ snd … c ≤ snd … d)
173 | nnormalize; #z; #x; #y; *; #H1; #H2; *; /3/; (*CSC: perche' non va? *) ##]
176 ndefinition downarrow: ∀S:Ax_pro. Ω \sup S → Ω \sup S ≝
177 λS:Ax_pro.λU:Ω ^S.{a | ∃b:S. b ∈ U ∧ a ≤ b}.
179 interpretation "downarrow" 'downarrow a = (downarrow ? a).
181 ndefinition fintersects: ∀S:Ax_pro. Ω \sup S → Ω \sup S → Ω \sup S ≝
184 interpretation "fintersects" 'fintersects U V = (fintersects ? U V).
186 ndefinition singleton ≝ λA.λa:A.{b | b=a}.
188 interpretation "singleton" 'singl a = (singleton ? a).
190 ninductive ftcover (A : Ax_pro) (U : Ω^A) : A → CProp[0] ≝
191 | ftreflexivity : ∀a. a ∈ U → ftcover A U a
192 | ftleqinfinity : ∀a,b. a ≤ b → ∀i. (∀x. x ∈ 𝐂 b i ↓ (singleton … a) → ftcover A U x) → ftcover A U a
193 | ftleqleft : ∀a,b. a ≤ b → ftcover A U b → ftcover A U a.
195 interpretation "ftcovers" 'covers a U = (ftcover ? U a).
197 ntheorem ftinfinity: ∀A: Ax_pro. ∀U: Ω^A. ∀a. ∀i. (∀x. x ∈ 𝐂 a i → x ◃ U) → a ◃ U.
199 napply (ftleqinfinity … a … i); //;
200 #b; *; *; #b; *; #H1; #H2; #H3; napply (ftleqleft … b); //;
201 napply H; napply H1 (*CSC: auto non va! *).
204 ncoinductive ftfish (A : Ax_pro) (F : Ω^A) : A → CProp[0] ≝
207 (∀b. a ≤ b → ftfish A F b) →
208 (∀b. a ≤ b → ∀i:𝐈 b. ∃x. x ∈ 𝐂 b i ↓ (singleton … a) ∧ ftfish A F x) →
211 interpretation "fish" 'fish a U = (ftfish ? U a).
213 nlemma ftcoreflexivity: ∀A: Ax_pro.∀F.∀a:A. a ⋉ F → a ∈ F.
214 #A; #F; #a; #H; ncases H; //.
217 nlemma ftcoleqinfinity:
218 ∀A: Ax_pro.∀F.∀a:A. a ⋉ F →
219 ∀b. (a ≤ b → ∀i. (∃x. x ∈ 𝐂 b i ↓ (singleton … a) ∧ x ⋉ F)).
220 #A; #F; #a; #H; ncases H; /2/.
224 ∀A: Ax_pro.∀F.∀a:A. a ⋉ F →
226 #A; #F; #a; #H; ncases H; /2/.
229 (*CSC: non serve manco questo (vedi sotto) *)
230 nlemma auto_hint3: ∀A. S__o__AAx A = S (AAx A).
234 alias symbol "I" (instance 6) = "I".
235 ntheorem ftcoinfinity: ∀A: Ax_pro. ∀F: Ω^A. ∀a. a ⋉ F → (∀i: 𝐈 a. ∃b. b ∈ 𝐂 a i ∧ b ⋉ F).
236 #A; #F; #a; #H; #i; nlapply (ftcoleqinfinity … F … a … i); //; #H;
237 ncases H; #c; *; *; *; #b; *; #H1; #H2; #H3; #H4; @ b; @ [ napply H1 (*CSC: auto non va *)]
238 napply (ftcoleqleft … c); //.
241 nrecord Pt (A: Ax_pro) : Type[1] ≝
243 pt_inhabited: ∃a. a ∈ pt_set;
244 pt_filtering: ∀a,b. a ∈ pt_set → b ∈ pt_set → ∃c. c ∈ (singleton … a) ↓ (singleton … b) → c ∈ pt_set;
245 pt_closed: {b | b ⋉ pt_set} ⊆ pt_set