author | paulson |
Fri, 23 Jul 1999 17:29:12 +0200 | |
changeset 7077 | 60b098bb8b8a |
parent 5535 | 678999604ee9 |
child 7219 | 4e3f386c2e37 |
permissions | -rw-r--r-- |
5078 | 1 |
(* Title : PRat.ML |
2 |
Author : Jacques D. Fleuriot |
|
3 |
Copyright : 1998 University of Cambridge |
|
4 |
Description : The positive rationals |
|
5 |
*) |
|
6 |
||
7 |
open PRat; |
|
8 |
||
9 |
Delrules [equalityI]; |
|
10 |
||
11 |
(*** Many theorems similar to those in Integ.thy ***) |
|
12 |
(*** Proving that ratrel is an equivalence relation ***) |
|
13 |
||
14 |
Goal |
|
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
15 |
"[| (x1::pnat) * y2 = x2 * y1; x2 * y3 = x3 * y2 |] \ |
5078 | 16 |
\ ==> x1 * y3 = x3 * y1"; |
17 |
by (res_inst_tac [("k1","y2")] (pnat_mult_cancel1 RS iffD1) 1); |
|
18 |
by (auto_tac (claset(), simpset() addsimps [pnat_mult_assoc RS sym])); |
|
19 |
by (auto_tac (claset(),simpset() addsimps [pnat_mult_commute])); |
|
20 |
by (dres_inst_tac [("s","x2 * y3")] sym 1); |
|
21 |
by (asm_simp_tac (simpset() addsimps [pnat_mult_left_commute, |
|
22 |
pnat_mult_commute]) 1); |
|
23 |
qed "prat_trans_lemma"; |
|
24 |
||
25 |
(** Natural deduction for ratrel **) |
|
26 |
||
27 |
Goalw [ratrel_def] |
|
28 |
"(((x1,y1),(x2,y2)): ratrel) = (x1 * y2 = x2 * y1)"; |
|
29 |
by (Fast_tac 1); |
|
30 |
qed "ratrel_iff"; |
|
31 |
||
32 |
Goalw [ratrel_def] |
|
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
33 |
"[| x1 * y2 = x2 * y1 |] ==> ((x1,y1),(x2,y2)): ratrel"; |
5078 | 34 |
by (Fast_tac 1); |
35 |
qed "ratrelI"; |
|
36 |
||
37 |
Goalw [ratrel_def] |
|
38 |
"p: ratrel --> (EX x1 y1 x2 y2. \ |
|
39 |
\ p = ((x1,y1),(x2,y2)) & x1 *y2 = x2 *y1)"; |
|
40 |
by (Fast_tac 1); |
|
41 |
qed "ratrelE_lemma"; |
|
42 |
||
43 |
val [major,minor] = goal thy |
|
44 |
"[| p: ratrel; \ |
|
45 |
\ !!x1 y1 x2 y2. [| p = ((x1,y1),(x2,y2)); x1*y2 = x2*y1 \ |
|
46 |
\ |] ==> Q |] ==> Q"; |
|
47 |
by (cut_facts_tac [major RS (ratrelE_lemma RS mp)] 1); |
|
48 |
by (REPEAT (eresolve_tac [asm_rl,exE,conjE,minor] 1)); |
|
49 |
qed "ratrelE"; |
|
50 |
||
51 |
AddSIs [ratrelI]; |
|
52 |
AddSEs [ratrelE]; |
|
53 |
||
54 |
Goal "(x,x): ratrel"; |
|
55 |
by (stac surjective_pairing 1 THEN rtac (refl RS ratrelI) 1); |
|
56 |
qed "ratrel_refl"; |
|
57 |
||
58 |
Goalw [equiv_def, refl_def, sym_def, trans_def] |
|
59 |
"equiv {x::(pnat*pnat).True} ratrel"; |
|
60 |
by (fast_tac (claset() addSIs [ratrel_refl] |
|
61 |
addSEs [sym, prat_trans_lemma]) 1); |
|
62 |
qed "equiv_ratrel"; |
|
63 |
||
64 |
val equiv_ratrel_iff = |
|
65 |
[TrueI, TrueI] MRS |
|
66 |
([CollectI, CollectI] MRS |
|
67 |
(equiv_ratrel RS eq_equiv_class_iff)); |
|
68 |
||
69 |
Goalw [prat_def,ratrel_def,quotient_def] "ratrel^^{(x,y)}:prat"; |
|
70 |
by (Blast_tac 1); |
|
71 |
qed "ratrel_in_prat"; |
|
72 |
||
73 |
Goal "inj_on Abs_prat prat"; |
|
74 |
by (rtac inj_on_inverseI 1); |
|
75 |
by (etac Abs_prat_inverse 1); |
|
76 |
qed "inj_on_Abs_prat"; |
|
77 |
||
78 |
Addsimps [equiv_ratrel_iff,inj_on_Abs_prat RS inj_on_iff, |
|
79 |
ratrel_iff, ratrel_in_prat, Abs_prat_inverse]; |
|
80 |
||
81 |
Addsimps [equiv_ratrel RS eq_equiv_class_iff]; |
|
82 |
val eq_ratrelD = equiv_ratrel RSN (2,eq_equiv_class); |
|
83 |
||
84 |
Goal "inj(Rep_prat)"; |
|
85 |
by (rtac inj_inverseI 1); |
|
86 |
by (rtac Rep_prat_inverse 1); |
|
87 |
qed "inj_Rep_prat"; |
|
88 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
89 |
(** prat_of_pnat: the injection from pnat to prat **) |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
90 |
Goal "inj(prat_of_pnat)"; |
5078 | 91 |
by (rtac injI 1); |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
92 |
by (rewtac prat_of_pnat_def); |
5078 | 93 |
by (dtac (inj_on_Abs_prat RS inj_onD) 1); |
94 |
by (REPEAT (rtac ratrel_in_prat 1)); |
|
95 |
by (dtac eq_equiv_class 1); |
|
96 |
by (rtac equiv_ratrel 1); |
|
97 |
by (Fast_tac 1); |
|
98 |
by Safe_tac; |
|
99 |
by (Asm_full_simp_tac 1); |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
100 |
qed "inj_prat_of_pnat"; |
5078 | 101 |
|
102 |
val [prem] = goal thy |
|
103 |
"(!!x y. z = Abs_prat(ratrel^^{(x,y)}) ==> P) ==> P"; |
|
104 |
by (res_inst_tac [("x1","z")] |
|
105 |
(rewrite_rule [prat_def] Rep_prat RS quotientE) 1); |
|
106 |
by (dres_inst_tac [("f","Abs_prat")] arg_cong 1); |
|
107 |
by (res_inst_tac [("p","x")] PairE 1); |
|
108 |
by (rtac prem 1); |
|
109 |
by (asm_full_simp_tac (simpset() addsimps [Rep_prat_inverse]) 1); |
|
110 |
qed "eq_Abs_prat"; |
|
111 |
||
112 |
(**** qinv: inverse on prat ****) |
|
113 |
||
114 |
Goalw [congruent_def] |
|
115 |
"congruent ratrel (%p. split (%x y. ratrel^^{(y,x)}) p)"; |
|
116 |
by Safe_tac; |
|
117 |
by (asm_full_simp_tac (simpset() addsimps [pnat_mult_commute]) 1); |
|
118 |
qed "qinv_congruent"; |
|
119 |
||
120 |
(*Resolve th against the corresponding facts for qinv*) |
|
121 |
val qinv_ize = RSLIST [equiv_ratrel, qinv_congruent]; |
|
122 |
||
123 |
Goalw [qinv_def] |
|
124 |
"qinv (Abs_prat(ratrel^^{(x,y)})) = Abs_prat(ratrel ^^ {(y,x)})"; |
|
125 |
by (res_inst_tac [("f","Abs_prat")] arg_cong 1); |
|
126 |
by (simp_tac (simpset() addsimps |
|
127 |
[ratrel_in_prat RS Abs_prat_inverse,qinv_ize UN_equiv_class]) 1); |
|
128 |
qed "qinv"; |
|
129 |
||
130 |
Goal "qinv (qinv z) = z"; |
|
131 |
by (res_inst_tac [("z","z")] eq_Abs_prat 1); |
|
132 |
by (asm_simp_tac (simpset() addsimps [qinv]) 1); |
|
133 |
qed "qinv_qinv"; |
|
134 |
||
135 |
Goal "inj(qinv)"; |
|
136 |
by (rtac injI 1); |
|
137 |
by (dres_inst_tac [("f","qinv")] arg_cong 1); |
|
138 |
by (asm_full_simp_tac (simpset() addsimps [qinv_qinv]) 1); |
|
139 |
qed "inj_qinv"; |
|
140 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
141 |
Goalw [prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
142 |
"qinv(prat_of_pnat (Abs_pnat 1)) = prat_of_pnat (Abs_pnat 1)"; |
5078 | 143 |
by (simp_tac (simpset() addsimps [qinv]) 1); |
144 |
qed "qinv_1"; |
|
145 |
||
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
146 |
Goal "!!(x1::pnat). [| x1 * y2 = x2 * y1 |] ==> \ |
5078 | 147 |
\ (x * y1 + x1 * ya) * (ya * y2) = (x * y2 + x2 * ya) * (ya * y1)"; |
148 |
by (auto_tac (claset() addSIs [pnat_same_multI2], |
|
149 |
simpset() addsimps [pnat_add_mult_distrib, |
|
150 |
pnat_mult_assoc])); |
|
151 |
by (res_inst_tac [("n1","y2")] (pnat_mult_commute RS subst) 1); |
|
152 |
by (auto_tac (claset() addIs [pnat_add_left_cancel RS iffD2],simpset() addsimps pnat_mult_ac)); |
|
153 |
by (res_inst_tac [("y1","x1")] (pnat_mult_left_commute RS subst) 1); |
|
154 |
by (res_inst_tac [("y1","x1")] (pnat_mult_left_commute RS ssubst) 1); |
|
155 |
by (auto_tac (claset(),simpset() addsimps [pnat_mult_assoc RS sym])); |
|
156 |
qed "prat_add_congruent2_lemma"; |
|
157 |
||
158 |
Goal |
|
159 |
"congruent2 ratrel (%p1 p2. \ |
|
160 |
\ split (%x1 y1. split (%x2 y2. ratrel^^{(x1*y2 + x2*y1, y1*y2)}) p2) p1)"; |
|
161 |
by (rtac (equiv_ratrel RS congruent2_commuteI) 1); |
|
162 |
by Safe_tac; |
|
163 |
by (rewtac split_def); |
|
164 |
by (asm_simp_tac (simpset() addsimps [pnat_mult_commute,pnat_add_commute]) 1); |
|
165 |
by (auto_tac (claset(),simpset() addsimps [prat_add_congruent2_lemma])); |
|
166 |
qed "prat_add_congruent2"; |
|
167 |
||
168 |
(*Resolve th against the corresponding facts for prat_add*) |
|
169 |
val prat_add_ize = RSLIST [equiv_ratrel, prat_add_congruent2]; |
|
170 |
||
171 |
Goalw [prat_add_def] |
|
172 |
"Abs_prat((ratrel^^{(x1,y1)})) + Abs_prat((ratrel^^{(x2,y2)})) = \ |
|
173 |
\ Abs_prat(ratrel ^^ {(x1*y2 + x2*y1, y1*y2)})"; |
|
174 |
by (simp_tac (simpset() addsimps [prat_add_ize UN_equiv_class2]) 1); |
|
175 |
qed "prat_add"; |
|
176 |
||
177 |
Goal "(z::prat) + w = w + z"; |
|
178 |
by (res_inst_tac [("z","z")] eq_Abs_prat 1); |
|
179 |
by (res_inst_tac [("z","w")] eq_Abs_prat 1); |
|
5535 | 180 |
by (asm_simp_tac |
181 |
(simpset() addsimps [prat_add] @ pnat_add_ac @ pnat_mult_ac) 1); |
|
5078 | 182 |
qed "prat_add_commute"; |
183 |
||
184 |
Goal "((z1::prat) + z2) + z3 = z1 + (z2 + z3)"; |
|
185 |
by (res_inst_tac [("z","z1")] eq_Abs_prat 1); |
|
186 |
by (res_inst_tac [("z","z2")] eq_Abs_prat 1); |
|
187 |
by (res_inst_tac [("z","z3")] eq_Abs_prat 1); |
|
5535 | 188 |
by (asm_simp_tac (simpset() addsimps [pnat_add_mult_distrib2,prat_add] @ |
189 |
pnat_add_ac @ pnat_mult_ac) 1); |
|
5078 | 190 |
qed "prat_add_assoc"; |
191 |
||
192 |
qed_goal "prat_add_left_commute" thy |
|
193 |
"(z1::prat) + (z2 + z3) = z2 + (z1 + z3)" |
|
194 |
(fn _ => [rtac (prat_add_commute RS trans) 1, rtac (prat_add_assoc RS trans) 1, |
|
195 |
rtac (prat_add_commute RS arg_cong) 1]); |
|
196 |
||
197 |
(* Positive Rational addition is an AC operator *) |
|
198 |
val prat_add_ac = [prat_add_assoc, prat_add_commute, prat_add_left_commute]; |
|
199 |
||
200 |
||
201 |
(*** Congruence property for multiplication ***) |
|
202 |
||
203 |
Goalw [congruent2_def] |
|
204 |
"congruent2 ratrel (%p1 p2. \ |
|
205 |
\ split (%x1 y1. split (%x2 y2. ratrel^^{(x1*x2, y1*y2)}) p2) p1)"; |
|
206 |
||
207 |
(*Proof via congruent2_commuteI seems longer*) |
|
208 |
by Safe_tac; |
|
209 |
by (asm_simp_tac (simpset() addsimps [pnat_mult_assoc]) 1); |
|
210 |
(*The rest should be trivial, but rearranging terms is hard*) |
|
211 |
by (res_inst_tac [("x1","x1a")] (pnat_mult_left_commute RS ssubst) 1); |
|
212 |
by (asm_simp_tac (simpset() addsimps [pnat_mult_assoc RS sym]) 1); |
|
213 |
by (asm_simp_tac (simpset() addsimps pnat_mult_ac) 1); |
|
214 |
qed "pnat_mult_congruent2"; |
|
215 |
||
216 |
(*Resolve th against the corresponding facts for pnat_mult*) |
|
217 |
val prat_mult_ize = RSLIST [equiv_ratrel, pnat_mult_congruent2]; |
|
218 |
||
219 |
Goalw [prat_mult_def] |
|
220 |
"Abs_prat(ratrel^^{(x1,y1)}) * Abs_prat(ratrel^^{(x2,y2)}) = \ |
|
221 |
\ Abs_prat(ratrel^^{(x1*x2, y1*y2)})"; |
|
222 |
by (asm_simp_tac |
|
223 |
(simpset() addsimps [prat_mult_ize UN_equiv_class2]) 1); |
|
224 |
qed "prat_mult"; |
|
225 |
||
226 |
Goal "(z::prat) * w = w * z"; |
|
227 |
by (res_inst_tac [("z","z")] eq_Abs_prat 1); |
|
228 |
by (res_inst_tac [("z","w")] eq_Abs_prat 1); |
|
5535 | 229 |
by (asm_simp_tac (simpset() addsimps pnat_mult_ac @ [prat_mult]) 1); |
5078 | 230 |
qed "prat_mult_commute"; |
231 |
||
232 |
Goal "((z1::prat) * z2) * z3 = z1 * (z2 * z3)"; |
|
233 |
by (res_inst_tac [("z","z1")] eq_Abs_prat 1); |
|
234 |
by (res_inst_tac [("z","z2")] eq_Abs_prat 1); |
|
235 |
by (res_inst_tac [("z","z3")] eq_Abs_prat 1); |
|
236 |
by (asm_simp_tac (simpset() addsimps [prat_mult, pnat_mult_assoc]) 1); |
|
237 |
qed "prat_mult_assoc"; |
|
238 |
||
239 |
(*For AC rewriting*) |
|
240 |
Goal "(x::prat)*(y*z)=y*(x*z)"; |
|
241 |
by (rtac (prat_mult_commute RS trans) 1); |
|
242 |
by (rtac (prat_mult_assoc RS trans) 1); |
|
243 |
by (rtac (prat_mult_commute RS arg_cong) 1); |
|
244 |
qed "prat_mult_left_commute"; |
|
245 |
||
246 |
(*Positive Rational multiplication is an AC operator*) |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
247 |
val prat_mult_ac = [prat_mult_assoc, |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
248 |
prat_mult_commute,prat_mult_left_commute]; |
5078 | 249 |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
250 |
Goalw [prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
251 |
"(prat_of_pnat (Abs_pnat 1)) * z = z"; |
5078 | 252 |
by (res_inst_tac [("z","z")] eq_Abs_prat 1); |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
253 |
by (asm_full_simp_tac (simpset() addsimps |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
254 |
[prat_mult] @ pnat_mult_ac) 1); |
5078 | 255 |
qed "prat_mult_1"; |
256 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
257 |
Goalw [prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
258 |
"z * (prat_of_pnat (Abs_pnat 1)) = z"; |
5078 | 259 |
by (res_inst_tac [("z","z")] eq_Abs_prat 1); |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
260 |
by (asm_full_simp_tac (simpset() addsimps |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
261 |
[prat_mult] @ pnat_mult_ac) 1); |
5078 | 262 |
qed "prat_mult_1_right"; |
263 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
264 |
Goalw [prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
265 |
"prat_of_pnat ((z1::pnat) + z2) = \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
266 |
\ prat_of_pnat z1 + prat_of_pnat z2"; |
5078 | 267 |
by (asm_simp_tac (simpset() addsimps [prat_add, |
268 |
pnat_add_mult_distrib,pnat_mult_1]) 1); |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
269 |
qed "prat_of_pnat_add"; |
5078 | 270 |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
271 |
Goalw [prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
272 |
"prat_of_pnat ((z1::pnat) * z2) = \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
273 |
\ prat_of_pnat z1 * prat_of_pnat z2"; |
5078 | 274 |
by (asm_simp_tac (simpset() addsimps [prat_mult, |
275 |
pnat_mult_1]) 1); |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
276 |
qed "prat_of_pnat_mult"; |
5078 | 277 |
|
278 |
(*** prat_mult and qinv ***) |
|
279 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
280 |
Goalw [prat_def,prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
281 |
"qinv (q) * q = prat_of_pnat (Abs_pnat 1)"; |
5078 | 282 |
by (res_inst_tac [("z","q")] eq_Abs_prat 1); |
283 |
by (asm_full_simp_tac (simpset() addsimps [qinv, |
|
284 |
prat_mult,pnat_mult_1,pnat_mult_1_left, |
|
285 |
pnat_mult_commute]) 1); |
|
286 |
qed "prat_mult_qinv"; |
|
287 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
288 |
Goal "q * qinv (q) = prat_of_pnat (Abs_pnat 1)"; |
5078 | 289 |
by (rtac (prat_mult_commute RS subst) 1); |
290 |
by (simp_tac (simpset() addsimps [prat_mult_qinv]) 1); |
|
291 |
qed "prat_mult_qinv_right"; |
|
292 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
293 |
Goal "? y. (x::prat) * y = prat_of_pnat (Abs_pnat 1)"; |
5078 | 294 |
by (fast_tac (claset() addIs [prat_mult_qinv_right]) 1); |
295 |
qed "prat_qinv_ex"; |
|
296 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
297 |
Goal "?! y. (x::prat) * y = prat_of_pnat (Abs_pnat 1)"; |
5078 | 298 |
by (auto_tac (claset() addIs [prat_mult_qinv_right],simpset())); |
299 |
by (dres_inst_tac [("f","%x. ya*x")] arg_cong 1); |
|
300 |
by (asm_full_simp_tac (simpset() addsimps [prat_mult_assoc RS sym]) 1); |
|
301 |
by (asm_full_simp_tac (simpset() addsimps [prat_mult_commute, |
|
302 |
prat_mult_1,prat_mult_1_right]) 1); |
|
303 |
qed "prat_qinv_ex1"; |
|
304 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
305 |
Goal "?! y. y * (x::prat) = prat_of_pnat (Abs_pnat 1)"; |
5078 | 306 |
by (auto_tac (claset() addIs [prat_mult_qinv],simpset())); |
307 |
by (dres_inst_tac [("f","%x. x*ya")] arg_cong 1); |
|
308 |
by (asm_full_simp_tac (simpset() addsimps [prat_mult_assoc]) 1); |
|
309 |
by (asm_full_simp_tac (simpset() addsimps [prat_mult_commute, |
|
310 |
prat_mult_1,prat_mult_1_right]) 1); |
|
311 |
qed "prat_qinv_left_ex1"; |
|
312 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
313 |
Goal "x * y = prat_of_pnat (Abs_pnat 1) ==> x = qinv y"; |
5078 | 314 |
by (cut_inst_tac [("q","y")] prat_mult_qinv 1); |
315 |
by (res_inst_tac [("x1","y")] (prat_qinv_left_ex1 RS ex1E) 1); |
|
316 |
by (Blast_tac 1); |
|
317 |
qed "prat_mult_inv_qinv"; |
|
318 |
||
319 |
Goal "? y. x = qinv y"; |
|
320 |
by (cut_inst_tac [("x","x")] prat_qinv_ex 1); |
|
321 |
by (etac exE 1 THEN dtac prat_mult_inv_qinv 1); |
|
322 |
by (Fast_tac 1); |
|
323 |
qed "prat_as_inverse_ex"; |
|
324 |
||
325 |
Goal "qinv(x*y) = qinv(x)*qinv(y)"; |
|
326 |
by (res_inst_tac [("z","x")] eq_Abs_prat 1); |
|
327 |
by (res_inst_tac [("z","y")] eq_Abs_prat 1); |
|
328 |
by (auto_tac (claset(),simpset() addsimps [qinv,prat_mult])); |
|
329 |
qed "qinv_mult_eq"; |
|
330 |
||
331 |
(** Lemmas **) |
|
332 |
||
333 |
qed_goal "prat_add_assoc_cong" thy |
|
334 |
"!!z. (z::prat) + v = z' + v' ==> z + (v + w) = z' + (v' + w)" |
|
335 |
(fn _ => [(asm_simp_tac (simpset() addsimps [prat_add_assoc RS sym]) 1)]); |
|
336 |
||
337 |
qed_goal "prat_add_assoc_swap" thy "(z::prat) + (v + w) = v + (z + w)" |
|
338 |
(fn _ => [(REPEAT (ares_tac [prat_add_commute RS prat_add_assoc_cong] 1))]); |
|
339 |
||
340 |
Goal "((z1::prat) + z2) * w = (z1 * w) + (z2 * w)"; |
|
341 |
by (res_inst_tac [("z","z1")] eq_Abs_prat 1); |
|
342 |
by (res_inst_tac [("z","z2")] eq_Abs_prat 1); |
|
343 |
by (res_inst_tac [("z","w")] eq_Abs_prat 1); |
|
344 |
by (asm_simp_tac |
|
5535 | 345 |
(simpset() addsimps [pnat_add_mult_distrib2, prat_add, prat_mult] @ |
346 |
pnat_add_ac @ pnat_mult_ac) 1); |
|
5078 | 347 |
qed "prat_add_mult_distrib"; |
348 |
||
349 |
val prat_mult_commute'= read_instantiate [("z","w")] prat_mult_commute; |
|
350 |
||
351 |
Goal "(w::prat) * (z1 + z2) = (w * z1) + (w * z2)"; |
|
352 |
by (simp_tac (simpset() addsimps [prat_mult_commute',prat_add_mult_distrib]) 1); |
|
353 |
qed "prat_add_mult_distrib2"; |
|
354 |
||
355 |
val prat_mult_simps = [prat_mult_1, prat_mult_1_right, |
|
356 |
prat_mult_qinv, prat_mult_qinv_right]; |
|
357 |
Addsimps prat_mult_simps; |
|
358 |
||
359 |
(*** theorems for ordering ***) |
|
360 |
(* prove introduction and elimination rules for prat_less *) |
|
361 |
||
362 |
Goalw [prat_less_def] |
|
363 |
"Q1 < (Q2::prat) = (EX Q3. Q1 + Q3 = Q2)"; |
|
364 |
by (Fast_tac 1); |
|
365 |
qed "prat_less_iff"; |
|
366 |
||
367 |
Goalw [prat_less_def] |
|
368 |
"!!(Q1::prat). Q1 + Q3 = Q2 ==> Q1 < Q2"; |
|
369 |
by (Fast_tac 1); |
|
370 |
qed "prat_lessI"; |
|
371 |
||
372 |
(* ordering on positive fractions in terms of existence of sum *) |
|
373 |
Goalw [prat_less_def] |
|
374 |
"Q1 < (Q2::prat) --> (EX Q3. Q1 + Q3 = Q2)"; |
|
375 |
by (Fast_tac 1); |
|
376 |
qed "prat_lessE_lemma"; |
|
377 |
||
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
378 |
Goal "!!P. [| Q1 < (Q2::prat); \ |
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
379 |
\ !! (Q3::prat). Q1 + Q3 = Q2 ==> P |] \ |
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
380 |
\ ==> P"; |
5078 | 381 |
by (dtac (prat_lessE_lemma RS mp) 1); |
382 |
by Auto_tac; |
|
383 |
qed "prat_lessE"; |
|
384 |
||
385 |
(* qless is a strong order i.e nonreflexive and transitive *) |
|
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
386 |
Goal "!!(q1::prat). [| q1 < q2; q2 < q3 |] ==> q1 < q3"; |
5078 | 387 |
by (REPEAT(dtac (prat_lessE_lemma RS mp) 1)); |
388 |
by (REPEAT(etac exE 1)); |
|
389 |
by (hyp_subst_tac 1); |
|
390 |
by (res_inst_tac [("Q3.0","Q3 + Q3a")] prat_lessI 1); |
|
391 |
by (auto_tac (claset(),simpset() addsimps [prat_add_assoc])); |
|
392 |
qed "prat_less_trans"; |
|
393 |
||
394 |
Goal "~q < (q::prat)"; |
|
395 |
by (EVERY1[rtac notI, dtac (prat_lessE_lemma RS mp)]); |
|
396 |
by (res_inst_tac [("z","q")] eq_Abs_prat 1); |
|
397 |
by (res_inst_tac [("z","Q3")] eq_Abs_prat 1); |
|
398 |
by (etac exE 1 THEN res_inst_tac [("z","Q3a")] eq_Abs_prat 1); |
|
399 |
by (REPEAT(hyp_subst_tac 1)); |
|
400 |
by (asm_full_simp_tac (simpset() addsimps [prat_add, |
|
401 |
pnat_no_add_ident,pnat_add_mult_distrib2] @ pnat_mult_ac) 1); |
|
402 |
qed "prat_less_not_refl"; |
|
403 |
||
404 |
(*** y < y ==> P ***) |
|
405 |
bind_thm("prat_less_irrefl",prat_less_not_refl RS notE); |
|
406 |
||
5459 | 407 |
Goal "!! (q1::prat). q1 < q2 ==> ~ q2 < q1"; |
408 |
by (rtac notI 1); |
|
5078 | 409 |
by (dtac prat_less_trans 1 THEN assume_tac 1); |
410 |
by (asm_full_simp_tac (simpset() addsimps [prat_less_not_refl]) 1); |
|
5459 | 411 |
qed "prat_less_not_sym"; |
5078 | 412 |
|
5459 | 413 |
(* [| x < y; ~P ==> y < x |] ==> P *) |
414 |
bind_thm ("prat_less_asym", prat_less_not_sym RS swap); |
|
5078 | 415 |
|
416 |
(* half of positive fraction exists- Gleason p. 120- Proposition 9-2.6(i)*) |
|
417 |
Goal "!(q::prat). ? x. x + x = q"; |
|
418 |
by (rtac allI 1); |
|
419 |
by (res_inst_tac [("z","q")] eq_Abs_prat 1); |
|
420 |
by (res_inst_tac [("x","Abs_prat (ratrel ^^ {(x, y+y)})")] exI 1); |
|
421 |
by (auto_tac (claset(),simpset() addsimps |
|
422 |
[prat_add,pnat_mult_assoc RS sym,pnat_add_mult_distrib, |
|
423 |
pnat_add_mult_distrib2])); |
|
424 |
qed "lemma_prat_dense"; |
|
425 |
||
426 |
Goal "? (x::prat). x + x = q"; |
|
427 |
by (res_inst_tac [("z","q")] eq_Abs_prat 1); |
|
428 |
by (res_inst_tac [("x","Abs_prat (ratrel ^^ {(x, y+y)})")] exI 1); |
|
429 |
by (auto_tac (claset(),simpset() addsimps |
|
430 |
[prat_add,pnat_mult_assoc RS sym,pnat_add_mult_distrib, |
|
431 |
pnat_add_mult_distrib2])); |
|
432 |
qed "prat_lemma_dense"; |
|
433 |
||
434 |
(* there exists a number between any two positive fractions *) |
|
435 |
(* Gleason p. 120- Proposition 9-2.6(iv) *) |
|
436 |
Goalw [prat_less_def] |
|
437 |
"!! (q1::prat). q1 < q2 ==> ? x. q1 < x & x < q2"; |
|
438 |
by (auto_tac (claset() addIs [lemma_prat_dense],simpset())); |
|
439 |
by (res_inst_tac [("x","T")] (lemma_prat_dense RS allE) 1); |
|
440 |
by (etac exE 1); |
|
441 |
by (res_inst_tac [("x","q1 + x")] exI 1); |
|
442 |
by (auto_tac (claset() addIs [prat_lemma_dense], |
|
443 |
simpset() addsimps [prat_add_assoc])); |
|
444 |
qed "prat_dense"; |
|
445 |
||
446 |
(* ordering of addition for positive fractions *) |
|
447 |
Goalw [prat_less_def] |
|
448 |
"!!(q1::prat). q1 < q2 ==> q1 + x < q2 + x"; |
|
449 |
by (Step_tac 1); |
|
450 |
by (res_inst_tac [("x","T")] exI 1); |
|
451 |
by (auto_tac (claset(),simpset() addsimps prat_add_ac)); |
|
452 |
qed "prat_add_less2_mono1"; |
|
453 |
||
454 |
Goal |
|
455 |
"!!(q1::prat). q1 < q2 ==> x + q1 < x + q2"; |
|
456 |
by (auto_tac (claset() addIs [prat_add_less2_mono1], |
|
457 |
simpset() addsimps [prat_add_commute])); |
|
458 |
qed "prat_add_less2_mono2"; |
|
459 |
||
460 |
(* ordering of multiplication for positive fractions *) |
|
461 |
Goalw [prat_less_def] |
|
462 |
"!!(q1::prat). q1 < q2 ==> q1 * x < q2 * x"; |
|
463 |
by (Step_tac 1); |
|
464 |
by (res_inst_tac [("x","T*x")] exI 1); |
|
465 |
by (auto_tac (claset(),simpset() addsimps [prat_add_mult_distrib])); |
|
466 |
qed "prat_mult_less2_mono1"; |
|
467 |
||
468 |
Goal "!!(q1::prat). q1 < q2 ==> x * q1 < x * q2"; |
|
469 |
by (auto_tac (claset() addDs [prat_mult_less2_mono1], |
|
470 |
simpset() addsimps [prat_mult_commute])); |
|
471 |
qed "prat_mult_left_less2_mono1"; |
|
472 |
||
473 |
(* there is no smallest positive fraction *) |
|
474 |
Goalw [prat_less_def] "? (x::prat). x < y"; |
|
475 |
by (cut_facts_tac [lemma_prat_dense] 1); |
|
476 |
by (Fast_tac 1); |
|
477 |
qed "qless_Ex"; |
|
478 |
||
479 |
(* lemma for proving $< is linear *) |
|
480 |
Goalw [prat_def,prat_less_def] |
|
481 |
"ratrel ^^ {(x, y * ya)} : {p::(pnat*pnat).True}/ratrel"; |
|
482 |
by (asm_full_simp_tac (simpset() addsimps [ratrel_def,quotient_def]) 1); |
|
483 |
by (Blast_tac 1); |
|
484 |
qed "lemma_prat_less_linear"; |
|
485 |
||
486 |
(* linearity of < -- Gleason p. 120 - Proposition 9-2.6 *) |
|
487 |
(*** FIXME Proof long ***) |
|
488 |
Goalw [prat_less_def] |
|
489 |
"(q1::prat) < q2 | q1 = q2 | q2 < q1"; |
|
490 |
by (res_inst_tac [("z","q1")] eq_Abs_prat 1); |
|
491 |
by (res_inst_tac [("z","q2")] eq_Abs_prat 1); |
|
492 |
by (Step_tac 1 THEN REPEAT(dtac (not_ex RS iffD1) 1) |
|
493 |
THEN Auto_tac); |
|
494 |
by (cut_inst_tac [("z1.0","x*ya"), |
|
495 |
("z2.0","xa*y")] pnat_linear_Ex_eq 1); |
|
496 |
by (EVERY1[etac disjE,etac exE]); |
|
497 |
by (eres_inst_tac |
|
498 |
[("x","Abs_prat(ratrel^^{(xb,ya*y)})")] allE 1); |
|
499 |
by (asm_full_simp_tac |
|
500 |
(simpset() addsimps [prat_add, pnat_mult_assoc |
|
501 |
RS sym,pnat_add_mult_distrib RS sym]) 1); |
|
502 |
by (EVERY1[asm_full_simp_tac (simpset() addsimps pnat_mult_ac), |
|
503 |
etac disjE, assume_tac, etac exE]); |
|
504 |
by (thin_tac "!T. Abs_prat (ratrel ^^ {(x, y)}) + T ~= \ |
|
505 |
\ Abs_prat (ratrel ^^ {(xa, ya)})" 1); |
|
506 |
by (eres_inst_tac [("x","Abs_prat(ratrel^^{(xb,y*ya)})")] allE 1); |
|
507 |
by (asm_full_simp_tac (simpset() addsimps [prat_add, |
|
508 |
pnat_mult_assoc RS sym,pnat_add_mult_distrib RS sym]) 1); |
|
509 |
by (asm_full_simp_tac (simpset() addsimps pnat_mult_ac) 1); |
|
510 |
qed "prat_linear"; |
|
511 |
||
512 |
Goal |
|
513 |
"!!(q1::prat). [| q1 < q2 ==> P; q1 = q2 ==> P; \ |
|
514 |
\ q2 < q1 ==> P |] ==> P"; |
|
515 |
by (cut_inst_tac [("q1.0","q1"),("q2.0","q2")] prat_linear 1); |
|
516 |
by Auto_tac; |
|
517 |
qed "prat_linear_less2"; |
|
518 |
||
519 |
(* Gleason p. 120 -- 9-2.6 (iv) *) |
|
520 |
Goal |
|
521 |
"!!(q1::prat). [| q1 < q2; qinv(q1) = qinv(q2) |] ==> P"; |
|
522 |
by (cut_inst_tac [("x","qinv (q2)"),("q1.0","q1"), |
|
523 |
("q2.0","q2")] prat_mult_less2_mono1 1); |
|
524 |
by (assume_tac 1); |
|
525 |
by (Asm_full_simp_tac 1 THEN dtac sym 1); |
|
526 |
by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl])); |
|
527 |
qed "lemma1_qinv_prat_less"; |
|
528 |
||
529 |
Goal |
|
530 |
"!!(q1::prat). [| q1 < q2; qinv(q1) < qinv(q2) |] ==> P"; |
|
531 |
by (cut_inst_tac [("x","qinv (q2)"),("q1.0","q1"), |
|
532 |
("q2.0","q2")] prat_mult_less2_mono1 1); |
|
533 |
by (assume_tac 1); |
|
534 |
by (cut_inst_tac [("x","q1"),("q1.0","qinv (q1)"), |
|
535 |
("q2.0","qinv (q2)")] prat_mult_left_less2_mono1 1); |
|
536 |
by Auto_tac; |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
537 |
by (dres_inst_tac [("q2.0","prat_of_pnat (Abs_pnat 1)")] prat_less_trans 1); |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
538 |
by (auto_tac (claset(),simpset() addsimps |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
539 |
[prat_less_not_refl])); |
5078 | 540 |
qed "lemma2_qinv_prat_less"; |
541 |
||
542 |
Goal |
|
543 |
"!!(q1::prat). q1 < q2 ==> qinv (q2) < qinv (q1)"; |
|
544 |
by (res_inst_tac [("q2.0","qinv q1"), |
|
545 |
("q1.0","qinv q2")] prat_linear_less2 1); |
|
546 |
by (auto_tac (claset() addEs [lemma1_qinv_prat_less, |
|
547 |
lemma2_qinv_prat_less],simpset())); |
|
548 |
qed "qinv_prat_less"; |
|
549 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
550 |
Goal "!!(q1::prat). q1 < prat_of_pnat (Abs_pnat 1) \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
551 |
\ ==> prat_of_pnat (Abs_pnat 1) < qinv(q1)"; |
5078 | 552 |
by (dtac qinv_prat_less 1); |
553 |
by (full_simp_tac (simpset() addsimps [qinv_1]) 1); |
|
554 |
qed "prat_qinv_gt_1"; |
|
555 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
556 |
Goalw [pnat_one_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
557 |
"!!(q1::prat). q1 < prat_of_pnat 1p \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
558 |
\ ==> prat_of_pnat 1p < qinv(q1)"; |
5078 | 559 |
by (etac prat_qinv_gt_1 1); |
560 |
qed "prat_qinv_is_gt_1"; |
|
561 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
562 |
Goalw [prat_less_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
563 |
"prat_of_pnat (Abs_pnat 1) < prat_of_pnat (Abs_pnat 1) \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
564 |
\ + prat_of_pnat (Abs_pnat 1)"; |
5078 | 565 |
by (Fast_tac 1); |
566 |
qed "prat_less_1_2"; |
|
567 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
568 |
Goal "qinv(prat_of_pnat (Abs_pnat 1) + \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
569 |
\ prat_of_pnat (Abs_pnat 1)) < prat_of_pnat (Abs_pnat 1)"; |
5078 | 570 |
by (cut_facts_tac [prat_less_1_2 RS qinv_prat_less] 1); |
571 |
by (asm_full_simp_tac (simpset() addsimps [qinv_1]) 1); |
|
572 |
qed "prat_less_qinv_2_1"; |
|
573 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
574 |
Goal "!!(x::prat). x < y ==> x*qinv(y) < prat_of_pnat (Abs_pnat 1)"; |
5078 | 575 |
by (dres_inst_tac [("x","qinv(y)")] prat_mult_less2_mono1 1); |
576 |
by (Asm_full_simp_tac 1); |
|
577 |
qed "prat_mult_qinv_less_1"; |
|
578 |
||
579 |
Goal "(x::prat) < x + x"; |
|
580 |
by (cut_inst_tac [("x","x")] |
|
581 |
(prat_less_1_2 RS prat_mult_left_less2_mono1) 1); |
|
582 |
by (asm_full_simp_tac (simpset() addsimps |
|
583 |
[prat_add_mult_distrib2]) 1); |
|
584 |
qed "prat_self_less_add_self"; |
|
585 |
||
586 |
Goalw [prat_less_def] "(x::prat) < y + x"; |
|
587 |
by (res_inst_tac [("x","y")] exI 1); |
|
588 |
by (simp_tac (simpset() addsimps [prat_add_commute]) 1); |
|
589 |
qed "prat_self_less_add_right"; |
|
590 |
||
591 |
Goal "(x::prat) < x + y"; |
|
592 |
by (rtac (prat_add_commute RS subst) 1); |
|
593 |
by (simp_tac (simpset() addsimps [prat_self_less_add_right]) 1); |
|
594 |
qed "prat_self_less_add_left"; |
|
595 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
596 |
Goalw [prat_less_def] "prat_of_pnat 1p < y ==> (x::prat) < x * y"; |
5078 | 597 |
by (auto_tac (claset(),simpset() addsimps [pnat_one_def, |
598 |
prat_add_mult_distrib2])); |
|
599 |
qed "prat_self_less_mult_right"; |
|
600 |
||
601 |
(*** Properties of <= ***) |
|
602 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
603 |
Goalw [prat_le_def] "~(w < z) ==> z <= (w::prat)"; |
5078 | 604 |
by (assume_tac 1); |
605 |
qed "prat_leI"; |
|
606 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
607 |
Goalw [prat_le_def] "z<=w ==> ~(w<(z::prat))"; |
5078 | 608 |
by (assume_tac 1); |
609 |
qed "prat_leD"; |
|
610 |
||
611 |
val prat_leE = make_elim prat_leD; |
|
612 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
613 |
Goal "(~(w < z)) = (z <= (w::prat))"; |
5078 | 614 |
by (fast_tac (claset() addSIs [prat_leI,prat_leD]) 1); |
615 |
qed "prat_less_le_iff"; |
|
616 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
617 |
Goalw [prat_le_def] "~ z <= w ==> w<(z::prat)"; |
5078 | 618 |
by (Fast_tac 1); |
619 |
qed "not_prat_leE"; |
|
620 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
621 |
Goalw [prat_le_def] "z < w ==> z <= (w::prat)"; |
5078 | 622 |
by (fast_tac (claset() addEs [prat_less_asym]) 1); |
623 |
qed "prat_less_imp_le"; |
|
624 |
||
625 |
Goalw [prat_le_def] "!!(x::prat). x <= y ==> x < y | x = y"; |
|
626 |
by (cut_facts_tac [prat_linear] 1); |
|
627 |
by (fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym]) 1); |
|
628 |
qed "prat_le_imp_less_or_eq"; |
|
629 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
630 |
Goalw [prat_le_def] "z<w | z=w ==> z <=(w::prat)"; |
5078 | 631 |
by (cut_facts_tac [prat_linear] 1); |
632 |
by (fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym]) 1); |
|
633 |
qed "prat_less_or_eq_imp_le"; |
|
634 |
||
635 |
Goal "(x <= (y::prat)) = (x < y | x=y)"; |
|
636 |
by (REPEAT(ares_tac [iffI, prat_less_or_eq_imp_le, prat_le_imp_less_or_eq] 1)); |
|
637 |
qed "prat_le_eq_less_or_eq"; |
|
638 |
||
639 |
Goal "w <= (w::prat)"; |
|
640 |
by (simp_tac (simpset() addsimps [prat_le_eq_less_or_eq]) 1); |
|
641 |
qed "prat_le_refl"; |
|
642 |
||
643 |
val prems = goal thy "!!i. [| i <= j; j < k |] ==> i < (k::prat)"; |
|
644 |
by (dtac prat_le_imp_less_or_eq 1); |
|
645 |
by (fast_tac (claset() addIs [prat_less_trans]) 1); |
|
646 |
qed "prat_le_less_trans"; |
|
647 |
||
648 |
Goal "!! (i::prat). [| i < j; j <= k |] ==> i < k"; |
|
649 |
by (dtac prat_le_imp_less_or_eq 1); |
|
650 |
by (fast_tac (claset() addIs [prat_less_trans]) 1); |
|
651 |
qed "prat_less_le_trans"; |
|
652 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
653 |
Goal "[| i <= j; j <= k |] ==> i <= (k::prat)"; |
5078 | 654 |
by (EVERY1 [dtac prat_le_imp_less_or_eq, dtac prat_le_imp_less_or_eq, |
655 |
rtac prat_less_or_eq_imp_le, fast_tac (claset() addIs [prat_less_trans])]); |
|
656 |
qed "prat_le_trans"; |
|
657 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
658 |
Goal "[| z <= w; w <= z |] ==> z = (w::prat)"; |
5078 | 659 |
by (EVERY1 [dtac prat_le_imp_less_or_eq, dtac prat_le_imp_less_or_eq, |
660 |
fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym])]); |
|
661 |
qed "prat_le_anti_sym"; |
|
662 |
||
5143
b94cd208f073
Removal of leading "\!\!..." from most Goal commands
paulson
parents:
5078
diff
changeset
|
663 |
Goal "[| ~ y < x; y ~= x |] ==> x < (y::prat)"; |
5078 | 664 |
by (rtac not_prat_leE 1); |
665 |
by (fast_tac (claset() addDs [prat_le_imp_less_or_eq]) 1); |
|
666 |
qed "not_less_not_eq_prat_less"; |
|
667 |
||
668 |
Goalw [prat_less_def] |
|
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
669 |
"[| x1 < y1; x2 < y2 |] ==> x1 + x2 < y1 + (y2::prat)"; |
5078 | 670 |
by (REPEAT(etac exE 1)); |
671 |
by (res_inst_tac [("x","T+Ta")] exI 1); |
|
672 |
by (auto_tac (claset(),simpset() addsimps prat_add_ac)); |
|
673 |
qed "prat_add_less_mono"; |
|
674 |
||
675 |
Goalw [prat_less_def] |
|
5148
74919e8f221c
More tidying and removal of "\!\!... from Goal commands
paulson
parents:
5143
diff
changeset
|
676 |
"[| x1 < y1; x2 < y2 |] ==> x1 * x2 < y1 * (y2::prat)"; |
5078 | 677 |
by (REPEAT(etac exE 1)); |
678 |
by (res_inst_tac [("x","T*Ta+T*x2+x1*Ta")] exI 1); |
|
679 |
by (auto_tac (claset(),simpset() addsimps prat_add_ac @ |
|
680 |
[prat_add_mult_distrib,prat_add_mult_distrib2])); |
|
681 |
qed "prat_mult_less_mono"; |
|
682 |
||
683 |
(* more prat_le *) |
|
684 |
Goal "!!(q1::prat). q1 <= q2 ==> x * q1 <= x * q2"; |
|
685 |
by (dtac prat_le_imp_less_or_eq 1); |
|
686 |
by (Step_tac 1); |
|
687 |
by (auto_tac (claset() addSIs [prat_le_refl, |
|
688 |
prat_less_imp_le,prat_mult_left_less2_mono1],simpset())); |
|
689 |
qed "prat_mult_left_le2_mono1"; |
|
690 |
||
691 |
Goal "!!(q1::prat). q1 <= q2 ==> q1 * x <= q2 * x"; |
|
692 |
by (auto_tac (claset() addDs [prat_mult_left_le2_mono1], |
|
693 |
simpset() addsimps [prat_mult_commute])); |
|
694 |
qed "prat_mult_le2_mono1"; |
|
695 |
||
696 |
Goal |
|
697 |
"!!(q1::prat). q1 <= q2 ==> qinv (q2) <= qinv (q1)"; |
|
698 |
by (dtac prat_le_imp_less_or_eq 1); |
|
699 |
by (Step_tac 1); |
|
700 |
by (auto_tac (claset() addSIs [prat_le_refl, |
|
701 |
prat_less_imp_le,qinv_prat_less],simpset())); |
|
702 |
qed "qinv_prat_le"; |
|
703 |
||
704 |
Goal "!!(q1::prat). q1 <= q2 ==> x + q1 <= x + q2"; |
|
705 |
by (dtac prat_le_imp_less_or_eq 1); |
|
706 |
by (Step_tac 1); |
|
707 |
by (auto_tac (claset() addSIs [prat_le_refl, |
|
708 |
prat_less_imp_le,prat_add_less2_mono1], |
|
709 |
simpset() addsimps [prat_add_commute])); |
|
710 |
qed "prat_add_left_le2_mono1"; |
|
711 |
||
712 |
Goal "!!(q1::prat). q1 <= q2 ==> q1 + x <= q2 + x"; |
|
713 |
by (auto_tac (claset() addDs [prat_add_left_le2_mono1], |
|
714 |
simpset() addsimps [prat_add_commute])); |
|
715 |
qed "prat_add_le2_mono1"; |
|
716 |
||
717 |
Goal "!!k l::prat. [|i<=j; k<=l |] ==> i + k <= j + l"; |
|
718 |
by (etac (prat_add_le2_mono1 RS prat_le_trans) 1); |
|
719 |
by (simp_tac (simpset() addsimps [prat_add_commute]) 1); |
|
720 |
(*j moves to the end because it is free while k, l are bound*) |
|
721 |
by (etac prat_add_le2_mono1 1); |
|
722 |
qed "prat_add_le_mono"; |
|
723 |
||
724 |
Goal "!!(x::prat). x + y < z + y ==> x < z"; |
|
725 |
by (rtac ccontr 1); |
|
726 |
by (etac (prat_leI RS prat_le_imp_less_or_eq RS disjE) 1); |
|
727 |
by (dres_inst_tac [("x","y"),("q1.0","z")] prat_add_less2_mono1 1); |
|
728 |
by (auto_tac (claset() addIs [prat_less_asym], |
|
729 |
simpset() addsimps [prat_less_not_refl])); |
|
730 |
qed "prat_add_right_less_cancel"; |
|
731 |
||
732 |
Goal "!!(x::prat). y + x < y + z ==> x < z"; |
|
733 |
by (res_inst_tac [("y","y")] prat_add_right_less_cancel 1); |
|
734 |
by (asm_full_simp_tac (simpset() addsimps [prat_add_commute]) 1); |
|
735 |
qed "prat_add_left_less_cancel"; |
|
736 |
||
737 |
(*** lemmas required for lemma_gleason9_34 in PReal : w*y > y/z ***) |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
738 |
Goalw [prat_of_pnat_def] |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
739 |
"Abs_prat(ratrel^^{(x,y)}) = (prat_of_pnat x)*qinv(prat_of_pnat y)"; |
5078 | 740 |
by (auto_tac (claset(),simpset() addsimps [prat_mult,qinv,pnat_mult_1_left, |
741 |
pnat_mult_1])); |
|
742 |
qed "Abs_prat_mult_qinv"; |
|
743 |
||
744 |
Goal "Abs_prat(ratrel^^{(x,y)}) <= Abs_prat(ratrel^^{(x,Abs_pnat 1)})"; |
|
745 |
by (simp_tac (simpset() addsimps [Abs_prat_mult_qinv]) 1); |
|
746 |
by (rtac prat_mult_left_le2_mono1 1); |
|
747 |
by (rtac qinv_prat_le 1); |
|
748 |
by (pnat_ind_tac "y" 1); |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
749 |
by (dres_inst_tac [("x","prat_of_pnat (Abs_pnat 1)")] prat_add_le2_mono1 2); |
5078 | 750 |
by (cut_facts_tac [prat_less_1_2 RS prat_less_imp_le] 2); |
751 |
by (auto_tac (claset() addIs [prat_le_trans], |
|
752 |
simpset() addsimps [prat_le_refl, |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
753 |
pSuc_is_plus_one,pnat_one_def,prat_of_pnat_add])); |
5078 | 754 |
qed "lemma_Abs_prat_le1"; |
755 |
||
756 |
Goal "Abs_prat(ratrel^^{(x,Abs_pnat 1)}) <= Abs_prat(ratrel^^{(x*y,Abs_pnat 1)})"; |
|
757 |
by (simp_tac (simpset() addsimps [Abs_prat_mult_qinv]) 1); |
|
758 |
by (rtac prat_mult_le2_mono1 1); |
|
759 |
by (pnat_ind_tac "y" 1); |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
760 |
by (dres_inst_tac [("x","prat_of_pnat x")] prat_add_le2_mono1 2); |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
761 |
by (cut_inst_tac [("z","prat_of_pnat x")] (prat_self_less_add_self |
5078 | 762 |
RS prat_less_imp_le) 2); |
763 |
by (auto_tac (claset() addIs [prat_le_trans], |
|
764 |
simpset() addsimps [prat_le_refl, |
|
765 |
pSuc_is_plus_one,pnat_one_def,prat_add_mult_distrib2, |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
766 |
prat_of_pnat_add,prat_of_pnat_mult])); |
5078 | 767 |
qed "lemma_Abs_prat_le2"; |
768 |
||
769 |
Goal "Abs_prat(ratrel^^{(x,z)}) <= Abs_prat(ratrel^^{(x*y,Abs_pnat 1)})"; |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
770 |
by (fast_tac (claset() addIs [prat_le_trans, |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
771 |
lemma_Abs_prat_le1,lemma_Abs_prat_le2]) 1); |
5078 | 772 |
qed "lemma_Abs_prat_le3"; |
773 |
||
774 |
Goal "Abs_prat(ratrel^^{(x*y,Abs_pnat 1)}) * Abs_prat(ratrel^^{(w,x)}) = \ |
|
775 |
\ Abs_prat(ratrel^^{(w*y,Abs_pnat 1)})"; |
|
776 |
by (full_simp_tac (simpset() addsimps [prat_mult, |
|
777 |
pnat_mult_1,pnat_mult_1_left] @ pnat_mult_ac) 1); |
|
778 |
qed "pre_lemma_gleason9_34"; |
|
779 |
||
780 |
Goal "Abs_prat(ratrel^^{(y*x,Abs_pnat 1*y)}) = \ |
|
781 |
\ Abs_prat(ratrel^^{(x,Abs_pnat 1)})"; |
|
782 |
by (auto_tac (claset(),simpset() addsimps |
|
783 |
[pnat_mult_1,pnat_mult_1_left] @ pnat_mult_ac)); |
|
784 |
qed "pre_lemma_gleason9_34b"; |
|
785 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
786 |
Goal "(prat_of_pnat n < prat_of_pnat m) = (n < m)"; |
5078 | 787 |
by (auto_tac (claset(),simpset() addsimps [prat_less_def, |
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
788 |
pnat_less_iff,prat_of_pnat_add])); |
5078 | 789 |
by (res_inst_tac [("z","T")] eq_Abs_prat 1); |
790 |
by (auto_tac (claset() addDs [pnat_eq_lessI], |
|
791 |
simpset() addsimps [prat_add,pnat_mult_1, |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
792 |
pnat_mult_1_left,prat_of_pnat_def,pnat_less_iff RS sym])); |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
793 |
qed "prat_of_pnat_less_iff"; |
5078 | 794 |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
795 |
Addsimps [prat_of_pnat_less_iff]; |
5078 | 796 |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
797 |
(*------------------------------------------------------------------*) |
5078 | 798 |
|
799 |
(*** prove witness that will be required to prove non-emptiness ***) |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
800 |
(*** of preal type as defined using Dedekind Sections in PReal ***) |
5078 | 801 |
(*** Show that exists positive real `one' ***) |
802 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
803 |
Goal "? q. q: {x::prat. x < prat_of_pnat (Abs_pnat 1)}"; |
5078 | 804 |
by (fast_tac (claset() addIs [prat_less_qinv_2_1]) 1); |
805 |
qed "lemma_prat_less_1_memEx"; |
|
806 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
807 |
Goal "{x::prat. x < prat_of_pnat (Abs_pnat 1)} ~= {}"; |
5078 | 808 |
by (rtac notI 1); |
809 |
by (cut_facts_tac [lemma_prat_less_1_memEx] 1); |
|
810 |
by (Asm_full_simp_tac 1); |
|
811 |
qed "lemma_prat_less_1_set_non_empty"; |
|
812 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
813 |
Goalw [psubset_def] "{} < {x::prat. x < prat_of_pnat (Abs_pnat 1)}"; |
5078 | 814 |
by (asm_full_simp_tac (simpset() addsimps |
815 |
[lemma_prat_less_1_set_non_empty RS not_sym]) 1); |
|
816 |
qed "empty_set_psubset_lemma_prat_less_1_set"; |
|
817 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
818 |
(*** exists rational not in set --- prat_of_pnat (Abs_pnat 1) itself ***) |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
819 |
Goal "? q. q ~: {x::prat. x < prat_of_pnat (Abs_pnat 1)}"; |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
820 |
by (res_inst_tac [("x","prat_of_pnat (Abs_pnat 1)")] exI 1); |
5078 | 821 |
by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl])); |
822 |
qed "lemma_prat_less_1_not_memEx"; |
|
823 |
||
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
824 |
Goal "{x::prat. x < prat_of_pnat (Abs_pnat 1)} ~= {q::prat. True}"; |
5078 | 825 |
by (rtac notI 1); |
826 |
by (cut_facts_tac [lemma_prat_less_1_not_memEx] 1); |
|
827 |
by (Asm_full_simp_tac 1); |
|
828 |
qed "lemma_prat_less_1_set_not_rat_set"; |
|
829 |
||
830 |
Goalw [psubset_def,subset_def] |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
831 |
"{x::prat. x < prat_of_pnat (Abs_pnat 1)} < {q::prat. True}"; |
5078 | 832 |
by (asm_full_simp_tac (simpset() addsimps |
833 |
[lemma_prat_less_1_set_not_rat_set, |
|
834 |
lemma_prat_less_1_not_memEx]) 1); |
|
835 |
qed "lemma_prat_less_1_set_psubset_rat_set"; |
|
836 |
||
837 |
(*** prove non_emptiness of type ***) |
|
7077
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
838 |
Goal "{x::prat. x < prat_of_pnat (Abs_pnat 1)} : {A. {} < A & \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
839 |
\ A < {q::prat. True} & \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
840 |
\ (!y: A. ((!z. z < y --> z: A) & \ |
60b098bb8b8a
heavily revised by Jacques: coercions have alphabetic names;
paulson
parents:
5535
diff
changeset
|
841 |
\ (? u: A. y < u)))}"; |
5078 | 842 |
by (auto_tac (claset() addDs [prat_less_trans], |
843 |
simpset() addsimps [empty_set_psubset_lemma_prat_less_1_set, |
|
844 |
lemma_prat_less_1_set_psubset_rat_set])); |
|
845 |
by (dtac prat_dense 1); |
|
846 |
by (Fast_tac 1); |
|
847 |
qed "preal_1"; |
|
848 |
||
849 |
||
850 |
||
851 |
||
852 |
||
853 |