Installation of target HOL-Real
authorpaulson
Thu Jun 25 13:57:34 1998 +0200 (1998-06-25)
changeset 50787b5ea59c0275
parent 5077 71043526295f
child 5079 2a8ed71f791f
Installation of target HOL-Real
src/HOL/Arith.ML
src/HOL/Induct/ROOT.ML
src/HOL/Integ/Group.ML
src/HOL/Integ/Group.thy
src/HOL/Integ/IntRing.ML
src/HOL/Integ/IntRing.thy
src/HOL/Integ/IntRingDefs.ML
src/HOL/Integ/IntRingDefs.thy
src/HOL/Integ/Lagrange.ML
src/HOL/Integ/Lagrange.thy
src/HOL/Integ/ROOT.ML
src/HOL/Integ/Ring.ML
src/HOL/Integ/Ring.thy
src/HOL/IsaMakefile
src/HOL/ROOT.ML
src/HOL/Real/Lubs.ML
src/HOL/Real/Lubs.thy
src/HOL/Real/PNat.ML
src/HOL/Real/PNat.thy
src/HOL/Real/PRat.ML
src/HOL/Real/PRat.thy
src/HOL/Real/PReal.ML
src/HOL/Real/PReal.thy
src/HOL/Real/RComplete.ML
src/HOL/Real/RComplete.thy
src/HOL/Real/README.html
src/HOL/Real/ROOT.ML
src/HOL/Real/Real.ML
src/HOL/Real/Real.thy
src/HOL/Real/RealAbs.ML
src/HOL/Real/RealAbs.thy
src/HOL/ex/Group.ML
src/HOL/ex/Group.thy
src/HOL/ex/IntRing.ML
src/HOL/ex/IntRing.thy
src/HOL/ex/IntRingDefs.ML
src/HOL/ex/IntRingDefs.thy
src/HOL/ex/Lagrange.ML
src/HOL/ex/Lagrange.thy
src/HOL/ex/Primrec.ML
src/HOL/ex/ROOT.ML
src/HOL/ex/Ring.ML
src/HOL/ex/Ring.thy
     1.1 --- a/src/HOL/Arith.ML	Wed Jun 24 13:59:45 1998 +0200
     1.2 +++ b/src/HOL/Arith.ML	Thu Jun 25 13:57:34 1998 +0200
     1.3 @@ -118,19 +118,16 @@
     1.4  qed "add_pred";
     1.5  Addsimps [add_pred];
     1.6  
     1.7 +Goal "!!m::nat. m + n = m ==> n = 0";
     1.8 +by (dtac (add_0_right RS ssubst) 1);
     1.9 +by (asm_full_simp_tac (simpset() addsimps [add_assoc]
    1.10 +                                 delsimps [add_0_right]) 1);
    1.11 +qed "add_eq_self_zero";
    1.12 +
    1.13  
    1.14  (**** Additional theorems about "less than" ****)
    1.15  
    1.16 -Goal "i<j --> (EX k. j = Suc(i+k))";
    1.17 -by (induct_tac "j" 1);
    1.18 -by (Simp_tac 1);
    1.19 -by (blast_tac (claset() addSEs [less_SucE] 
    1.20 -                       addSIs [add_0_right RS sym, add_Suc_right RS sym]) 1);
    1.21 -val lemma = result();
    1.22 -
    1.23 -(* [| i<j;  !!x. j = Suc(i+x) ==> Q |] ==> Q *)
    1.24 -bind_thm ("less_natE", lemma RS mp RS exE);
    1.25 -
    1.26 +(*Deleted less_natE; instead use less_eq_Suc_add RS exE*)
    1.27  Goal "!!m. m<n --> (? k. n=Suc(m+k))";
    1.28  by (induct_tac "n" 1);
    1.29  by (ALLGOALS (simp_tac (simpset() addsimps [less_Suc_eq])));
    1.30 @@ -442,6 +439,12 @@
    1.31  by (ALLGOALS Asm_simp_tac);
    1.32  qed "less_imp_diff_positive";
    1.33  
    1.34 +Goal "!! (i::nat). i < j  ==> ? k. 0<k & i+k = j";
    1.35 +by (res_inst_tac [("x","j - i")] exI 1);
    1.36 +by (fast_tac (claset() addDs [less_trans, less_irrefl] 
    1.37 +   	               addIs [less_imp_diff_positive, add_diff_inverse]) 1);
    1.38 +qed "less_imp_add_positive";
    1.39 +
    1.40  Goal "Suc(m)-n = (if m<n then 0 else Suc(m-n))";
    1.41  by (simp_tac (simpset() addsimps [less_imp_diff_is_0, not_less_eq, Suc_diff_n]) 1);
    1.42  qed "if_Suc_diff_n";
    1.43 @@ -527,7 +530,7 @@
    1.44  
    1.45  (*strict, in 1st argument; proof is by induction on k>0*)
    1.46  Goal "!!i::nat. [| i<j; 0<k |] ==> k*i < k*j";
    1.47 -by (eres_inst_tac [("i","0")] less_natE 1);
    1.48 +by (eres_inst_tac [("m1","0")] (less_eq_Suc_add RS exE) 1);
    1.49  by (Asm_simp_tac 1);
    1.50  by (induct_tac "x" 1);
    1.51  by (ALLGOALS (asm_simp_tac (simpset() addsimps [add_less_mono])));
     2.1 --- a/src/HOL/Induct/ROOT.ML	Wed Jun 24 13:59:45 1998 +0200
     2.2 +++ b/src/HOL/Induct/ROOT.ML	Thu Jun 25 13:57:34 1998 +0200
     2.3 @@ -3,7 +3,7 @@
     2.4      Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     2.5      Copyright   1997  University of Cambridge
     2.6  
     2.7 -Exampled of Inductive Definitions
     2.8 +Examples of Inductive and Coinductive Definitions
     2.9  *)
    2.10  
    2.11  HOL_build_completed;    (*Make examples fail if HOL did*)
     3.1 --- a/src/HOL/Integ/Group.ML	Wed Jun 24 13:59:45 1998 +0200
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,222 +0,0 @@
     3.4 -(*  Title:      HOL/Integ/Group.ML
     3.5 -    ID:         $Id$
     3.6 -    Author:     Tobias Nipkow
     3.7 -    Copyright   1997 TU Muenchen
     3.8 -*)
     3.9 -
    3.10 -(*** Groups ***)
    3.11 -
    3.12 -(* Derives the well-known convergent set of equations for groups
    3.13 -   based on the unary inverse zero-x.
    3.14 -*)
    3.15 -
    3.16 -Goal "!!x::'a::add_group. (zero-x)+(x+y) = y";
    3.17 -by (rtac trans 1);
    3.18 -by (rtac (plus_assoc RS sym) 1);
    3.19 -by (stac left_inv 1);
    3.20 -by (rtac zeroL 1);
    3.21 -qed "left_inv2";
    3.22 -
    3.23 -Goal "!!x::'a::add_group. (zero-(zero-x)) = x";
    3.24 -by (rtac trans 1);
    3.25 -by (res_inst_tac [("x","zero-x")] left_inv2 2);
    3.26 -by (stac left_inv 1);
    3.27 -by (rtac (zeroR RS sym) 1);
    3.28 -qed "inv_inv";
    3.29 -
    3.30 -Goal "zero-zero = (zero::'a::add_group)";
    3.31 -by (rtac trans 1);
    3.32 -by (rtac (zeroR RS sym) 1);
    3.33 -by (rtac trans 1);
    3.34 -by (res_inst_tac [("x","zero")] left_inv2 2);
    3.35 -by (simp_tac (simpset() addsimps [zeroR]) 1);
    3.36 -qed "inv_zero";
    3.37 -
    3.38 -Goal "!!x::'a::add_group. x+(zero-x) = zero";
    3.39 -by (rtac trans 1);
    3.40 -by (res_inst_tac [("x","zero-x")] left_inv 2);
    3.41 -by (stac inv_inv 1);
    3.42 -by (rtac refl 1);
    3.43 -qed "right_inv";
    3.44 -
    3.45 -Goal "!!x::'a::add_group. x+((zero-x)+y) = y";
    3.46 -by (rtac trans 1);
    3.47 -by (res_inst_tac [("x","zero-x")] left_inv2 2);
    3.48 -by (stac inv_inv 1);
    3.49 -by (rtac refl 1);
    3.50 -qed "right_inv2";
    3.51 -
    3.52 -val plus_cong = read_instantiate [("f1","op +")] (arg_cong RS cong);
    3.53 -
    3.54 -Goal "!!x::'a::add_group. zero-(x+y) = (zero-y)+(zero-x)";
    3.55 -by (rtac trans 1);
    3.56 - by (rtac zeroR 2);
    3.57 -by (rtac trans 1);
    3.58 - by (rtac plus_cong 2);
    3.59 -  by (rtac refl 2);
    3.60 - by (res_inst_tac [("x","x+y")] right_inv 2);
    3.61 -by (rtac trans 1);
    3.62 - by (rtac plus_assoc 2);
    3.63 -by (rtac trans 1);
    3.64 - by (rtac plus_cong 2);
    3.65 -  by (simp_tac (simpset() addsimps
    3.66 -        [plus_assoc,left_inv,left_inv2,right_inv,right_inv2]) 2);
    3.67 - by (rtac refl 2);
    3.68 -by (rtac (zeroL RS sym) 1);
    3.69 -qed "inv_plus";
    3.70 -
    3.71 -(*** convergent TRS for groups with unary inverse zero-x ***)
    3.72 -val group1_simps =
    3.73 -  [zeroL,zeroR,plus_assoc,left_inv,left_inv2,right_inv,right_inv2,inv_inv,
    3.74 -   inv_zero,inv_plus];
    3.75 -
    3.76 -val group1_tac =
    3.77 -  let val ss = HOL_basic_ss addsimps group1_simps
    3.78 -  in simp_tac ss end;
    3.79 -
    3.80 -(* I believe there is no convergent TRS for groups with binary `-',
    3.81 -   unless you have an extra unary `-' and simply define x-y = x+(-y).
    3.82 -   This does not work with only a binary `-' because x-y = x+(zero-y) does
    3.83 -   not terminate. Hence we have a special tactic for converting all
    3.84 -   occurrences of x-y into x+(zero-y):
    3.85 -*)
    3.86 -
    3.87 -local
    3.88 -fun find(Const("op -",Type("fun",[T,_]))$s$t) = [(T,s,t)] @ find s @ find t
    3.89 -  | find(s$t) = find s @ find t
    3.90 -  | find _ = [];
    3.91 -
    3.92 -fun subst_tac sg (tacf,(T,s,t)) = 
    3.93 -  let val typinst = [(("'a",0),ctyp_of sg T)];
    3.94 -      val terminst = [(cterm_of sg (Var(("x",0),T)),cterm_of sg s),
    3.95 -                      (cterm_of sg (Var(("y",0),T)),cterm_of sg t)];
    3.96 -  in tacf THEN' rtac ((instantiate(typinst,terminst) minus_inv) RS ssubst) end;
    3.97 -
    3.98 -in
    3.99 -val mk_group1_tac = SUBGOAL(fn (t,i) => fn st =>
   3.100 -      let val sg = #sign(rep_thm st)
   3.101 -      in foldl (subst_tac sg) (K all_tac,find t) i st
   3.102 -      end)
   3.103 -end;
   3.104 -
   3.105 -(* The following two equations are not used in any of the decision procedures,
   3.106 -   but are still very useful. They also demonstrate mk_group1_tac.
   3.107 -*)
   3.108 -Goal "x-x = (zero::'a::add_group)";
   3.109 -by (mk_group1_tac 1);
   3.110 -by (group1_tac 1);
   3.111 -qed "minus_self_zero";
   3.112 -
   3.113 -Goal "x-zero = (x::'a::add_group)";
   3.114 -by (mk_group1_tac 1);
   3.115 -by (group1_tac 1);
   3.116 -qed "minus_zero";
   3.117 -
   3.118 -(*** Abelian Groups ***)
   3.119 -
   3.120 -Goal "x+(y+z)=y+(x+z::'a::add_agroup)";
   3.121 -by (rtac trans 1);
   3.122 -by (rtac plus_commute 1);
   3.123 -by (rtac trans 1);
   3.124 -by (rtac plus_assoc 1);
   3.125 -by (simp_tac (simpset() addsimps [plus_commute]) 1);
   3.126 -qed "plus_commuteL";
   3.127 -
   3.128 -(* Convergent TRS for Abelian groups with unary inverse zero-x.
   3.129 -   Requires ordered rewriting
   3.130 -*)
   3.131 -
   3.132 -val agroup1_simps = plus_commute::plus_commuteL::group1_simps;
   3.133 -
   3.134 -val agroup1_tac =
   3.135 -  let val ss = HOL_basic_ss addsimps agroup1_simps
   3.136 -  in simp_tac ss end;
   3.137 -
   3.138 -(* Again, I do not believe there is a convergent TRS for Abelian Groups with
   3.139 -   binary `-'. However, we can still decide the word problem using additional
   3.140 -   rules for 
   3.141 -   1. floating `-' to the top:
   3.142 -      "x + (y - z) = (x + y) - (z::'a::add_group)"
   3.143 -      "(x - y) + z = (x + z) - (y::'a::add_agroup)"
   3.144 -      "(x - y) - z = x - (y + (z::'a::add_agroup))"
   3.145 -      "x - (y - z) = (x + z) - (y::'a::add_agroup)"
   3.146 -   2. and for moving `-' over to the other side:
   3.147 -      (x-y = z) = (x = z+y) and (x = y-z) = (x+z = y)
   3.148 -*)
   3.149 -Goal "x + (y - z) = (x + y) - (z::'a::add_group)";
   3.150 -by (mk_group1_tac 1);
   3.151 -by (group1_tac 1);
   3.152 -qed "plus_minusR";
   3.153 -
   3.154 -Goal "(x - y) + z = (x + z) - (y::'a::add_agroup)";
   3.155 -by (mk_group1_tac 1);
   3.156 -by (agroup1_tac 1);
   3.157 -qed "plus_minusL";
   3.158 -
   3.159 -Goal "(x - y) - z = x - (y + (z::'a::add_agroup))";
   3.160 -by (mk_group1_tac 1);
   3.161 -by (agroup1_tac 1);
   3.162 -qed "minus_minusL";
   3.163 -
   3.164 -Goal "x - (y - z) = (x + z) - (y::'a::add_agroup)";
   3.165 -by (mk_group1_tac 1);
   3.166 -by (agroup1_tac 1);
   3.167 -qed "minus_minusR";
   3.168 -
   3.169 -Goal "!!x::'a::add_group. (x-y = z) = (x = z+y)";
   3.170 -by (stac minus_inv 1);
   3.171 -by (fast_tac (claset() addss (HOL_basic_ss addsimps group1_simps)) 1);
   3.172 -qed "minusL_iff";
   3.173 -
   3.174 -Goal "!!x::'a::add_group. (x = y-z) = (x+z = y)";
   3.175 -by (stac minus_inv 1);
   3.176 -by (fast_tac (claset() addss (HOL_basic_ss addsimps group1_simps)) 1);
   3.177 -qed "minusR_iff";
   3.178 -
   3.179 -val agroup2_simps =
   3.180 -  [zeroL,zeroR,plus_assoc,plus_commute,plus_commuteL,
   3.181 -   plus_minusR,plus_minusL,minus_minusL,minus_minusR,minusL_iff,minusR_iff];
   3.182 -
   3.183 -(* This two-phase ordered rewriting tactic works, but agroup_simps are
   3.184 -   simpler. However, agroup_simps is not confluent for arbitrary terms,
   3.185 -   it merely decides equality.
   3.186 -(* Phase 1 *)
   3.187 -
   3.188 -Goal "!!x::'a::add_agroup. (x+(zero-y))+z = (x+z)+(zero-y)";
   3.189 -by (Simp_tac 1);
   3.190 -val lemma = result();
   3.191 -bind_thm("plus_minusL",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
   3.192 -
   3.193 -Goal "!!x::'a::add_agroup. x+(zero-(y+z)) = (x+(zero-y))+(zero-z)";
   3.194 -by (Simp_tac 1);
   3.195 -val lemma = result();
   3.196 -bind_thm("minus_plusR",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
   3.197 -
   3.198 -Goal "!!x::'a::add_agroup. x+(zero-(y+(zero-z))) = (x+z)+(zero-y)";
   3.199 -by (Simp_tac 1);
   3.200 -val lemma = result();
   3.201 -bind_thm("minus_minusR",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
   3.202 -
   3.203 -Goal "!!x::'a::add_agroup. x+(y+(zero-z)) = (x+y)+(zero-z)";
   3.204 -by (Simp_tac 1);
   3.205 -val lemma = result();
   3.206 -bind_thm("plus_minusR",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
   3.207 -
   3.208 -(* Phase 2 *)
   3.209 -
   3.210 -Goal "!!x::'a::add_agroup. (x+y)+(zero-z) = x+(y+(zero-z))";
   3.211 -by (Simp_tac 1);
   3.212 -val lemma = result();
   3.213 -bind_thm("minus_plusL2",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
   3.214 -
   3.215 -Goal "!!x::'a::add_agroup. (x+y)+(zero-x) = y";
   3.216 -by (rtac (plus_assoc RS trans) 1);
   3.217 -by (rtac trans 1);
   3.218 - by (rtac plus_cong 1);
   3.219 -  by (rtac refl 1);
   3.220 - by (rtac right_inv2 2);
   3.221 -by (rtac plus_commute 1);
   3.222 -val lemma = result();
   3.223 -bind_thm("minus_plusL3",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
   3.224 -
   3.225 -*)
     4.1 --- a/src/HOL/Integ/Group.thy	Wed Jun 24 13:59:45 1998 +0200
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,44 +0,0 @@
     4.4 -(*  Title:      HOL/Integ/Group.thy
     4.5 -    ID:         $Id$
     4.6 -    Author:     Tobias Nipkow
     4.7 -    Copyright   1996 TU Muenchen
     4.8 -
     4.9 -A little bit of group theory leading up to rings. Hence groups are additive.
    4.10 -*)
    4.11 -
    4.12 -Group = Set +
    4.13 -
    4.14 -(* 0 already used in Nat *)
    4.15 -axclass  zero < term
    4.16 -consts   zero :: "'a::zero"
    4.17 -
    4.18 -(* additive semigroups *)
    4.19 -
    4.20 -axclass  add_semigroup < plus
    4.21 -  plus_assoc   "(x + y) + z = x + (y + z)"
    4.22 -
    4.23 -
    4.24 -(* additive monoids *)
    4.25 -
    4.26 -axclass  add_monoid < add_semigroup, zero
    4.27 -  zeroL    "zero + x = x"
    4.28 -  zeroR    "x + zero = x"
    4.29 -
    4.30 -(* additive groups *)
    4.31 -(*
    4.32 -The inverse is the binary `-'. Groups with unary and binary inverse are
    4.33 -interdefinable: x-y := x+(zero-y) and -x := zero-x. The law left_inv is
    4.34 -simply the translation of (-x)+x = zero. This characterizes groups already,
    4.35 -provided we only allow (zero-x). Law minus_inv `defines' the general x-y in
    4.36 -terms of the specific zero-y.
    4.37 -*)
    4.38 -axclass  add_group < add_monoid, minus
    4.39 -  left_inv  "(zero-x)+x = zero"
    4.40 -  minus_inv "x-y = x + (zero-y)"
    4.41 -
    4.42 -(* additive abelian groups *)
    4.43 -
    4.44 -axclass  add_agroup < add_group
    4.45 -  plus_commute  "x + y = y + x"
    4.46 -
    4.47 -end
     5.1 --- a/src/HOL/Integ/IntRing.ML	Wed Jun 24 13:59:45 1998 +0200
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,18 +0,0 @@
     5.4 -(*  Title:      HOL/Integ/IntRing.ML
     5.5 -    ID:         $Id$
     5.6 -    Author:     Tobias Nipkow and Markus Wenzel
     5.7 -    Copyright   1996 TU Muenchen
     5.8 -
     5.9 -The instantiation of Lagrange's lemma for int.
    5.10 -*)
    5.11 -
    5.12 -open IntRing;
    5.13 -
    5.14 -Goal "!!i1::int. \
    5.15 -\  (sq i1 + sq i2 + sq i3 + sq i4) * (sq j1 + sq j2 + sq j3 + sq j4) = \
    5.16 -\  sq(i1*j1 - i2*j2 - i3*j3 - i4*j4)  + \
    5.17 -\  sq(i1*j2 + i2*j1 + i3*j4 - i4*j3)  + \
    5.18 -\  sq(i1*j3 - i2*j4 + i3*j1 + i4*j2)  + \
    5.19 -\  sq(i1*j4 + i2*j3 - i3*j2 + i4*j1)";
    5.20 -by (rtac Lagrange_lemma 1);
    5.21 -qed "Lagrange_lemma_int";
     6.1 --- a/src/HOL/Integ/IntRing.thy	Wed Jun 24 13:59:45 1998 +0200
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,19 +0,0 @@
     6.4 -(*  Title:      HOL/Integ/IntRing.thy
     6.5 -    ID:         $Id$
     6.6 -    Author:     Tobias Nipkow and Markus Wenzel
     6.7 -    Copyright   1996 TU Muenchen
     6.8 -
     6.9 -The integers form a commutative ring.
    6.10 -With an application of Lagrange's lemma.
    6.11 -*)
    6.12 -
    6.13 -IntRing = IntRingDefs + Lagrange +
    6.14 -
    6.15 -instance int :: add_semigroup (zadd_assoc)
    6.16 -instance int :: add_monoid (zero_int_def,zadd_0,zadd_0_right)
    6.17 -instance int :: add_group (left_inv_int,minus_inv_int)
    6.18 -instance int :: add_agroup (zadd_commute)
    6.19 -instance int :: ring (zmult_assoc,zadd_zmult_distrib2,zadd_zmult_distrib)
    6.20 -instance int :: cring (zmult_commute)
    6.21 -
    6.22 -end
     7.1 --- a/src/HOL/Integ/IntRingDefs.ML	Wed Jun 24 13:59:45 1998 +0200
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,16 +0,0 @@
     7.4 -(*  Title:      HOL/Integ/IntRingDefs.thy
     7.5 -    ID:         $Id$
     7.6 -    Author:     Tobias Nipkow and Markus Wenzel
     7.7 -    Copyright   1996 TU Muenchen
     7.8 -
     7.9 -*)
    7.10 -
    7.11 -open IntRingDefs;
    7.12 -
    7.13 -Goalw [zero_int_def,zdiff_def] "(zero-x)+(x::int) = zero";
    7.14 -by (Simp_tac 1);
    7.15 -qed "left_inv_int";
    7.16 -
    7.17 -Goalw [zero_int_def,zdiff_def] "x-y = (x::int) + (zero-y)";
    7.18 -by (Simp_tac 1);
    7.19 -qed "minus_inv_int";
     8.1 --- a/src/HOL/Integ/IntRingDefs.thy	Wed Jun 24 13:59:45 1998 +0200
     8.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.3 @@ -1,15 +0,0 @@
     8.4 -(*  Title:      HOL/Integ/IntRingDefs.thy
     8.5 -    ID:         $Id$
     8.6 -    Author:     Tobias Nipkow and Markus Wenzel
     8.7 -    Copyright   1996 TU Muenchen
     8.8 -
     8.9 -Provides the basic defs and thms for showing that int is a commutative ring.
    8.10 -Most of it has been defined and shown already.
    8.11 -*)
    8.12 -
    8.13 -IntRingDefs = Integ + Ring +
    8.14 -
    8.15 -instance int :: zero
    8.16 -defs zero_int_def "zero::int == $# 0"
    8.17 -
    8.18 -end
     9.1 --- a/src/HOL/Integ/Lagrange.ML	Wed Jun 24 13:59:45 1998 +0200
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,37 +0,0 @@
     9.4 -(*  Title:      HOL/Integ/Lagrange.ML
     9.5 -    ID:         $Id$
     9.6 -    Author:     Tobias Nipkow
     9.7 -    Copyright   1996 TU Muenchen
     9.8 -
     9.9 -
    9.10 -The following lemma essentially shows that all composite natural numbers are
    9.11 -sums of fours squares, provided all prime numbers are. However, this is an
    9.12 -abstract thm about commutative rings and has a priori nothing to do with nat.
    9.13 -*)
    9.14 -
    9.15 -Goalw [Lagrange.sq_def] "!!x1::'a::cring. \
    9.16 -\  (sq x1 + sq x2 + sq x3 + sq x4) * (sq y1 + sq y2 + sq y3 + sq y4) = \
    9.17 -\  sq(x1*y1 - x2*y2 - x3*y3 - x4*y4)  + \
    9.18 -\  sq(x1*y2 + x2*y1 + x3*y4 - x4*y3)  + \
    9.19 -\  sq(x1*y3 - x2*y4 + x3*y1 + x4*y2)  + \
    9.20 -\  sq(x1*y4 + x2*y3 - x3*y2 + x4*y1)";
    9.21 -(*Takes up to three minutes...*)
    9.22 -by (cring_tac 1);
    9.23 -qed "Lagrange_lemma";
    9.24 -
    9.25 -(* A challenge by John Harrison.
    9.26 -   Takes forever because of the naive bottom-up strategy of the rewriter.
    9.27 -
    9.28 -Goalw [Lagrange.sq_def] "!!p1::'a::cring.\
    9.29 -\ (sq p1 + sq q1 + sq r1 + sq s1 + sq t1 + sq u1 + sq v1 + sq w1) * \
    9.30 -\ (sq p2 + sq q2 + sq r2 + sq s2 + sq t2 + sq u2 + sq v2 + sq w2) \
    9.31 -\  = sq (p1*p2 - q1*q2 - r1*r2 - s1*s2 - t1*t2 - u1*u2 - v1*v2 - w1*w2) + \
    9.32 -\    sq (p1*q2 + q1*p2 + r1*s2 - s1*r2 + t1*u2 - u1*t2 - v1*w2 + w1*v2) +\
    9.33 -\    sq (p1*r2 - q1*s2 + r1*p2 + s1*q2 + t1*v2 + u1*w2 - v1*t2 - w1*u2) +\
    9.34 -\    sq (p1*s2 + q1*r2 - r1*q2 + s1*p2 + t1*w2 - u1*v2 + v1*u2 - w1*t2) +\
    9.35 -\    sq (p1*t2 - q1*u2 - r1*v2 - s1*w2 + t1*p2 + u1*q2 + v1*r2 + w1*s2) +\
    9.36 -\    sq (p1*u2 + q1*t2 - r1*w2 + s1*v2 - t1*q2 + u1*p2 - v1*s2 + w1*r2) +\
    9.37 -\    sq (p1*v2 + q1*w2 + r1*t2 - s1*u2 - t1*r2 + u1*s2 + v1*p2 - w1*q2) +\
    9.38 -\    sq (p1*w2 - q1*v2 + r1*u2 + s1*t2 - t1*s2 - u1*r2 + v1*q2 + w1*p2)";
    9.39 -
    9.40 -*)
    10.1 --- a/src/HOL/Integ/Lagrange.thy	Wed Jun 24 13:59:45 1998 +0200
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,18 +0,0 @@
    10.4 -(*  Title:      HOL/Integ/Lagrange.thy
    10.5 -    ID:         $Id$
    10.6 -    Author:     Tobias Nipkow
    10.7 -    Copyright   1996 TU Muenchen
    10.8 -
    10.9 -
   10.10 -This theory only contains a single thm, which is a lemma in Lagrange's proof
   10.11 -that every natural number is the sum of 4 squares.  It's sole purpose is to
   10.12 -demonstrate ordered rewriting for commutative rings.
   10.13 -
   10.14 -The enterprising reader might consider proving all of Lagrange's thm.
   10.15 -*)
   10.16 -Lagrange = Ring +
   10.17 -
   10.18 -constdefs sq :: 'a::times => 'a
   10.19 -         "sq x == x*x"
   10.20 -
   10.21 -end
    11.1 --- a/src/HOL/Integ/ROOT.ML	Wed Jun 24 13:59:45 1998 +0200
    11.2 +++ b/src/HOL/Integ/ROOT.ML	Thu Jun 25 13:57:34 1998 +0200
    11.3 @@ -6,7 +6,4 @@
    11.4  The Integers in HOL (ported from ZF by Riccardo Mattolini)
    11.5  *)
    11.6  
    11.7 -HOL_build_completed;    (*Cause examples to fail if HOL did*)
    11.8 -
    11.9  time_use_thy "Bin";
   11.10 -time_use_thy "IntRing";
    12.1 --- a/src/HOL/Integ/Ring.ML	Wed Jun 24 13:59:45 1998 +0200
    12.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.3 @@ -1,139 +0,0 @@
    12.4 -(*  Title:      HOL/Integ/Ring.ML
    12.5 -    ID:         $Id$
    12.6 -    Author:     Tobias Nipkow
    12.7 -    Copyright   1996 TU Muenchen
    12.8 -
    12.9 -Derives a few equational consequences about rings
   12.10 -and defines cring_simpl, a simplification tactic for commutative rings.
   12.11 -*)
   12.12 -
   12.13 -Goal "!!x::'a::cring. x*(y*z)=y*(x*z)";
   12.14 -by (rtac trans 1);
   12.15 -by (rtac times_commute 1);
   12.16 -by (rtac trans 1);
   12.17 -by (rtac times_assoc 1);
   12.18 -by (simp_tac (HOL_basic_ss addsimps [times_commute]) 1);
   12.19 -qed "times_commuteL";
   12.20 -
   12.21 -val times_cong = read_instantiate [("f1","op *")] (arg_cong RS cong);
   12.22 -
   12.23 -Goal "!!x::'a::ring. zero*x = zero";
   12.24 -by (rtac trans 1);
   12.25 - by (rtac right_inv 2);
   12.26 -by (rtac trans 1);
   12.27 - by (rtac plus_cong 2);
   12.28 -  by (rtac refl 3);
   12.29 - by (rtac trans 2);
   12.30 -  by (rtac times_cong 3);
   12.31 -   by (rtac zeroL 3);
   12.32 -  by (rtac refl 3);
   12.33 - by (rtac (distribR RS sym) 2);
   12.34 -by (rtac trans 1);
   12.35 - by (rtac (plus_assoc RS sym) 2);
   12.36 -by (rtac trans 1);
   12.37 - by (rtac plus_cong 2);
   12.38 -  by (rtac refl 2);
   12.39 - by (rtac (right_inv RS sym) 2);
   12.40 -by (rtac (zeroR RS sym) 1);
   12.41 -qed "mult_zeroL";
   12.42 -
   12.43 -Goal "!!x::'a::ring. x*zero = zero";
   12.44 -by (rtac trans 1);
   12.45 - by (rtac right_inv 2);
   12.46 -by (rtac trans 1);
   12.47 - by (rtac plus_cong 2);
   12.48 -  by (rtac refl 3);
   12.49 - by (rtac trans 2);
   12.50 -  by (rtac times_cong 3);
   12.51 -   by (rtac zeroL 4);
   12.52 -  by (rtac refl 3);
   12.53 - by (rtac (distribL RS sym) 2);
   12.54 -by (rtac trans 1);
   12.55 - by (rtac (plus_assoc RS sym) 2);
   12.56 -by (rtac trans 1);
   12.57 - by (rtac plus_cong 2);
   12.58 -  by (rtac refl 2);
   12.59 - by (rtac (right_inv RS sym) 2);
   12.60 -by (rtac (zeroR RS sym) 1);
   12.61 -qed "mult_zeroR";
   12.62 -
   12.63 -Goal "!!x::'a::ring. (zero-x)*y = zero-(x*y)";
   12.64 -by (rtac trans 1);
   12.65 - by (rtac zeroL 2);
   12.66 -by (rtac trans 1);
   12.67 - by (rtac plus_cong 2);
   12.68 -  by (rtac refl 3);
   12.69 - by (rtac mult_zeroL 2);
   12.70 -by (rtac trans 1);
   12.71 - by (rtac plus_cong 2);
   12.72 -  by (rtac refl 3);
   12.73 - by (rtac times_cong 2);
   12.74 -  by (rtac left_inv 2);
   12.75 - by (rtac refl 2);
   12.76 -by (rtac trans 1);
   12.77 - by (rtac plus_cong 2);
   12.78 -  by (rtac refl 3);
   12.79 - by (rtac (distribR RS sym) 2);
   12.80 -by (rtac trans 1);
   12.81 - by (rtac (plus_assoc RS sym) 2);
   12.82 -by (rtac trans 1);
   12.83 - by (rtac plus_cong 2);
   12.84 -  by (rtac refl 2);
   12.85 - by (rtac (right_inv RS sym) 2);
   12.86 -by (rtac (zeroR RS sym) 1);
   12.87 -qed "mult_invL";
   12.88 -
   12.89 -Goal "!!x::'a::ring. x*(zero-y) = zero-(x*y)";
   12.90 -by (rtac trans 1);
   12.91 - by (rtac zeroL 2);
   12.92 -by (rtac trans 1);
   12.93 - by (rtac plus_cong 2);
   12.94 -  by (rtac refl 3);
   12.95 - by (rtac mult_zeroR 2);
   12.96 -by (rtac trans 1);
   12.97 - by (rtac plus_cong 2);
   12.98 -  by (rtac refl 3);
   12.99 - by (rtac times_cong 2);
  12.100 -  by (rtac refl 2);
  12.101 - by (rtac left_inv 2);
  12.102 -by (rtac trans 1);
  12.103 - by (rtac plus_cong 2);
  12.104 -  by (rtac refl 3);
  12.105 - by (rtac (distribL RS sym) 2);
  12.106 -by (rtac trans 1);
  12.107 - by (rtac (plus_assoc RS sym) 2);
  12.108 -by (rtac trans 1);
  12.109 - by (rtac plus_cong 2);
  12.110 -  by (rtac refl 2);
  12.111 - by (rtac (right_inv RS sym) 2);
  12.112 -by (rtac (zeroR RS sym) 1);
  12.113 -qed "mult_invR";
  12.114 -
  12.115 -Goal "x*(y-z) = (x*y - x*z::'a::ring)";
  12.116 -by (mk_group1_tac 1);
  12.117 -by (simp_tac (HOL_basic_ss addsimps [distribL,mult_invR]) 1);
  12.118 -qed "minus_distribL";
  12.119 -
  12.120 -Goal "(x-y)*z = (x*z - y*z::'a::ring)";
  12.121 -by (mk_group1_tac 1);
  12.122 -by (simp_tac (HOL_basic_ss addsimps [distribR,mult_invL]) 1);
  12.123 -qed "minus_distribR";
  12.124 -
  12.125 -val cring_simps = [times_assoc,times_commute,times_commuteL,
  12.126 -                   distribL,distribR,minus_distribL,minus_distribR]
  12.127 -                  @ agroup2_simps;
  12.128 -
  12.129 -val cring_tac =
  12.130 -  let val ss = HOL_basic_ss addsimps cring_simps
  12.131 -  in simp_tac ss end;
  12.132 -
  12.133 -
  12.134 -(*** The order [minus_plusL3,minus_plusL2] is important because minus_plusL3
  12.135 -     MUST be tried first
  12.136 -val cring_simp =
  12.137 -  let val phase1 = simpset() addsimps
  12.138 -                   [plus_minusL,minus_plusR,minus_minusR,plus_minusR]
  12.139 -      val phase2 = HOL_ss addsimps [minus_plusL3,minus_plusL2,
  12.140 -                                    zeroL,zeroR,mult_zeroL,mult_zeroR]
  12.141 -  in simp_tac phase1 THEN' simp_tac phase2 end;
  12.142 -***)
    13.1 --- a/src/HOL/Integ/Ring.thy	Wed Jun 24 13:59:45 1998 +0200
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,24 +0,0 @@
    13.4 -(*  Title:      HOL/Integ/Ring.thy
    13.5 -    ID:         $Id$
    13.6 -    Author:     Tobias Nipkow
    13.7 -    Copyright   1996 TU Muenchen
    13.8 -
    13.9 -Bits of rings.
   13.10 -Main output: a simplification tactic for commutative rings.
   13.11 -*)
   13.12 -
   13.13 -Ring = Group +
   13.14 -
   13.15 -(* Ring *)
   13.16 -
   13.17 -axclass  ring < add_agroup, times
   13.18 -  times_assoc "(x*y)*z = x*(y*z)"
   13.19 -  distribL    "x*(y+z) = x*y + x*z"
   13.20 -  distribR    "(x+y)*z = x*z + y*z"
   13.21 -
   13.22 -(* Commutative ring *)
   13.23 -
   13.24 -axclass cring < ring
   13.25 -  times_commute "x*y = y*x"
   13.26 -
   13.27 -end
    14.1 --- a/src/HOL/IsaMakefile	Wed Jun 24 13:59:45 1998 +0200
    14.2 +++ b/src/HOL/IsaMakefile	Thu Jun 25 13:57:34 1998 +0200
    14.3 @@ -8,7 +8,7 @@
    14.4  
    14.5  default: HOL
    14.6  images: HOL TLA
    14.7 -test: HOL-Subst HOL-Induct HOL-IMP HOL-Hoare HOL-Lex HOL-Integ \
    14.8 +test: HOL-Subst HOL-Induct HOL-IMP HOL-Hoare HOL-Lex HOL-Real \
    14.9    HOL-Auth HOL-UNITY HOL-Modelcheck HOL-Lambda HOL-W0 HOL-MiniML HOL-IOA \
   14.10    HOL-AxClasses HOL-AxClasses-Group HOL-AxClasses-Lattice \
   14.11    HOL-AxClasses-Tutorial HOL-Quot HOL-ex TLA-Inc TLA-Buffer TLA-Memory
   14.12 @@ -39,6 +39,8 @@
   14.13    $(SRC)/TFL/tfl.sml $(SRC)/TFL/thms.sig $(SRC)/TFL/thms.sml \
   14.14    $(SRC)/TFL/thry.sig $(SRC)/TFL/thry.sml $(SRC)/TFL/usyntax.sig \
   14.15    $(SRC)/TFL/usyntax.sml $(SRC)/TFL/utils.sig $(SRC)/TFL/utils.sml \
   14.16 +  Integ/Bin.ML Integ/Bin.thy  Integ/Equiv.ML Integ/Equiv.thy \
   14.17 +  Integ/Integ.ML Integ/Integ.thy Integ/ROOT.ML \
   14.18    Arith.ML Arith.thy Divides.ML Divides.thy Finite.ML Finite.thy \
   14.19    Fun.ML Fun.thy Gfp.ML Gfp.thy HOL.ML HOL.thy Inductive.ML \
   14.20    Inductive.thy Lfp.ML Lfp.thy List.ML List.thy Map.ML Map.thy Nat.ML \
   14.21 @@ -117,16 +119,16 @@
   14.22  	@$(ISATOOL) usedir $(OUT)/HOL Lex
   14.23  
   14.24  
   14.25 -## HOL-Integ
   14.26 +## HOL-Real
   14.27  
   14.28 -HOL-Integ: HOL $(LOG)/HOL-Integ.gz
   14.29 +HOL-Real: HOL $(LOG)/HOL-Real.gz
   14.30  
   14.31 -$(LOG)/HOL-Integ.gz: $(OUT)/HOL Integ/Bin.ML Integ/Bin.thy \
   14.32 -  Integ/Equiv.ML Integ/Equiv.thy Integ/Group.ML Integ/Group.thy \
   14.33 -  Integ/IntRing.ML Integ/IntRing.thy Integ/IntRingDefs.ML \
   14.34 -  Integ/IntRingDefs.thy Integ/Integ.ML Integ/Integ.thy Integ/Lagrange.ML \
   14.35 -  Integ/Lagrange.thy Integ/ROOT.ML Integ/Ring.ML Integ/Ring.thy
   14.36 -	@$(ISATOOL) usedir $(OUT)/HOL Integ
   14.37 +$(LOG)/HOL-Real.gz: $(OUT)/HOL \
   14.38 +  Real/Lubs.ML Real/Lubs.thy Real/PNat.ML Real/PNat.thy \
   14.39 +  Real/PRat.ML Real/PRat.thy Real/PReal.ML Real/PReal.thy \
   14.40 +  Real/RComplete.ML Real/RComplete.thy Real/Real.ML Real/Real.thy \
   14.41 +  Real/RealAbs.ML Real/RealAbs.thy Real/ROOT.ML
   14.42 +	@$(ISATOOL) usedir $(OUT)/HOL Real
   14.43  
   14.44  
   14.45  ## HOL-Auth
   14.46 @@ -282,7 +284,10 @@
   14.47    ex/NatSum.thy ex/Primes.ML ex/Primes.thy ex/Primrec.ML ex/Primrec.thy \
   14.48    ex/Puzzle.ML ex/Puzzle.thy ex/Qsort.ML ex/Qsort.thy ex/ROOT.ML \
   14.49    ex/Recdef.ML ex/Recdef.thy ex/String.ML ex/String.thy ex/cla.ML \
   14.50 -  ex/meson.ML ex/mesontest.ML ex/set.ML
   14.51 +  ex/meson.ML ex/mesontest.ML ex/set.ML \
   14.52 +  ex/Group.ML ex/Group.thy  ex/IntRing.ML ex/IntRing.thy \
   14.53 +  ex/IntRingDefs.ML ex/IntRingDefs.thy \
   14.54 +  ex/Lagrange.ML ex/Lagrange.thy ex/Ring.ML ex/Ring.thy
   14.55  	@$(ISATOOL) usedir $(OUT)/HOL ex
   14.56  
   14.57  
   14.58 @@ -336,8 +341,7 @@
   14.59  clean:
   14.60  	@rm -f $(OUT)/HOL $(LOG)/HOL.gz $(LOG)/HOL-Subst.gz \
   14.61  	  $(LOG)/HOL-Induct.gz $(LOG)/HOL-IMP.gz $(LOG)/HOL-Hoare.gz \
   14.62 -	  $(LOG)/HOL-Lex.gz $(LOG)/HOL-Integ.gz \
   14.63 -	  $(LOG)/HOL-Auth.gz $(LOG)/HOL-UNITY.gz \
   14.64 +	  $(LOG)/HOL-Lex.gz $(LOG)/HOL-Auth.gz $(LOG)/HOL-UNITY.gz \
   14.65  	  $(LOG)/HOL-Modelcheck.gz $(LOG)/HOL-Lambda.gz $(LOG)/HOL-W0.gz \
   14.66  	  $(LOG)/HOL-MiniML.gz $(LOG)/HOL-IOA.gz $(LOG)/HOL-AxClasses.gz \
   14.67  	  $(LOG)/HOL-AxClasses-Group.gz $(LOG)/HOL-AxClasses-Lattice.gz \
    15.1 --- a/src/HOL/ROOT.ML	Wed Jun 24 13:59:45 1998 +0200
    15.2 +++ b/src/HOL/ROOT.ML	Thu Jun 25 13:57:34 1998 +0200
    15.3 @@ -59,9 +59,12 @@
    15.4  use_thy "Map";
    15.5  use_thy "Update";
    15.6  
    15.7 +use_dir "Integ";
    15.8 +
    15.9  (*TFL: recursive function definitions*)
   15.10  cd "$ISABELLE_HOME/src/TFL";
   15.11  use "sys.sml";
   15.12 +cd "$ISABELLE_HOME/src/HOL";
   15.13  
   15.14  print_depth 8;
   15.15  
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/HOL/Real/Lubs.ML	Thu Jun 25 13:57:34 1998 +0200
    16.3 @@ -0,0 +1,101 @@
    16.4 +(*  Title       : Lubs.ML
    16.5 +    Author      : Jacques D. Fleuriot
    16.6 +    Copyright   : 1998  University of Cambridge
    16.7 +    Description : Completeness of the reals. A few of the 
    16.8 +                  definitions suggested by James Margetson
    16.9 +*) 
   16.10 +
   16.11 +open Lubs;
   16.12 +
   16.13 +(*------------------------------------------------------------------------
   16.14 +                        Rules for *<= and <=*
   16.15 + ------------------------------------------------------------------------*)
   16.16 +Goalw [setle_def] "!!x. ALL y: S. y <= x ==> S *<= x";
   16.17 +by (assume_tac 1);
   16.18 +qed "setleI";
   16.19 +
   16.20 +Goalw [setle_def] "!!x. [| S *<= x; y: S |] ==> y <= x";
   16.21 +by (Fast_tac 1);
   16.22 +qed "setleD";
   16.23 +
   16.24 +Goalw [setge_def] "!!x. ALL y: S. x<= y ==> x <=* S";
   16.25 +by (assume_tac 1);
   16.26 +qed "setgeI";
   16.27 +
   16.28 +Goalw [setge_def] "!!x. [| x <=* S; y: S |] ==> x <= y";
   16.29 +by (Fast_tac 1);
   16.30 +qed "setgeD";
   16.31 +
   16.32 +(*------------------------------------------------------------------------
   16.33 +                        Rules about leastP, ub and lub
   16.34 + ------------------------------------------------------------------------*)
   16.35 +Goalw [leastP_def] "!!x. leastP P x ==> P x";
   16.36 +by (Step_tac 1);
   16.37 +qed "leastPD1";
   16.38 +
   16.39 +Goalw [leastP_def] "!!x. leastP P x ==> x <=* Collect P";
   16.40 +by (Step_tac 1);
   16.41 +qed "leastPD2";
   16.42 +
   16.43 +Goal "!!x. [| leastP P x; y: Collect P |] ==> x <= y";
   16.44 +by (blast_tac (claset() addSDs [leastPD2,setgeD]) 1);
   16.45 +qed "leastPD3";
   16.46 +
   16.47 +Goalw [isLub_def,isUb_def,leastP_def] 
   16.48 +      "!!x. isLub R S x ==> S *<= x";
   16.49 +by (Step_tac 1);
   16.50 +qed "isLubD1";
   16.51 +
   16.52 +Goalw [isLub_def,isUb_def,leastP_def] 
   16.53 +      "!!x. isLub R S x ==> x: R";
   16.54 +by (Step_tac 1);
   16.55 +qed "isLubD1a";
   16.56 +
   16.57 +Goalw [isUb_def] "!!x. isLub R S x ==> isUb R S x";
   16.58 +by (blast_tac (claset() addDs [isLubD1,isLubD1a]) 1);
   16.59 +qed "isLub_isUb";
   16.60 +
   16.61 +Goal "!!x. [| isLub R S x; y : S |] ==> y <= x";
   16.62 +by (blast_tac (claset() addSDs [isLubD1,setleD]) 1);
   16.63 +qed "isLubD2";
   16.64 +
   16.65 +Goalw [isLub_def] "!!x. isLub R S x ==> leastP(isUb R S) x";
   16.66 +by (assume_tac 1);
   16.67 +qed "isLubD3";
   16.68 +
   16.69 +Goalw [isLub_def] "!!x. leastP(isUb R S) x ==> isLub R S x";
   16.70 +by (assume_tac 1);
   16.71 +qed "isLubI1";
   16.72 +
   16.73 +Goalw [isLub_def,leastP_def] 
   16.74 +      "!!x. [| isUb R S x; x <=* Collect (isUb R S) |] ==> isLub R S x";
   16.75 +by (Step_tac 1);
   16.76 +qed "isLubI2";
   16.77 +
   16.78 +Goalw [isUb_def] "!!x. [| isUb R S x; y : S |] ==> y <= x";
   16.79 +by (fast_tac (claset() addDs [setleD]) 1);
   16.80 +qed "isUbD";
   16.81 +
   16.82 +Goalw [isUb_def] "!!x. isUb R S x ==> S *<= x";
   16.83 +by (Step_tac 1);
   16.84 +qed "isUbD2";
   16.85 +
   16.86 +Goalw [isUb_def] "!!x. isUb R S x ==> x: R";
   16.87 +by (Step_tac 1);
   16.88 +qed "isUbD2a";
   16.89 +
   16.90 +Goalw [isUb_def] "!!x. [| S *<= x; x: R |] ==> isUb R S x";
   16.91 +by (Step_tac 1);
   16.92 +qed "isUbI";
   16.93 +
   16.94 +Goalw [isLub_def] "!!x. [| isLub R S x; isUb R S y |] ==> x <= y";
   16.95 +by (blast_tac (claset() addSIs [leastPD3]) 1);
   16.96 +qed "isLub_le_isUb";
   16.97 +
   16.98 +Goalw [ubs_def,isLub_def] "!!x. isLub R S x ==> x <=* ubs R S";
   16.99 +by (etac leastPD2 1);
  16.100 +qed "isLub_ubs";
  16.101 +
  16.102 +
  16.103 +
  16.104 +
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/HOL/Real/Lubs.thy	Thu Jun 25 13:57:34 1998 +0200
    17.3 @@ -0,0 +1,38 @@
    17.4 +(*  Title       : Lubs.thy
    17.5 +    Author      : Jacques D. Fleuriot
    17.6 +    Copyright   : 1998  University of Cambridge
    17.7 +    Description : Upper bounds, lubs definitions
    17.8 +                  suggested by James Margetson
    17.9 +*) 
   17.10 +
   17.11 +
   17.12 +Lubs = Set +
   17.13 +
   17.14 +consts
   17.15 +    
   17.16 +    "*<=" :: ['a set, 'a] => bool     (infixl 70)
   17.17 +    "<=*" :: ['a, 'a set] => bool     (infixl 70)
   17.18 +
   17.19 +constdefs
   17.20 +    leastP      :: ['a =>bool,'a] => bool
   17.21 +    "leastP P x == (P x & x <=* Collect P)"
   17.22 +
   17.23 +    isLub       :: ['a set, 'a set, 'a] => bool    
   17.24 +    "isLub R S x  == leastP (isUb R S) x"
   17.25 +
   17.26 +    isUb        :: ['a set, 'a set, 'a] => bool     
   17.27 +    "isUb R S x   == S *<= x & x: R"
   17.28 +
   17.29 +    ubs         :: ['a set, 'a set] => 'a set
   17.30 +    "ubs R S      == Collect (isUb R S)"
   17.31 +
   17.32 +defs
   17.33 +    setle_def
   17.34 +    "S *<= x    == (ALL y: S. y <= x)"
   17.35 +
   17.36 +    setge_def
   17.37 +    "x <=* S    == (ALL y: S. x <= y)"
   17.38 +
   17.39 +end                    
   17.40 +
   17.41 +    
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/HOL/Real/PNat.ML	Thu Jun 25 13:57:34 1998 +0200
    18.3 @@ -0,0 +1,723 @@
    18.4 +(*  Title       : PNat.ML
    18.5 +    Author      : Jacques D. Fleuriot
    18.6 +    Copyright   : 1998  University of Cambridge
    18.7 +    Description : The positive naturals -- proofs 
    18.8 +                : mainly as in Nat.thy
    18.9 +*)
   18.10 +
   18.11 +open PNat;
   18.12 +
   18.13 +Goal "mono(%X. {1} Un (Suc``X))";
   18.14 +by (REPEAT (ares_tac [monoI, subset_refl, image_mono, Un_mono] 1));
   18.15 +qed "pnat_fun_mono";
   18.16 +
   18.17 +val pnat_unfold = pnat_fun_mono RS (pnat_def RS def_lfp_Tarski);
   18.18 +
   18.19 +Goal "1 : pnat";
   18.20 +by (stac pnat_unfold 1);
   18.21 +by (rtac (singletonI RS UnI1) 1);
   18.22 +qed "one_RepI";
   18.23 +
   18.24 +Addsimps [one_RepI];
   18.25 +
   18.26 +Goal "i: pnat ==> Suc(i) : pnat";
   18.27 +by (stac pnat_unfold 1);
   18.28 +by (etac (imageI RS UnI2) 1);
   18.29 +qed "pnat_Suc_RepI";
   18.30 +
   18.31 +Goal "2 : pnat";
   18.32 +by (rtac (one_RepI RS pnat_Suc_RepI) 1);
   18.33 +qed "two_RepI";
   18.34 +
   18.35 +(*** Induction ***)
   18.36 +
   18.37 +val major::prems = goal thy
   18.38 +    "[| i: pnat;  P(1);   \
   18.39 +\       !!j. [| j: pnat; P(j) |] ==> P(Suc(j)) |]  ==> P(i)";
   18.40 +by (rtac ([pnat_def, pnat_fun_mono, major] MRS def_induct) 1);
   18.41 +by (blast_tac (claset() addIs prems) 1);
   18.42 +qed "PNat_induct";
   18.43 +
   18.44 +val prems = goalw thy [pnat_one_def,pnat_Suc_def]
   18.45 +    "[| P(1p);   \
   18.46 +\       !!n. P(n) ==> P(pSuc n) |]  ==> P(n)";
   18.47 +by (rtac (Rep_pnat_inverse RS subst) 1);   
   18.48 +by (rtac (Rep_pnat RS PNat_induct) 1);
   18.49 +by (REPEAT (ares_tac prems 1
   18.50 +     ORELSE eresolve_tac [Abs_pnat_inverse RS subst] 1));
   18.51 +qed "pnat_induct";
   18.52 +
   18.53 +(*Perform induction on n. *)
   18.54 +local fun raw_pnat_ind_tac a i = 
   18.55 +    res_inst_tac [("n",a)] pnat_induct i  THEN  rename_last_tac a [""] (i+1)
   18.56 +in
   18.57 +val pnat_ind_tac = Datatype.occs_in_prems raw_pnat_ind_tac
   18.58 +end;
   18.59 +
   18.60 +val prems = goal thy
   18.61 +    "[| !!x. P x 1p;  \
   18.62 +\       !!y. P 1p (pSuc y);  \
   18.63 +\       !!x y. [| P x y |] ==> P (pSuc x) (pSuc y)  \
   18.64 +\    |] ==> P m n";
   18.65 +by (res_inst_tac [("x","m")] spec 1);
   18.66 +by (pnat_ind_tac "n" 1);
   18.67 +by (rtac allI 2);
   18.68 +by (pnat_ind_tac "x" 2);
   18.69 +by (REPEAT (ares_tac (prems@[allI]) 1 ORELSE etac spec 1));
   18.70 +qed "pnat_diff_induct";
   18.71 +
   18.72 +(*Case analysis on the natural numbers*)
   18.73 +val prems = goal thy 
   18.74 +    "[| n=1p ==> P;  !!x. n = pSuc(x) ==> P |] ==> P";
   18.75 +by (subgoal_tac "n=1p | (EX x. n = pSuc(x))" 1);
   18.76 +by (fast_tac (claset() addSEs prems) 1);
   18.77 +by (pnat_ind_tac "n" 1);
   18.78 +by (rtac (refl RS disjI1) 1);
   18.79 +by (Blast_tac 1);
   18.80 +qed "pnatE";
   18.81 +
   18.82 +(*** Isomorphisms: Abs_Nat and Rep_Nat ***)
   18.83 +
   18.84 +Goal "inj_on Abs_pnat pnat";
   18.85 +by (rtac inj_on_inverseI 1);
   18.86 +by (etac Abs_pnat_inverse 1);
   18.87 +qed "inj_on_Abs_pnat";
   18.88 +
   18.89 +Addsimps [inj_on_Abs_pnat RS inj_on_iff];
   18.90 +
   18.91 +Goal "inj(Rep_pnat)";
   18.92 +by (rtac inj_inverseI 1);
   18.93 +by (rtac Rep_pnat_inverse 1);
   18.94 +qed "inj_Rep_pnat";
   18.95 +
   18.96 +bind_thm ("Zero_not_Suc", Suc_not_Zero RS not_sym);
   18.97 +
   18.98 +Goal "0 ~: pnat";
   18.99 +by (stac pnat_unfold 1);
  18.100 +by Auto_tac;
  18.101 +qed "zero_not_mem_pnat";
  18.102 +
  18.103 +(* 0 : pnat ==> P *)
  18.104 +bind_thm ("zero_not_mem_pnatE", zero_not_mem_pnat RS notE);
  18.105 +
  18.106 +Addsimps [zero_not_mem_pnat];
  18.107 +
  18.108 +Goal "!!x. x : pnat ==> 0 < x";
  18.109 +by (dtac (pnat_unfold RS subst) 1);
  18.110 +by Auto_tac;
  18.111 +qed "mem_pnat_gt_zero";
  18.112 +
  18.113 +Goal "!!x. 0 < x ==> x: pnat";
  18.114 +by (stac pnat_unfold 1);
  18.115 +by (dtac (gr_implies_not0 RS not0_implies_Suc) 1); 
  18.116 +by (etac exE 1 THEN Asm_simp_tac 1);
  18.117 +by (induct_tac "m" 1);
  18.118 +by (auto_tac (claset(),simpset() 
  18.119 +    addsimps [one_RepI]) THEN dtac pnat_Suc_RepI 1);
  18.120 +by (Blast_tac 1);
  18.121 +qed "gt_0_mem_pnat";
  18.122 +
  18.123 +Goal "(x: pnat) = (0 < x)";
  18.124 +by (blast_tac (claset() addDs [mem_pnat_gt_zero,gt_0_mem_pnat]) 1);
  18.125 +qed "mem_pnat_gt_0_iff";
  18.126 +
  18.127 +Goal "0 < Rep_pnat x";
  18.128 +by (rtac (Rep_pnat RS mem_pnat_gt_zero) 1);
  18.129 +qed "Rep_pnat_gt_zero";
  18.130 +
  18.131 +Goalw [pnat_add_def] "(x::pnat) + y = y + x";
  18.132 +by (simp_tac (simpset() addsimps [add_commute]) 1);
  18.133 +qed "pnat_add_commute";
  18.134 +
  18.135 +(** alternative definition for pnat **)
  18.136 +(** order isomorphism **)
  18.137 +Goal "pnat = {x::nat. 0 < x}";
  18.138 +by (rtac set_ext 1);
  18.139 +by (simp_tac (simpset() addsimps 
  18.140 +    [mem_pnat_gt_0_iff]) 1);
  18.141 +qed "Collect_pnat_gt_0";
  18.142 +
  18.143 +(*** Distinctness of constructors ***)
  18.144 +
  18.145 +Goalw [pnat_one_def,pnat_Suc_def] "pSuc(m) ~= 1p";
  18.146 +by (rtac (inj_on_Abs_pnat RS inj_on_contraD) 1);
  18.147 +by (rtac (Rep_pnat_gt_zero RS Suc_mono RS less_not_refl2) 1);
  18.148 +by (REPEAT (resolve_tac [Rep_pnat RS  pnat_Suc_RepI, one_RepI] 1));
  18.149 +qed "pSuc_not_one";
  18.150 +
  18.151 +bind_thm ("one_not_pSuc", pSuc_not_one RS not_sym);
  18.152 +
  18.153 +AddIffs [pSuc_not_one,one_not_pSuc];
  18.154 +
  18.155 +bind_thm ("pSuc_neq_one", (pSuc_not_one RS notE));
  18.156 +val one_neq_pSuc = sym RS pSuc_neq_one;
  18.157 +
  18.158 +(** Injectiveness of pSuc **)
  18.159 +
  18.160 +Goalw [pnat_Suc_def] "inj(pSuc)";
  18.161 +by (rtac injI 1);
  18.162 +by (dtac (inj_on_Abs_pnat RS inj_onD) 1);
  18.163 +by (REPEAT (resolve_tac [Rep_pnat, pnat_Suc_RepI] 1));
  18.164 +by (dtac (inj_Suc RS injD) 1);
  18.165 +by (etac (inj_Rep_pnat RS injD) 1);
  18.166 +qed "inj_pSuc"; 
  18.167 +
  18.168 +val pSuc_inject = inj_pSuc RS injD;
  18.169 +
  18.170 +Goal "(pSuc(m)=pSuc(n)) = (m=n)";
  18.171 +by (EVERY1 [rtac iffI, etac pSuc_inject, etac arg_cong]); 
  18.172 +qed "pSuc_pSuc_eq";
  18.173 +
  18.174 +AddIffs [pSuc_pSuc_eq];
  18.175 +
  18.176 +Goal "n ~= pSuc(n)";
  18.177 +by (pnat_ind_tac "n" 1);
  18.178 +by (ALLGOALS Asm_simp_tac);
  18.179 +qed "n_not_pSuc_n";
  18.180 +
  18.181 +bind_thm ("pSuc_n_not_n", n_not_pSuc_n RS not_sym);
  18.182 +
  18.183 +Goal "!!n. n ~= 1p ==> EX m. n = pSuc m";
  18.184 +by (rtac pnatE 1);
  18.185 +by (REPEAT (Blast_tac 1));
  18.186 +qed "not1p_implies_pSuc";
  18.187 +
  18.188 +Goal "pSuc m = m + 1p";
  18.189 +by (auto_tac (claset(),simpset() addsimps [pnat_Suc_def,
  18.190 +    pnat_one_def,Abs_pnat_inverse,pnat_add_def]));
  18.191 +qed "pSuc_is_plus_one";
  18.192 +
  18.193 +Goal
  18.194 +      "(Rep_pnat x + Rep_pnat y): pnat";
  18.195 +by (cut_facts_tac [[Rep_pnat_gt_zero,
  18.196 +    Rep_pnat_gt_zero] MRS add_less_mono,Collect_pnat_gt_0] 1);
  18.197 +by (etac ssubst 1);
  18.198 +by Auto_tac;
  18.199 +qed "sum_Rep_pnat";
  18.200 +
  18.201 +Goalw [pnat_add_def] 
  18.202 +      "Rep_pnat x + Rep_pnat y = Rep_pnat (x + y)";
  18.203 +by (simp_tac (simpset() addsimps [sum_Rep_pnat RS 
  18.204 +                          Abs_pnat_inverse]) 1);
  18.205 +qed "sum_Rep_pnat_sum";
  18.206 +
  18.207 +Goalw [pnat_add_def] 
  18.208 +      "(x + y) + z = x + (y + (z::pnat))";
  18.209 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.210 +by (simp_tac (simpset() addsimps [sum_Rep_pnat RS 
  18.211 +                Abs_pnat_inverse,add_assoc]) 1);
  18.212 +qed "pnat_add_assoc";
  18.213 +
  18.214 +Goalw [pnat_add_def] "x + (y + z) = y + (x + (z::pnat))";
  18.215 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.216 +by (simp_tac (simpset() addsimps [sum_Rep_pnat RS 
  18.217 +          Abs_pnat_inverse,add_left_commute]) 1);
  18.218 +qed "pnat_add_left_commute";
  18.219 +
  18.220 +(*Addition is an AC-operator*)
  18.221 +val pnat_add_ac = [pnat_add_assoc, pnat_add_commute, pnat_add_left_commute];
  18.222 +
  18.223 +Goalw [pnat_add_def] "((x::pnat) + y = x + z) = (y = z)";
  18.224 +by (auto_tac (claset() addDs [(inj_on_Abs_pnat RS inj_onD),
  18.225 +     inj_Rep_pnat RS injD],simpset() addsimps [sum_Rep_pnat]));
  18.226 +qed "pnat_add_left_cancel";
  18.227 +
  18.228 +Goalw [pnat_add_def] "(y + (x::pnat) = z + x) = (y = z)";
  18.229 +by (auto_tac (claset() addDs [(inj_on_Abs_pnat RS inj_onD),
  18.230 +     inj_Rep_pnat RS injD],simpset() addsimps [sum_Rep_pnat]));
  18.231 +qed "pnat_add_right_cancel";
  18.232 +
  18.233 +Goalw [pnat_add_def] "!(y::pnat). x + y ~= x";
  18.234 +by (rtac (Rep_pnat_inverse RS subst) 1);
  18.235 +by (auto_tac (claset() addDs [(inj_on_Abs_pnat RS inj_onD)] 
  18.236 +  	               addSDs [add_eq_self_zero],
  18.237 +	      simpset() addsimps [sum_Rep_pnat, Rep_pnat,Abs_pnat_inverse,
  18.238 +				  Rep_pnat_gt_zero RS less_not_refl2]));
  18.239 +qed "pnat_no_add_ident";
  18.240 +
  18.241 +
  18.242 +(***) (***) (***) (***) (***) (***) (***) (***) (***)
  18.243 +
  18.244 +  (*** pnat_less ***)
  18.245 +
  18.246 +Goalw [pnat_less_def] 
  18.247 +      "!!x. [| x < (y::pnat); y < z |] ==> x < z";
  18.248 +by ((etac less_trans 1) THEN assume_tac 1);
  18.249 +qed "pnat_less_trans";
  18.250 +
  18.251 +Goalw [pnat_less_def] "!!x. x < (y::pnat) ==> ~ y < x";
  18.252 +by (etac less_not_sym 1);
  18.253 +qed "pnat_less_not_sym";
  18.254 +
  18.255 +(* [| x < y; y < x |] ==> P *)
  18.256 +bind_thm ("pnat_less_asym",pnat_less_not_sym RS notE);
  18.257 +
  18.258 +Goalw [pnat_less_def] "!!x. ~ y < (y::pnat)";
  18.259 +by Auto_tac;
  18.260 +qed "pnat_less_not_refl";
  18.261 +
  18.262 +bind_thm ("pnat_less_irrefl",pnat_less_not_refl RS notE);
  18.263 +
  18.264 +Goalw [pnat_less_def] 
  18.265 +     "!!x. x < (y::pnat) ==> x ~= y";
  18.266 +by Auto_tac;
  18.267 +qed "pnat_less_not_refl2";
  18.268 +
  18.269 +Goal "~ Rep_pnat y < 0";
  18.270 +by Auto_tac;
  18.271 +qed "Rep_pnat_not_less0";
  18.272 +
  18.273 +(*** Rep_pnat < 0 ==> P ***)
  18.274 +bind_thm ("Rep_pnat_less_zeroE",Rep_pnat_not_less0 RS notE);
  18.275 +
  18.276 +Goal "~ Rep_pnat y < 1";
  18.277 +by (auto_tac (claset(),simpset() addsimps [less_Suc_eq,
  18.278 +                  Rep_pnat_gt_zero,less_not_refl2]));
  18.279 +qed "Rep_pnat_not_less_one";
  18.280 +
  18.281 +(*** Rep_pnat < 1 ==> P ***)
  18.282 +bind_thm ("Rep_pnat_less_oneE",Rep_pnat_not_less_one RS notE);
  18.283 +
  18.284 +Goalw [pnat_less_def] 
  18.285 +     "!!x. x < (y::pnat) ==> Rep_pnat y ~= 1";
  18.286 +by (auto_tac (claset(),simpset() 
  18.287 +    addsimps [Rep_pnat_not_less_one] delsimps [less_one]));
  18.288 +qed "Rep_pnat_gt_implies_not0";
  18.289 +
  18.290 +Goalw [pnat_less_def] 
  18.291 +      "(x::pnat) < y | x = y | y < x";
  18.292 +by (cut_facts_tac [less_linear] 1);
  18.293 +by (fast_tac (claset() addIs [inj_Rep_pnat RS injD]) 1);
  18.294 +qed "pnat_less_linear";
  18.295 +
  18.296 +Goalw [le_def] "1 <= Rep_pnat x";
  18.297 +by (rtac Rep_pnat_not_less_one 1);
  18.298 +qed "Rep_pnat_le_one";
  18.299 +
  18.300 +Goalw [pnat_less_def]
  18.301 +     "!! (z1::nat). z1 < z2  ==> ? z3. z1 + Rep_pnat z3 = z2";
  18.302 +by (dtac less_imp_add_positive 1);
  18.303 +by (auto_tac (claset() addSIs [Abs_pnat_inverse],
  18.304 +	      simpset() addsimps [Collect_pnat_gt_0]));
  18.305 +qed "lemma_less_ex_sum_Rep_pnat";
  18.306 +
  18.307 +
  18.308 +   (*** pnat_le ***)
  18.309 +
  18.310 +Goalw [pnat_le_def] "!!x. ~ (x::pnat) < y ==> y <= x";
  18.311 +by (assume_tac 1);
  18.312 +qed "pnat_leI";
  18.313 +
  18.314 +Goalw [pnat_le_def] "!!x. (x::pnat) <= y ==> ~ y < x";
  18.315 +by (assume_tac 1);
  18.316 +qed "pnat_leD";
  18.317 +
  18.318 +val pnat_leE = make_elim pnat_leD;
  18.319 +
  18.320 +Goal "(~ (x::pnat) < y) = (y <= x)";
  18.321 +by (blast_tac (claset() addIs [pnat_leI] addEs [pnat_leE]) 1);
  18.322 +qed "pnat_not_less_iff_le";
  18.323 +
  18.324 +Goalw [pnat_le_def] "!!x. ~(x::pnat) <= y ==> y < x";
  18.325 +by (Blast_tac 1);
  18.326 +qed "pnat_not_leE";
  18.327 +
  18.328 +Goalw [pnat_le_def] "!!x. (x::pnat) < y ==> x <= y";
  18.329 +by (blast_tac (claset() addEs [pnat_less_asym]) 1);
  18.330 +qed "pnat_less_imp_le";
  18.331 +
  18.332 +(** Equivalence of m<=n and  m<n | m=n **)
  18.333 +
  18.334 +Goalw [pnat_le_def] "!!m. m <= n ==> m < n | m=(n::pnat)";
  18.335 +by (cut_facts_tac [pnat_less_linear] 1);
  18.336 +by (blast_tac (claset() addEs [pnat_less_irrefl,pnat_less_asym]) 1);
  18.337 +qed "pnat_le_imp_less_or_eq";
  18.338 +
  18.339 +Goalw [pnat_le_def] "!!m. m<n | m=n ==> m <=(n::pnat)";
  18.340 +by (cut_facts_tac [pnat_less_linear] 1);
  18.341 +by (blast_tac (claset() addSEs [pnat_less_irrefl] addEs [pnat_less_asym]) 1);
  18.342 +qed "pnat_less_or_eq_imp_le";
  18.343 +
  18.344 +Goal "(m <= (n::pnat)) = (m < n | m=n)";
  18.345 +by (REPEAT(ares_tac [iffI,pnat_less_or_eq_imp_le,pnat_le_imp_less_or_eq] 1));
  18.346 +qed "pnat_le_eq_less_or_eq";
  18.347 +
  18.348 +Goal "n <= (n::pnat)";
  18.349 +by (simp_tac (simpset() addsimps [pnat_le_eq_less_or_eq]) 1);
  18.350 +qed "pnat_le_refl";
  18.351 +
  18.352 +val prems = goal thy "!!i. [| i <= j; j < k |] ==> i < (k::pnat)";
  18.353 +by (dtac pnat_le_imp_less_or_eq 1);
  18.354 +by (blast_tac (claset() addIs [pnat_less_trans]) 1);
  18.355 +qed "pnat_le_less_trans";
  18.356 +
  18.357 +Goal "!!i. [| i < j; j <= k |] ==> i < (k::pnat)";
  18.358 +by (dtac pnat_le_imp_less_or_eq 1);
  18.359 +by (blast_tac (claset() addIs [pnat_less_trans]) 1);
  18.360 +qed "pnat_less_le_trans";
  18.361 +
  18.362 +Goal "!!i. [| i <= j; j <= k |] ==> i <= (k::pnat)";
  18.363 +by (EVERY1[dtac pnat_le_imp_less_or_eq, 
  18.364 +           dtac pnat_le_imp_less_or_eq,
  18.365 +           rtac pnat_less_or_eq_imp_le, 
  18.366 +           blast_tac (claset() addIs [pnat_less_trans])]);
  18.367 +qed "pnat_le_trans";
  18.368 +
  18.369 +Goal "!!m. [| m <= n; n <= m |] ==> m = (n::pnat)";
  18.370 +by (EVERY1[dtac pnat_le_imp_less_or_eq, 
  18.371 +           dtac pnat_le_imp_less_or_eq,
  18.372 +           blast_tac (claset() addIs [pnat_less_asym])]);
  18.373 +qed "pnat_le_anti_sym";
  18.374 +
  18.375 +Goal "(m::pnat) < n = (m <= n & m ~= n)";
  18.376 +by (rtac iffI 1);
  18.377 +by (rtac conjI 1);
  18.378 +by (etac pnat_less_imp_le 1);
  18.379 +by (etac pnat_less_not_refl2 1);
  18.380 +by (blast_tac (claset() addSDs [pnat_le_imp_less_or_eq]) 1);
  18.381 +qed "pnat_less_le";
  18.382 +
  18.383 +(** LEAST -- the least number operator **)
  18.384 +
  18.385 +Goal "(! m::pnat. P m --> n <= m) = (! m. m < n --> ~ P m)";
  18.386 +by (blast_tac (claset() addIs [pnat_leI] addEs [pnat_leE]) 1);
  18.387 +val lemma = result();
  18.388 +
  18.389 +(* Comment below from NatDef.ML where Least_nat_def is proved*)
  18.390 +(* This is an old def of Least for nat, which is derived for compatibility *)
  18.391 +Goalw [Least_def]
  18.392 +  "(LEAST n::pnat. P n) == (@n. P(n) & (ALL m. m < n --> ~P(m)))";
  18.393 +by (simp_tac (simpset() addsimps [lemma]) 1);
  18.394 +qed "Least_pnat_def";
  18.395 +
  18.396 +val [prem1,prem2] = goalw thy [Least_pnat_def]
  18.397 +    "[| P(k::pnat);  !!x. x<k ==> ~P(x) |] ==> (LEAST x. P(x)) = k";
  18.398 +by (rtac select_equality 1);
  18.399 +by (blast_tac (claset() addSIs [prem1,prem2]) 1);
  18.400 +by (cut_facts_tac [pnat_less_linear] 1);
  18.401 +by (blast_tac (claset() addSIs [prem1] addSDs [prem2]) 1);
  18.402 +qed "pnat_Least_equality";
  18.403 +
  18.404 +(***) (***) (***) (***) (***) (***) (***) (***)
  18.405 +
  18.406 +(*** alternative definition for pnat_le ***)
  18.407 +Goalw [pnat_le_def,pnat_less_def] 
  18.408 +      "((m::pnat) <= n) = (Rep_pnat m <= Rep_pnat n)";
  18.409 +by (auto_tac (claset() addSIs [leI] addSEs [leD],simpset()));
  18.410 +qed "pnat_le_iff_Rep_pnat_le";
  18.411 +
  18.412 +Goal "!!k::pnat. (k + m <= k + n) = (m<=n)";
  18.413 +by (simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  18.414 +                           sum_Rep_pnat_sum RS sym]) 1);
  18.415 +qed "pnat_add_left_cancel_le";
  18.416 +
  18.417 +Goalw [pnat_less_def] "!!k::pnat. (k + m < k + n) = (m<n)";
  18.418 +by (simp_tac (simpset() addsimps [sum_Rep_pnat_sum RS sym]) 1);
  18.419 +qed "pnat_add_left_cancel_less";
  18.420 +
  18.421 +Addsimps [pnat_add_left_cancel, pnat_add_right_cancel,
  18.422 +  pnat_add_left_cancel_le, pnat_add_left_cancel_less];
  18.423 +
  18.424 +Goal "n <= ((m + n)::pnat)";
  18.425 +by (simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  18.426 +                    sum_Rep_pnat_sum RS sym,le_add2]) 1);
  18.427 +qed "pnat_le_add2";
  18.428 +
  18.429 +Goal "n <= ((n + m)::pnat)";
  18.430 +by (simp_tac (simpset() addsimps pnat_add_ac) 1);
  18.431 +by (rtac pnat_le_add2 1);
  18.432 +qed "pnat_le_add1";
  18.433 +
  18.434 +(*** "i <= j ==> i <= j + m" ***)
  18.435 +bind_thm ("pnat_trans_le_add1", pnat_le_add1 RSN (2,pnat_le_trans));
  18.436 +
  18.437 +(*** "i <= j ==> i <= m + j" ***)
  18.438 +bind_thm ("pnat_trans_le_add2", pnat_le_add2 RSN (2,pnat_le_trans));
  18.439 +
  18.440 +(*"i < j ==> i < j + m"*)
  18.441 +bind_thm ("pnat_trans_less_add1", pnat_le_add1 RSN (2,pnat_less_le_trans));
  18.442 +
  18.443 +(*"i < j ==> i < m + j"*)
  18.444 +bind_thm ("pnat_trans_less_add2", pnat_le_add2 RSN (2,pnat_less_le_trans));
  18.445 +
  18.446 +Goalw [pnat_less_def] "!!i. i+j < (k::pnat) ==> i<k";
  18.447 +by (auto_tac (claset() addEs [add_lessD1],
  18.448 +    simpset() addsimps [sum_Rep_pnat_sum RS sym]));
  18.449 +qed "pnat_add_lessD1";
  18.450 +
  18.451 +Goal "!!i::pnat. ~ (i+j < i)";
  18.452 +by (rtac  notI 1);
  18.453 +by (etac (pnat_add_lessD1 RS pnat_less_irrefl) 1);
  18.454 +qed "pnat_not_add_less1";
  18.455 +
  18.456 +Goal "!!i::pnat. ~ (j+i < i)";
  18.457 +by (simp_tac (simpset() addsimps [pnat_add_commute, pnat_not_add_less1]) 1);
  18.458 +qed "pnat_not_add_less2";
  18.459 +
  18.460 +AddIffs [pnat_not_add_less1, pnat_not_add_less2];
  18.461 +
  18.462 +Goal "!!k::pnat. m <= n ==> m <= n + k";
  18.463 +by (etac pnat_le_trans 1);
  18.464 +by (rtac pnat_le_add1 1);
  18.465 +qed "pnat_le_imp_add_le";
  18.466 +
  18.467 +Goal "!!k::pnat. m < n ==> m < n + k";
  18.468 +by (etac pnat_less_le_trans 1);
  18.469 +by (rtac pnat_le_add1 1);
  18.470 +qed "pnat_less_imp_add_less";
  18.471 +
  18.472 +Goal "m + k <= n --> m <= (n::pnat)";
  18.473 +by (simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  18.474 +    sum_Rep_pnat_sum RS sym]) 1);
  18.475 +by (fast_tac (claset() addIs [add_leD1]) 1);
  18.476 +qed_spec_mp "pnat_add_leD1";
  18.477 +
  18.478 +Goal "!!n::pnat. m + k <= n ==> k <= n";
  18.479 +by (full_simp_tac (simpset() addsimps [pnat_add_commute]) 1);
  18.480 +by (etac pnat_add_leD1 1);
  18.481 +qed_spec_mp "pnat_add_leD2";
  18.482 +
  18.483 +Goal "!!n::pnat. m + k <= n ==> m <= n & k <= n";
  18.484 +by (blast_tac (claset() addDs [pnat_add_leD1, pnat_add_leD2]) 1);
  18.485 +bind_thm ("pnat_add_leE", result() RS conjE);
  18.486 +
  18.487 +Goalw [pnat_less_def] 
  18.488 +      "!!k l::pnat. [| k < l; m + l = k + n |] ==> m < n";
  18.489 +by (rtac less_add_eq_less 1 THEN assume_tac 1);
  18.490 +by (auto_tac (claset(),simpset() addsimps [sum_Rep_pnat_sum]));
  18.491 +qed "pnat_less_add_eq_less";
  18.492 +
  18.493 +(* ordering on positive naturals in terms of existence of sum *)
  18.494 +(* could provide alternative definition -- Gleason *)
  18.495 +Goalw [pnat_less_def,pnat_add_def] 
  18.496 +      "(z1::pnat) < z2 = (? z3. z1 + z3 = z2)";
  18.497 +by (rtac iffI 1);
  18.498 +by (res_inst_tac [("t","z2")] (Rep_pnat_inverse RS subst) 1);
  18.499 +by (dtac lemma_less_ex_sum_Rep_pnat 1);
  18.500 +by (etac exE 1 THEN res_inst_tac [("x","z3")] exI 1);
  18.501 +by (auto_tac (claset(),simpset() addsimps [sum_Rep_pnat_sum,Rep_pnat_inverse]));
  18.502 +by (res_inst_tac [("t","Rep_pnat z1")] (add_0_right RS subst) 1);
  18.503 +by (auto_tac (claset(),simpset() addsimps [sum_Rep_pnat_sum RS sym,
  18.504 +               Rep_pnat_gt_zero] delsimps [add_0_right]));
  18.505 +qed "pnat_less_iff";
  18.506 +
  18.507 +Goal "(? (x::pnat). z1 + x = z2) | z1 = z2 \
  18.508 +\          |(? x. z2 + x = z1)";
  18.509 +by (cut_facts_tac [pnat_less_linear] 1);
  18.510 +by (asm_full_simp_tac (simpset() addsimps [pnat_less_iff]) 1);
  18.511 +qed "pnat_linear_Ex_eq";
  18.512 +
  18.513 +Goal "!!(x::pnat). x + y = z ==> x < z";
  18.514 +by (rtac (pnat_less_iff RS iffD2) 1);
  18.515 +by (Blast_tac 1);
  18.516 +qed "pnat_eq_lessI";
  18.517 +
  18.518 +(*** Monotonicity of Addition ***)
  18.519 +
  18.520 +(*strict, in 1st argument*)
  18.521 +Goalw [pnat_less_def] "!!i j k::pnat. i < j ==> i + k < j + k";
  18.522 +by (auto_tac (claset() addIs [add_less_mono1],
  18.523 +       simpset() addsimps [sum_Rep_pnat_sum RS sym]));
  18.524 +qed "pnat_add_less_mono1";
  18.525 +
  18.526 +Goalw [pnat_less_def] "!!i j k::pnat. [|i < j; k < l|] ==> i + k < j + l";
  18.527 +by (auto_tac (claset() addIs [add_less_mono],
  18.528 +       simpset() addsimps [sum_Rep_pnat_sum RS sym]));
  18.529 +qed "pnat_add_less_mono";
  18.530 +
  18.531 +Goalw [pnat_less_def]
  18.532 +     "!!f. [| !!i j::pnat. i<j ==> f(i) < f(j);       \
  18.533 +\        i <= j                                 \
  18.534 +\     |] ==> f(i) <= (f(j)::pnat)";
  18.535 +by (auto_tac (claset() addSDs [inj_Rep_pnat RS injD],
  18.536 +             simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  18.537 +                                     le_eq_less_or_eq]));
  18.538 +qed "pnat_less_mono_imp_le_mono";
  18.539 +
  18.540 +Goal "!!i j k::pnat. i<=j ==> i + k <= j + k";
  18.541 +by (res_inst_tac [("f", "%j. j+k")] pnat_less_mono_imp_le_mono 1);
  18.542 +by (etac pnat_add_less_mono1 1);
  18.543 +by (assume_tac 1);
  18.544 +qed "pnat_add_le_mono1";
  18.545 +
  18.546 +Goal "!!k l::pnat. [|i<=j;  k<=l |] ==> i + k <= j + l";
  18.547 +by (etac (pnat_add_le_mono1 RS pnat_le_trans) 1);
  18.548 +by (simp_tac (simpset() addsimps [pnat_add_commute]) 1);
  18.549 +(*j moves to the end because it is free while k, l are bound*)
  18.550 +by (etac pnat_add_le_mono1 1);
  18.551 +qed "pnad_add_le_mono";
  18.552 +
  18.553 +Goal "1 * Rep_pnat n = Rep_pnat n";
  18.554 +by (Asm_simp_tac 1);
  18.555 +qed "Rep_pnat_mult_1";
  18.556 +
  18.557 +Goal "Rep_pnat n * 1 = Rep_pnat n";
  18.558 +by (Asm_simp_tac 1);
  18.559 +qed "Rep_pnat_mult_1_right";
  18.560 +
  18.561 +Goal
  18.562 +      "(Rep_pnat x * Rep_pnat y): pnat";
  18.563 +by (cut_facts_tac [[Rep_pnat_gt_zero,
  18.564 +    Rep_pnat_gt_zero] MRS mult_less_mono1,Collect_pnat_gt_0] 1);
  18.565 +by (etac ssubst 1);
  18.566 +by Auto_tac;
  18.567 +qed "mult_Rep_pnat";
  18.568 +
  18.569 +Goalw [pnat_mult_def] 
  18.570 +      "Rep_pnat x * Rep_pnat y = Rep_pnat (x * y)";
  18.571 +by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  18.572 +                          Abs_pnat_inverse]) 1);
  18.573 +qed "mult_Rep_pnat_mult";
  18.574 +
  18.575 +Goalw [pnat_mult_def] "m * n = n * (m::pnat)";
  18.576 +by (full_simp_tac (simpset() addsimps [mult_commute]) 1);
  18.577 +qed "pnat_mult_commute";
  18.578 +
  18.579 +Goalw [pnat_mult_def,pnat_add_def] "(m + n)*k = (m*k) + ((n*k)::pnat)";
  18.580 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.581 +by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  18.582 +                Abs_pnat_inverse,sum_Rep_pnat RS 
  18.583 +             Abs_pnat_inverse, add_mult_distrib]) 1);
  18.584 +qed "pnat_add_mult_distrib";
  18.585 +
  18.586 +Goalw [pnat_mult_def,pnat_add_def] "k*(m + n) = (k*m) + ((k*n)::pnat)";
  18.587 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.588 +by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  18.589 +                Abs_pnat_inverse,sum_Rep_pnat RS 
  18.590 +             Abs_pnat_inverse, add_mult_distrib2]) 1);
  18.591 +qed "pnat_add_mult_distrib2";
  18.592 +
  18.593 +Goalw [pnat_mult_def] 
  18.594 +      "(x * y) * z = x * (y * (z::pnat))";
  18.595 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.596 +by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  18.597 +                Abs_pnat_inverse,mult_assoc]) 1);
  18.598 +qed "pnat_mult_assoc";
  18.599 +
  18.600 +Goalw [pnat_mult_def] "x * (y * z) = y * (x * (z::pnat))";
  18.601 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.602 +by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  18.603 +          Abs_pnat_inverse,mult_left_commute]) 1);
  18.604 +qed "pnat_mult_left_commute";
  18.605 +
  18.606 +Goalw [pnat_mult_def] "x * (Abs_pnat 1) = x";
  18.607 +by (full_simp_tac (simpset() addsimps [one_RepI RS Abs_pnat_inverse,
  18.608 +                   Rep_pnat_inverse]) 1);
  18.609 +qed "pnat_mult_1";
  18.610 +
  18.611 +Goal "Abs_pnat 1 * x = x";
  18.612 +by (full_simp_tac (simpset() addsimps [pnat_mult_1,
  18.613 +                   pnat_mult_commute]) 1);
  18.614 +qed "pnat_mult_1_left";
  18.615 +
  18.616 +(*Multiplication is an AC-operator*)
  18.617 +val pnat_mult_ac = [pnat_mult_assoc, pnat_mult_commute, pnat_mult_left_commute];
  18.618 +
  18.619 +Goal "!!i j k::pnat. i<=j ==> i * k <= j * k";
  18.620 +by (asm_full_simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  18.621 +                     mult_Rep_pnat_mult RS sym,mult_le_mono1]) 1);
  18.622 +qed "pnat_mult_le_mono1";
  18.623 +
  18.624 +Goal "!!i::pnat. [| i<=j; k<=l |] ==> i*k<=j*l";
  18.625 +by (asm_full_simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  18.626 +                     mult_Rep_pnat_mult RS sym,mult_le_mono]) 1);
  18.627 +qed "pnat_mult_le_mono";
  18.628 +
  18.629 +Goal "!!i::pnat. i<j ==> k*i < k*j";
  18.630 +by (asm_full_simp_tac (simpset() addsimps [pnat_less_def,
  18.631 +    mult_Rep_pnat_mult RS sym,Rep_pnat_gt_zero,mult_less_mono2]) 1);
  18.632 +qed "pnat_mult_less_mono2";
  18.633 +
  18.634 +Goal "!!i::pnat. i<j ==> i*k < j*k";
  18.635 +by (dtac pnat_mult_less_mono2 1);
  18.636 +by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [pnat_mult_commute])));
  18.637 +qed "pnat_mult_less_mono1";
  18.638 +
  18.639 +Goalw [pnat_less_def] "(m*(k::pnat) < n*k) = (m<n)";
  18.640 +by (asm_full_simp_tac (simpset() addsimps [mult_Rep_pnat_mult 
  18.641 +              RS sym,Rep_pnat_gt_zero]) 1);
  18.642 +qed "pnat_mult_less_cancel2";
  18.643 +
  18.644 +Goalw [pnat_less_def] "((k::pnat)*m < k*n) = (m<n)";
  18.645 +by (asm_full_simp_tac (simpset() addsimps [mult_Rep_pnat_mult 
  18.646 +              RS sym,Rep_pnat_gt_zero]) 1);
  18.647 +qed "pnat_mult_less_cancel1";
  18.648 +
  18.649 +Addsimps [pnat_mult_less_cancel1, pnat_mult_less_cancel2];
  18.650 +
  18.651 +Goalw [pnat_mult_def]  "(m*(k::pnat) = n*k) = (m=n)";
  18.652 +by (auto_tac (claset() addSDs [inj_on_Abs_pnat RS inj_onD, 
  18.653 +    inj_Rep_pnat RS injD] addIs [mult_Rep_pnat], 
  18.654 +    simpset() addsimps [Rep_pnat_gt_zero RS mult_cancel2]));
  18.655 +qed "pnat_mult_cancel2";
  18.656 +
  18.657 +Goal "((k::pnat)*m = k*n) = (m=n)";
  18.658 +by (rtac (pnat_mult_cancel2 RS subst) 1);
  18.659 +by (auto_tac (claset () addIs [pnat_mult_commute RS subst],simpset()));
  18.660 +qed "pnat_mult_cancel1";
  18.661 +
  18.662 +Addsimps [pnat_mult_cancel1, pnat_mult_cancel2];
  18.663 +
  18.664 +Goal
  18.665 +     "!!(z1::pnat). z2*z3 = z4*z5  ==> z2*(z1*z3) = z4*(z1*z5)";
  18.666 +by (auto_tac (claset() addIs [pnat_mult_cancel1 RS iffD2],
  18.667 +    simpset() addsimps [pnat_mult_left_commute]));
  18.668 +qed "pnat_same_multI2";
  18.669 +
  18.670 +val [prem] = goal thy
  18.671 +    "(!!u. z = Abs_pnat(u) ==> P) ==> P";
  18.672 +by (cut_inst_tac [("x1","z")] 
  18.673 +    (rewrite_rule [pnat_def] (Rep_pnat RS Abs_pnat_inverse)) 1);
  18.674 +by (res_inst_tac [("u","Rep_pnat z")] prem 1);
  18.675 +by (dtac (inj_Rep_pnat RS injD) 1);
  18.676 +by (Asm_simp_tac 1);
  18.677 +qed "eq_Abs_pnat";
  18.678 +
  18.679 +(** embedding of naturals in positive naturals **)
  18.680 +
  18.681 +(* pnat_one_eq! *)
  18.682 +Goalw [pnat_nat_def,pnat_one_def]"1p = *#0";
  18.683 +by (Full_simp_tac 1);
  18.684 +qed "pnat_one_iff";
  18.685 +
  18.686 +Goalw [pnat_nat_def,pnat_one_def,pnat_add_def] "1p + 1p = *#1";
  18.687 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.688 +by (auto_tac (claset() addIs [(gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst)],
  18.689 +    simpset()));
  18.690 +qed "pnat_two_eq";
  18.691 +
  18.692 +Goal "inj(pnat_nat)";
  18.693 +by (rtac injI 1);
  18.694 +by (rewtac pnat_nat_def);
  18.695 +by (dtac (inj_on_Abs_pnat RS inj_onD) 1);
  18.696 +by (auto_tac (claset() addSIs [gt_0_mem_pnat],simpset()));
  18.697 +qed "inj_pnat_nat";
  18.698 +
  18.699 +Goal "0 < n + 1";
  18.700 +by Auto_tac;
  18.701 +qed "nat_add_one_less";
  18.702 +
  18.703 +Goal "0 < n1 + n2 + 1";
  18.704 +by Auto_tac;
  18.705 +qed "nat_add_one_less1";
  18.706 +
  18.707 +(* this worked with one call to auto_tac before! *)
  18.708 +Goalw [pnat_add_def,pnat_nat_def,pnat_one_def] 
  18.709 +          "*#n1 + *#n2 = *#(n1 + n2) + 1p";
  18.710 +by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  18.711 +by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 1);
  18.712 +by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 2);
  18.713 +by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 3);
  18.714 +by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 4);
  18.715 +by (auto_tac (claset(),
  18.716 +	      simpset() addsimps [sum_Rep_pnat_sum,
  18.717 +				  nat_add_one_less,nat_add_one_less1]));
  18.718 +qed "pnat_nat_add";
  18.719 +
  18.720 +Goalw [pnat_nat_def,pnat_less_def] "(n < m) = (*#n < *#m)";
  18.721 +by (auto_tac (claset(),simpset() 
  18.722 +    addsimps [Abs_pnat_inverse,Collect_pnat_gt_0]));
  18.723 +qed "pnat_nat_less_iff";
  18.724 +
  18.725 +Addsimps [pnat_nat_less_iff RS sym];
  18.726 +
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/HOL/Real/PNat.thy	Thu Jun 25 13:57:34 1998 +0200
    19.3 @@ -0,0 +1,73 @@
    19.4 +(*  Title       : PNat.thy
    19.5 +    Author      : Jacques D. Fleuriot
    19.6 +    Copyright   : 1998  University of Cambridge
    19.7 +    Description : The positive naturals
    19.8 +*) 
    19.9 +
   19.10 +
   19.11 +PNat = Arith +
   19.12 +
   19.13 +(** type pnat **)
   19.14 +
   19.15 +(* type definition *)
   19.16 +
   19.17 +typedef
   19.18 +  pnat = "lfp(%X. {1} Un (Suc``X))"   (lfp_def)
   19.19 +
   19.20 +instance
   19.21 +   pnat :: {ord, plus, times}
   19.22 +
   19.23 +consts
   19.24 +
   19.25 +  pSuc       :: pnat => pnat
   19.26 +  "1p"       :: pnat                ("1p")
   19.27 +
   19.28 +constdefs
   19.29 +  
   19.30 +  pnat_nat  :: nat => pnat                  ("*# _" [80] 80) 
   19.31 +  "*# n     == Abs_pnat(n + 1)"
   19.32 + 
   19.33 +defs
   19.34 +
   19.35 +  pnat_one_def      "1p == Abs_pnat(1)"
   19.36 +  pnat_Suc_def      "pSuc == (%n. Abs_pnat(Suc(Rep_pnat(n))))"
   19.37 +
   19.38 +
   19.39 +  pnat_add_def
   19.40 +       "x + y == Abs_pnat(Rep_pnat(x) +  Rep_pnat(y))"
   19.41 +
   19.42 +  pnat_mult_def
   19.43 +       "x * y == Abs_pnat(Rep_pnat(x) * Rep_pnat(y))"
   19.44 +
   19.45 + pnat_less_def
   19.46 +       "x < (y::pnat) == Rep_pnat(x) < Rep_pnat(y)"
   19.47 +
   19.48 + pnat_le_def
   19.49 +       "x <= (y::pnat) ==  ~(y < x)"
   19.50 +
   19.51 +end
   19.52 +
   19.53 +
   19.54 +
   19.55 +
   19.56 +
   19.57 +
   19.58 +
   19.59 +
   19.60 +
   19.61 +
   19.62 +
   19.63 +
   19.64 +
   19.65 +
   19.66 +
   19.67 +
   19.68 +
   19.69 +
   19.70 +
   19.71 +
   19.72 +
   19.73 +
   19.74 +
   19.75 +
   19.76 +
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/HOL/Real/PRat.ML	Thu Jun 25 13:57:34 1998 +0200
    20.3 @@ -0,0 +1,837 @@
    20.4 +(*  Title       : PRat.ML
    20.5 +    Author      : Jacques D. Fleuriot
    20.6 +    Copyright   : 1998  University of Cambridge
    20.7 +    Description : The positive rationals
    20.8 +*) 
    20.9 +
   20.10 +open PRat;
   20.11 +
   20.12 +Delrules [equalityI];
   20.13 +
   20.14 +(*** Many theorems similar to those in Integ.thy ***)
   20.15 +(*** Proving that ratrel is an equivalence relation ***)
   20.16 +
   20.17 +Goal
   20.18 +    "!! x1. [| (x1::pnat) * y2 = x2 * y1; x2 * y3 = x3 * y2 |] \
   20.19 +\            ==> x1 * y3 = x3 * y1";        
   20.20 +by (res_inst_tac [("k1","y2")] (pnat_mult_cancel1 RS iffD1) 1);
   20.21 +by (auto_tac (claset(), simpset() addsimps [pnat_mult_assoc RS sym]));
   20.22 +by (auto_tac (claset(),simpset() addsimps [pnat_mult_commute]));
   20.23 +by (dres_inst_tac [("s","x2 * y3")] sym 1);
   20.24 +by (asm_simp_tac (simpset() addsimps [pnat_mult_left_commute,
   20.25 +    pnat_mult_commute]) 1);
   20.26 +qed "prat_trans_lemma";
   20.27 +
   20.28 +(** Natural deduction for ratrel **)
   20.29 +
   20.30 +Goalw [ratrel_def]
   20.31 +    "(((x1,y1),(x2,y2)): ratrel) = (x1 * y2 = x2 * y1)";
   20.32 +by (Fast_tac 1);
   20.33 +qed "ratrel_iff";
   20.34 +
   20.35 +Goalw [ratrel_def]
   20.36 +    "!!x1 x2. [| x1 * y2 = x2 * y1 |] ==> ((x1,y1),(x2,y2)): ratrel";
   20.37 +by (Fast_tac  1);
   20.38 +qed "ratrelI";
   20.39 +
   20.40 +Goalw [ratrel_def]
   20.41 +  "p: ratrel --> (EX x1 y1 x2 y2. \
   20.42 +\                  p = ((x1,y1),(x2,y2)) & x1 *y2 = x2 *y1)";
   20.43 +by (Fast_tac 1);
   20.44 +qed "ratrelE_lemma";
   20.45 +
   20.46 +val [major,minor] = goal thy
   20.47 +  "[| p: ratrel;  \
   20.48 +\     !!x1 y1 x2 y2. [| p = ((x1,y1),(x2,y2));  x1*y2 = x2*y1 \
   20.49 +\                    |] ==> Q |] ==> Q";
   20.50 +by (cut_facts_tac [major RS (ratrelE_lemma RS mp)] 1);
   20.51 +by (REPEAT (eresolve_tac [asm_rl,exE,conjE,minor] 1));
   20.52 +qed "ratrelE";
   20.53 +
   20.54 +AddSIs [ratrelI];
   20.55 +AddSEs [ratrelE];
   20.56 +
   20.57 +Goal "(x,x): ratrel";
   20.58 +by (stac surjective_pairing 1 THEN rtac (refl RS ratrelI) 1);
   20.59 +qed "ratrel_refl";
   20.60 +
   20.61 +Goalw [equiv_def, refl_def, sym_def, trans_def]
   20.62 +    "equiv {x::(pnat*pnat).True} ratrel";
   20.63 +by (fast_tac (claset() addSIs [ratrel_refl] 
   20.64 +                      addSEs [sym, prat_trans_lemma]) 1);
   20.65 +qed "equiv_ratrel";
   20.66 +
   20.67 +val equiv_ratrel_iff =
   20.68 +    [TrueI, TrueI] MRS 
   20.69 +    ([CollectI, CollectI] MRS 
   20.70 +    (equiv_ratrel RS eq_equiv_class_iff));
   20.71 +
   20.72 +Goalw  [prat_def,ratrel_def,quotient_def] "ratrel^^{(x,y)}:prat";
   20.73 +by (Blast_tac 1);
   20.74 +qed "ratrel_in_prat";
   20.75 +
   20.76 +Goal "inj_on Abs_prat prat";
   20.77 +by (rtac inj_on_inverseI 1);
   20.78 +by (etac Abs_prat_inverse 1);
   20.79 +qed "inj_on_Abs_prat";
   20.80 +
   20.81 +Addsimps [equiv_ratrel_iff,inj_on_Abs_prat RS inj_on_iff,
   20.82 +          ratrel_iff, ratrel_in_prat, Abs_prat_inverse];
   20.83 +
   20.84 +Addsimps [equiv_ratrel RS eq_equiv_class_iff];
   20.85 +val eq_ratrelD = equiv_ratrel RSN (2,eq_equiv_class);
   20.86 +
   20.87 +Goal "inj(Rep_prat)";
   20.88 +by (rtac inj_inverseI 1);
   20.89 +by (rtac Rep_prat_inverse 1);
   20.90 +qed "inj_Rep_prat";
   20.91 +
   20.92 +(** prat_pnat: the injection from pnat to prat **)
   20.93 +Goal "inj(prat_pnat)";
   20.94 +by (rtac injI 1);
   20.95 +by (rewtac prat_pnat_def);
   20.96 +by (dtac (inj_on_Abs_prat RS inj_onD) 1);
   20.97 +by (REPEAT (rtac ratrel_in_prat 1));
   20.98 +by (dtac eq_equiv_class 1);
   20.99 +by (rtac equiv_ratrel 1);
  20.100 +by (Fast_tac 1);
  20.101 +by Safe_tac;
  20.102 +by (Asm_full_simp_tac 1);
  20.103 +qed "inj_prat_pnat";
  20.104 +
  20.105 +(* lcp's original eq_Abs_Integ *)
  20.106 +val [prem] = goal thy
  20.107 +    "(!!x y. z = Abs_prat(ratrel^^{(x,y)}) ==> P) ==> P";
  20.108 +by (res_inst_tac [("x1","z")] 
  20.109 +    (rewrite_rule [prat_def] Rep_prat RS quotientE) 1);
  20.110 +by (dres_inst_tac [("f","Abs_prat")] arg_cong 1);
  20.111 +by (res_inst_tac [("p","x")] PairE 1);
  20.112 +by (rtac prem 1);
  20.113 +by (asm_full_simp_tac (simpset() addsimps [Rep_prat_inverse]) 1);
  20.114 +qed "eq_Abs_prat";
  20.115 +
  20.116 +(**** qinv: inverse on prat ****)
  20.117 +
  20.118 +Goalw [congruent_def]
  20.119 +  "congruent ratrel (%p. split (%x y. ratrel^^{(y,x)}) p)";
  20.120 +by Safe_tac;
  20.121 +by (asm_full_simp_tac (simpset() addsimps [pnat_mult_commute]) 1);
  20.122 +qed "qinv_congruent";
  20.123 +
  20.124 +(*Resolve th against the corresponding facts for qinv*)
  20.125 +val qinv_ize = RSLIST [equiv_ratrel, qinv_congruent];
  20.126 +
  20.127 +Goalw [qinv_def]
  20.128 +      "qinv (Abs_prat(ratrel^^{(x,y)})) = Abs_prat(ratrel ^^ {(y,x)})";
  20.129 +by (res_inst_tac [("f","Abs_prat")] arg_cong 1);
  20.130 +by (simp_tac (simpset() addsimps 
  20.131 +   [ratrel_in_prat RS Abs_prat_inverse,qinv_ize UN_equiv_class]) 1);
  20.132 +qed "qinv";
  20.133 +
  20.134 +Goal "qinv (qinv z) = z";
  20.135 +by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  20.136 +by (asm_simp_tac (simpset() addsimps [qinv]) 1);
  20.137 +qed "qinv_qinv";
  20.138 +
  20.139 +Goal "inj(qinv)";
  20.140 +by (rtac injI 1);
  20.141 +by (dres_inst_tac [("f","qinv")] arg_cong 1);
  20.142 +by (asm_full_simp_tac (simpset() addsimps [qinv_qinv]) 1);
  20.143 +qed "inj_qinv";
  20.144 +
  20.145 +Goalw [prat_pnat_def] "qinv($# (Abs_pnat 1)) = $#(Abs_pnat 1)";
  20.146 +by (simp_tac (simpset() addsimps [qinv]) 1);
  20.147 +qed "qinv_1";
  20.148 +
  20.149 +Goal 
  20.150 +     "!!(x1::pnat). [| x1 * y2 = x2 * y1 |] ==> \
  20.151 +\     (x * y1 + x1 * ya) * (ya * y2) = (x * y2 + x2 * ya) * (ya * y1)";
  20.152 +by (auto_tac (claset() addSIs [pnat_same_multI2],
  20.153 +       simpset() addsimps [pnat_add_mult_distrib,
  20.154 +       pnat_mult_assoc]));
  20.155 +by (res_inst_tac [("n1","y2")] (pnat_mult_commute RS subst) 1);
  20.156 +by (auto_tac (claset() addIs [pnat_add_left_cancel RS iffD2],simpset() addsimps pnat_mult_ac));
  20.157 +by (res_inst_tac [("y1","x1")] (pnat_mult_left_commute RS subst) 1);
  20.158 +by (res_inst_tac [("y1","x1")] (pnat_mult_left_commute RS ssubst) 1);
  20.159 +by (auto_tac (claset(),simpset() addsimps [pnat_mult_assoc RS sym]));
  20.160 +qed "prat_add_congruent2_lemma";
  20.161 +
  20.162 +Goal 
  20.163 +    "congruent2 ratrel (%p1 p2.                  \
  20.164 +\         split (%x1 y1. split (%x2 y2. ratrel^^{(x1*y2 + x2*y1, y1*y2)}) p2) p1)";
  20.165 +by (rtac (equiv_ratrel RS congruent2_commuteI) 1);
  20.166 +by Safe_tac;
  20.167 +by (rewtac split_def);
  20.168 +by (asm_simp_tac (simpset() addsimps [pnat_mult_commute,pnat_add_commute]) 1);
  20.169 +by (auto_tac (claset(),simpset() addsimps [prat_add_congruent2_lemma]));
  20.170 +qed "prat_add_congruent2";
  20.171 +
  20.172 +(*Resolve th against the corresponding facts for prat_add*)
  20.173 +val prat_add_ize = RSLIST [equiv_ratrel, prat_add_congruent2];
  20.174 +
  20.175 +Goalw [prat_add_def]
  20.176 +   "Abs_prat((ratrel^^{(x1,y1)})) + Abs_prat((ratrel^^{(x2,y2)})) =   \
  20.177 +\   Abs_prat(ratrel ^^ {(x1*y2 + x2*y1, y1*y2)})";
  20.178 +by (simp_tac (simpset() addsimps [prat_add_ize UN_equiv_class2]) 1);
  20.179 +qed "prat_add";
  20.180 +
  20.181 +Goal "(z::prat) + w = w + z";
  20.182 +by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  20.183 +by (res_inst_tac [("z","w")] eq_Abs_prat 1);
  20.184 +by (asm_simp_tac (simpset() addsimps ([prat_add] @ pnat_add_ac @ pnat_mult_ac)) 1);
  20.185 +qed "prat_add_commute";
  20.186 +
  20.187 +Goal "((z1::prat) + z2) + z3 = z1 + (z2 + z3)";
  20.188 +by (res_inst_tac [("z","z1")] eq_Abs_prat 1);
  20.189 +by (res_inst_tac [("z","z2")] eq_Abs_prat 1);
  20.190 +by (res_inst_tac [("z","z3")] eq_Abs_prat 1);
  20.191 +by (asm_simp_tac (simpset() addsimps ([pnat_add_mult_distrib2,prat_add] @ 
  20.192 +                                     pnat_add_ac @ pnat_mult_ac)) 1);
  20.193 +qed "prat_add_assoc";
  20.194 +
  20.195 +qed_goal "prat_add_left_commute" thy
  20.196 +    "(z1::prat) + (z2 + z3) = z2 + (z1 + z3)"
  20.197 + (fn _ => [rtac (prat_add_commute RS trans) 1, rtac (prat_add_assoc RS trans) 1,
  20.198 +           rtac (prat_add_commute RS arg_cong) 1]);
  20.199 +
  20.200 +(* Positive Rational addition is an AC operator *)
  20.201 +val prat_add_ac = [prat_add_assoc, prat_add_commute, prat_add_left_commute];
  20.202 +
  20.203 +
  20.204 +(*** Congruence property for multiplication ***)
  20.205 +
  20.206 +Goalw [congruent2_def]
  20.207 +    "congruent2 ratrel (%p1 p2.                  \
  20.208 +\         split (%x1 y1. split (%x2 y2. ratrel^^{(x1*x2, y1*y2)}) p2) p1)";
  20.209 +
  20.210 +(*Proof via congruent2_commuteI seems longer*)
  20.211 +by Safe_tac;
  20.212 +by (asm_simp_tac (simpset() addsimps [pnat_mult_assoc]) 1);
  20.213 +(*The rest should be trivial, but rearranging terms is hard*)
  20.214 +by (res_inst_tac [("x1","x1a")] (pnat_mult_left_commute RS ssubst) 1);
  20.215 +by (asm_simp_tac (simpset() addsimps [pnat_mult_assoc RS sym]) 1);
  20.216 +by (asm_simp_tac (simpset() addsimps pnat_mult_ac) 1);
  20.217 +qed "pnat_mult_congruent2";
  20.218 +
  20.219 +(*Resolve th against the corresponding facts for pnat_mult*)
  20.220 +val prat_mult_ize = RSLIST [equiv_ratrel, pnat_mult_congruent2];
  20.221 +
  20.222 +Goalw [prat_mult_def]
  20.223 +  "Abs_prat(ratrel^^{(x1,y1)}) * Abs_prat(ratrel^^{(x2,y2)}) = \
  20.224 +\  Abs_prat(ratrel^^{(x1*x2, y1*y2)})";
  20.225 +by (asm_simp_tac
  20.226 +    (simpset() addsimps [prat_mult_ize UN_equiv_class2]) 1);
  20.227 +qed "prat_mult";
  20.228 +
  20.229 +Goal "(z::prat) * w = w * z";
  20.230 +by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  20.231 +by (res_inst_tac [("z","w")] eq_Abs_prat 1);
  20.232 +by (asm_simp_tac (simpset() addsimps (pnat_mult_ac @ [prat_mult])) 1);
  20.233 +qed "prat_mult_commute";
  20.234 +
  20.235 +Goal "((z1::prat) * z2) * z3 = z1 * (z2 * z3)";
  20.236 +by (res_inst_tac [("z","z1")] eq_Abs_prat 1);
  20.237 +by (res_inst_tac [("z","z2")] eq_Abs_prat 1);
  20.238 +by (res_inst_tac [("z","z3")] eq_Abs_prat 1);
  20.239 +by (asm_simp_tac (simpset() addsimps [prat_mult, pnat_mult_assoc]) 1);
  20.240 +qed "prat_mult_assoc";
  20.241 +
  20.242 +(*For AC rewriting*)
  20.243 +Goal "(x::prat)*(y*z)=y*(x*z)";
  20.244 +by (rtac (prat_mult_commute RS trans) 1);
  20.245 +by (rtac (prat_mult_assoc RS trans) 1);
  20.246 +by (rtac (prat_mult_commute RS arg_cong) 1);
  20.247 +qed "prat_mult_left_commute";
  20.248 +
  20.249 +(*Positive Rational multiplication is an AC operator*)
  20.250 +val prat_mult_ac = [prat_mult_assoc,prat_mult_commute,prat_mult_left_commute];
  20.251 +
  20.252 +Goalw [prat_pnat_def] "($#Abs_pnat 1) * z = z";
  20.253 +by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  20.254 +by (asm_full_simp_tac (simpset() addsimps [prat_mult] @ pnat_mult_ac) 1);
  20.255 +qed "prat_mult_1";
  20.256 +
  20.257 +Goalw [prat_pnat_def] "z * ($#Abs_pnat 1) = z";
  20.258 +by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  20.259 +by (asm_full_simp_tac (simpset() addsimps [prat_mult] @ pnat_mult_ac) 1);
  20.260 +qed "prat_mult_1_right";
  20.261 +
  20.262 +Goalw [prat_pnat_def] 
  20.263 +            "$#((z1::pnat) + z2) = $#z1 + $#z2";
  20.264 +by (asm_simp_tac (simpset() addsimps [prat_add,
  20.265 +       pnat_add_mult_distrib,pnat_mult_1]) 1);
  20.266 +qed "prat_pnat_add";
  20.267 +
  20.268 +Goalw [prat_pnat_def] 
  20.269 +            "$#((z1::pnat) * z2) = $#z1 * $#z2";
  20.270 +by (asm_simp_tac (simpset() addsimps [prat_mult,
  20.271 +                              pnat_mult_1]) 1);
  20.272 +qed "prat_pnat_mult";
  20.273 +
  20.274 +(*** prat_mult and qinv ***)
  20.275 +
  20.276 +Goalw [prat_def,prat_pnat_def] "qinv (q) * q = $# (Abs_pnat 1)";
  20.277 +by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  20.278 +by (asm_full_simp_tac (simpset() addsimps [qinv,
  20.279 +        prat_mult,pnat_mult_1,pnat_mult_1_left,
  20.280 +                        pnat_mult_commute]) 1);
  20.281 +qed "prat_mult_qinv";
  20.282 +
  20.283 +Goal "q * qinv (q) = $# (Abs_pnat 1)";
  20.284 +by (rtac (prat_mult_commute RS subst) 1);
  20.285 +by (simp_tac (simpset() addsimps [prat_mult_qinv]) 1);
  20.286 +qed "prat_mult_qinv_right";
  20.287 +
  20.288 +Goal "? y. (x::prat) * y = $# Abs_pnat 1";
  20.289 +by (fast_tac (claset() addIs [prat_mult_qinv_right]) 1);
  20.290 +qed "prat_qinv_ex";
  20.291 +
  20.292 +Goal "?! y. (x::prat) * y = $# Abs_pnat 1";
  20.293 +by (auto_tac (claset() addIs [prat_mult_qinv_right],simpset()));
  20.294 +by (dres_inst_tac [("f","%x. ya*x")] arg_cong 1);
  20.295 +by (asm_full_simp_tac (simpset() addsimps [prat_mult_assoc RS sym]) 1);
  20.296 +by (asm_full_simp_tac (simpset() addsimps [prat_mult_commute,
  20.297 +    prat_mult_1,prat_mult_1_right]) 1);
  20.298 +qed "prat_qinv_ex1";
  20.299 +
  20.300 +Goal "?! y. y * (x::prat) = $# Abs_pnat 1";
  20.301 +by (auto_tac (claset() addIs [prat_mult_qinv],simpset()));
  20.302 +by (dres_inst_tac [("f","%x. x*ya")] arg_cong 1);
  20.303 +by (asm_full_simp_tac (simpset() addsimps [prat_mult_assoc]) 1);
  20.304 +by (asm_full_simp_tac (simpset() addsimps [prat_mult_commute,
  20.305 +    prat_mult_1,prat_mult_1_right]) 1);
  20.306 +qed "prat_qinv_left_ex1";
  20.307 +
  20.308 +Goal "!!y. x * y = $# Abs_pnat 1 ==> x = qinv y";
  20.309 +by (cut_inst_tac [("q","y")] prat_mult_qinv 1);
  20.310 +by (res_inst_tac [("x1","y")] (prat_qinv_left_ex1 RS ex1E) 1);
  20.311 +by (Blast_tac 1);
  20.312 +qed "prat_mult_inv_qinv";
  20.313 +
  20.314 +Goal "? y. x = qinv y";
  20.315 +by (cut_inst_tac [("x","x")] prat_qinv_ex 1);
  20.316 +by (etac exE 1 THEN dtac prat_mult_inv_qinv 1);
  20.317 +by (Fast_tac 1);
  20.318 +qed "prat_as_inverse_ex";
  20.319 +
  20.320 +Goal "qinv(x*y) = qinv(x)*qinv(y)";
  20.321 +by (res_inst_tac [("z","x")] eq_Abs_prat 1);
  20.322 +by (res_inst_tac [("z","y")] eq_Abs_prat 1);
  20.323 +by (auto_tac (claset(),simpset() addsimps [qinv,prat_mult]));
  20.324 +qed "qinv_mult_eq";
  20.325 +
  20.326 +(** Lemmas **)
  20.327 +
  20.328 +qed_goal "prat_add_assoc_cong" thy
  20.329 +    "!!z. (z::prat) + v = z' + v' ==> z + (v + w) = z' + (v' + w)"
  20.330 + (fn _ => [(asm_simp_tac (simpset() addsimps [prat_add_assoc RS sym]) 1)]);
  20.331 +
  20.332 +qed_goal "prat_add_assoc_swap" thy "(z::prat) + (v + w) = v + (z + w)"
  20.333 + (fn _ => [(REPEAT (ares_tac [prat_add_commute RS prat_add_assoc_cong] 1))]);
  20.334 +
  20.335 +Goal "((z1::prat) + z2) * w = (z1 * w) + (z2 * w)";
  20.336 +by (res_inst_tac [("z","z1")] eq_Abs_prat 1);
  20.337 +by (res_inst_tac [("z","z2")] eq_Abs_prat 1);
  20.338 +by (res_inst_tac [("z","w")] eq_Abs_prat 1);
  20.339 +by (asm_simp_tac 
  20.340 +    (simpset() addsimps ([pnat_add_mult_distrib2, prat_add, prat_mult] @ 
  20.341 +                        pnat_add_ac @ pnat_mult_ac)) 1);
  20.342 +qed "prat_add_mult_distrib";
  20.343 +
  20.344 +val prat_mult_commute'= read_instantiate [("z","w")] prat_mult_commute;
  20.345 +
  20.346 +Goal "(w::prat) * (z1 + z2) = (w * z1) + (w * z2)";
  20.347 +by (simp_tac (simpset() addsimps [prat_mult_commute',prat_add_mult_distrib]) 1);
  20.348 +qed "prat_add_mult_distrib2";
  20.349 +
  20.350 +val prat_mult_simps = [prat_mult_1, prat_mult_1_right, 
  20.351 +                       prat_mult_qinv, prat_mult_qinv_right];
  20.352 +Addsimps prat_mult_simps;
  20.353 +
  20.354 +      (*** theorems for ordering ***)
  20.355 +(* prove introduction and elimination rules for prat_less *)
  20.356 +
  20.357 +Goalw [prat_less_def]
  20.358 +    "Q1 < (Q2::prat) = (EX Q3. Q1 + Q3 = Q2)";
  20.359 +by (Fast_tac 1);
  20.360 +qed "prat_less_iff";
  20.361 +
  20.362 +Goalw [prat_less_def]
  20.363 +      "!!(Q1::prat). Q1 + Q3 = Q2 ==> Q1 < Q2";
  20.364 +by (Fast_tac  1);
  20.365 +qed "prat_lessI";
  20.366 +
  20.367 +(* ordering on positive fractions in terms of existence of sum *)
  20.368 +Goalw [prat_less_def]
  20.369 +      "Q1 < (Q2::prat) --> (EX Q3. Q1 + Q3 = Q2)";
  20.370 +by (Fast_tac 1);
  20.371 +qed "prat_lessE_lemma";
  20.372 +
  20.373 +Goal 
  20.374 +     "!! Q1. [| Q1 < (Q2::prat); \
  20.375 +\        !! (Q3::prat). Q1 + Q3 = Q2 ==> P |] \
  20.376 +\     ==> P";
  20.377 +by (dtac (prat_lessE_lemma RS mp) 1);
  20.378 +by Auto_tac;
  20.379 +qed "prat_lessE";
  20.380 +
  20.381 +(* qless is a strong order i.e nonreflexive and transitive *)
  20.382 +Goal 
  20.383 +     "!!(q1::prat). [| q1 < q2; q2 < q3 |] ==> q1 < q3";
  20.384 +by (REPEAT(dtac (prat_lessE_lemma RS mp) 1));
  20.385 +by (REPEAT(etac exE 1));
  20.386 +by (hyp_subst_tac 1);
  20.387 +by (res_inst_tac [("Q3.0","Q3 + Q3a")] prat_lessI 1);
  20.388 +by (auto_tac (claset(),simpset() addsimps [prat_add_assoc]));
  20.389 +qed "prat_less_trans";
  20.390 +
  20.391 +Goal "~q < (q::prat)";
  20.392 +by (EVERY1[rtac notI, dtac (prat_lessE_lemma RS mp)]);
  20.393 +by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  20.394 +by (res_inst_tac [("z","Q3")] eq_Abs_prat 1);
  20.395 +by (etac exE 1 THEN res_inst_tac [("z","Q3a")] eq_Abs_prat 1);
  20.396 +by (REPEAT(hyp_subst_tac 1));
  20.397 +by (asm_full_simp_tac (simpset() addsimps [prat_add,
  20.398 +    pnat_no_add_ident,pnat_add_mult_distrib2] @ pnat_mult_ac) 1);
  20.399 +qed "prat_less_not_refl";
  20.400 +
  20.401 +(*** y < y ==> P ***)
  20.402 +bind_thm("prat_less_irrefl",prat_less_not_refl RS notE);
  20.403 +
  20.404 +Goal "!! (q1::prat). [| q1 < q2; q2 < q1 |] ==> P";
  20.405 +by (dtac prat_less_trans 1 THEN assume_tac 1);
  20.406 +by (asm_full_simp_tac (simpset() addsimps [prat_less_not_refl]) 1);
  20.407 +qed "prat_less_asym";
  20.408 +
  20.409 +Goal "!! (q1::prat). q1 < q2 ==> ~ q2 < q1";
  20.410 +by (auto_tac (claset() addSDs [prat_less_asym],simpset()));
  20.411 +qed "prat_less_not_sym";
  20.412 +
  20.413 +(* half of positive fraction exists- Gleason p. 120- Proposition 9-2.6(i)*)
  20.414 +Goal "!(q::prat). ? x. x + x = q";
  20.415 +by (rtac allI 1);
  20.416 +by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  20.417 +by (res_inst_tac [("x","Abs_prat (ratrel ^^ {(x, y+y)})")] exI 1);
  20.418 +by (auto_tac (claset(),simpset() addsimps 
  20.419 +              [prat_add,pnat_mult_assoc RS sym,pnat_add_mult_distrib,
  20.420 +               pnat_add_mult_distrib2]));
  20.421 +qed "lemma_prat_dense";
  20.422 +
  20.423 +Goal "? (x::prat). x + x = q";
  20.424 +by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  20.425 +by (res_inst_tac [("x","Abs_prat (ratrel ^^ {(x, y+y)})")] exI 1);
  20.426 +by (auto_tac (claset(),simpset() addsimps 
  20.427 +              [prat_add,pnat_mult_assoc RS sym,pnat_add_mult_distrib,
  20.428 +               pnat_add_mult_distrib2]));
  20.429 +qed "prat_lemma_dense";
  20.430 +
  20.431 +(* there exists a number between any two positive fractions *)
  20.432 +(* Gleason p. 120- Proposition 9-2.6(iv) *)
  20.433 +Goalw [prat_less_def] 
  20.434 +      "!! (q1::prat). q1 < q2 ==> ? x. q1 < x & x < q2";
  20.435 +by (auto_tac (claset() addIs [lemma_prat_dense],simpset()));
  20.436 +by (res_inst_tac [("x","T")] (lemma_prat_dense RS allE) 1);
  20.437 +by (etac exE 1);
  20.438 +by (res_inst_tac [("x","q1 + x")] exI 1);
  20.439 +by (auto_tac (claset() addIs [prat_lemma_dense],
  20.440 +    simpset() addsimps [prat_add_assoc]));
  20.441 +qed "prat_dense";
  20.442 +
  20.443 +(* ordering of addition for positive fractions *)
  20.444 +Goalw [prat_less_def] 
  20.445 +      "!!(q1::prat). q1 < q2 ==> q1 + x < q2 + x";
  20.446 +by (Step_tac 1);
  20.447 +by (res_inst_tac [("x","T")] exI 1);
  20.448 +by (auto_tac (claset(),simpset() addsimps prat_add_ac));
  20.449 +qed "prat_add_less2_mono1";
  20.450 +
  20.451 +Goal  
  20.452 +      "!!(q1::prat). q1 < q2 ==> x + q1 < x + q2";
  20.453 +by (auto_tac (claset() addIs [prat_add_less2_mono1],
  20.454 +    simpset() addsimps [prat_add_commute]));
  20.455 +qed "prat_add_less2_mono2";
  20.456 +
  20.457 +(* ordering of multiplication for positive fractions *)
  20.458 +Goalw [prat_less_def] 
  20.459 +      "!!(q1::prat). q1 < q2 ==> q1 * x < q2 * x";
  20.460 +by (Step_tac 1);
  20.461 +by (res_inst_tac [("x","T*x")] exI 1);
  20.462 +by (auto_tac (claset(),simpset() addsimps [prat_add_mult_distrib]));
  20.463 +qed "prat_mult_less2_mono1";
  20.464 +
  20.465 +Goal "!!(q1::prat). q1 < q2  ==> x * q1 < x * q2";
  20.466 +by (auto_tac (claset() addDs [prat_mult_less2_mono1],
  20.467 +    simpset() addsimps [prat_mult_commute]));
  20.468 +qed "prat_mult_left_less2_mono1";
  20.469 +
  20.470 +(* there is no smallest positive fraction *)
  20.471 +Goalw [prat_less_def] "? (x::prat). x < y";
  20.472 +by (cut_facts_tac [lemma_prat_dense] 1);
  20.473 +by (Fast_tac 1);
  20.474 +qed "qless_Ex";
  20.475 +
  20.476 +(* lemma for proving $< is linear *)
  20.477 +Goalw [prat_def,prat_less_def] 
  20.478 +      "ratrel ^^ {(x, y * ya)} : {p::(pnat*pnat).True}/ratrel";
  20.479 +by (asm_full_simp_tac (simpset() addsimps [ratrel_def,quotient_def]) 1);
  20.480 +by (Blast_tac 1);
  20.481 +qed "lemma_prat_less_linear";
  20.482 +
  20.483 +(* linearity of < -- Gleason p. 120 - Proposition 9-2.6 *)
  20.484 +(*** FIXME Proof long ***)
  20.485 +Goalw [prat_less_def] 
  20.486 +      "(q1::prat) < q2 | q1 = q2 | q2 < q1";
  20.487 +by (res_inst_tac [("z","q1")] eq_Abs_prat 1);
  20.488 +by (res_inst_tac [("z","q2")] eq_Abs_prat 1);
  20.489 +by (Step_tac 1 THEN REPEAT(dtac (not_ex RS iffD1) 1) 
  20.490 +               THEN Auto_tac);
  20.491 +by (cut_inst_tac  [("z1.0","x*ya"),
  20.492 +   ("z2.0","xa*y")] pnat_linear_Ex_eq 1);
  20.493 +by (EVERY1[etac disjE,etac exE]);
  20.494 +by (eres_inst_tac 
  20.495 +    [("x","Abs_prat(ratrel^^{(xb,ya*y)})")] allE 1);
  20.496 +by (asm_full_simp_tac 
  20.497 +    (simpset() addsimps [prat_add, pnat_mult_assoc 
  20.498 +     RS sym,pnat_add_mult_distrib RS sym]) 1);
  20.499 +by (EVERY1[asm_full_simp_tac (simpset() addsimps pnat_mult_ac),
  20.500 +    etac disjE, assume_tac, etac exE]);
  20.501 +by (thin_tac "!T. Abs_prat (ratrel ^^ {(x, y)}) + T ~= \
  20.502 +\     Abs_prat (ratrel ^^ {(xa, ya)})" 1);
  20.503 +by (eres_inst_tac [("x","Abs_prat(ratrel^^{(xb,y*ya)})")] allE 1);
  20.504 +by (asm_full_simp_tac (simpset() addsimps [prat_add,
  20.505 +      pnat_mult_assoc RS sym,pnat_add_mult_distrib RS sym]) 1);
  20.506 +by (asm_full_simp_tac (simpset() addsimps pnat_mult_ac) 1);
  20.507 +qed "prat_linear";
  20.508 +
  20.509 +Goal
  20.510 +    "!!(q1::prat). [| q1 < q2 ==> P;  q1 = q2 ==> P; \
  20.511 +\          q2 < q1 ==> P |] ==> P";
  20.512 +by (cut_inst_tac [("q1.0","q1"),("q2.0","q2")] prat_linear 1);
  20.513 +by Auto_tac;
  20.514 +qed "prat_linear_less2";
  20.515 +
  20.516 +(* Gleason p. 120 -- 9-2.6 (iv) *)
  20.517 +Goal 
  20.518 + "!!(q1::prat). [| q1 < q2; qinv(q1) = qinv(q2) |] ==> P";
  20.519 +by (cut_inst_tac [("x","qinv (q2)"),("q1.0","q1"),
  20.520 +   ("q2.0","q2")] prat_mult_less2_mono1 1);
  20.521 +by (assume_tac 1);
  20.522 +by (Asm_full_simp_tac 1 THEN dtac sym 1);
  20.523 +by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  20.524 +qed "lemma1_qinv_prat_less";
  20.525 +
  20.526 +Goal 
  20.527 + "!!(q1::prat). [| q1 < q2; qinv(q1) < qinv(q2) |] ==> P";
  20.528 +by (cut_inst_tac [("x","qinv (q2)"),("q1.0","q1"),
  20.529 +   ("q2.0","q2")] prat_mult_less2_mono1 1);
  20.530 +by (assume_tac 1);
  20.531 +by (cut_inst_tac [("x","q1"),("q1.0","qinv (q1)"),
  20.532 +   ("q2.0","qinv (q2)")] prat_mult_left_less2_mono1 1);
  20.533 +by Auto_tac;
  20.534 +by (dres_inst_tac [("q2.0","$#Abs_pnat 1")] prat_less_trans 1);
  20.535 +by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  20.536 +qed "lemma2_qinv_prat_less";
  20.537 +
  20.538 +Goal 
  20.539 +      "!!(q1::prat). q1 < q2  ==> qinv (q2) < qinv (q1)";
  20.540 +by (res_inst_tac [("q2.0","qinv q1"),
  20.541 +         ("q1.0","qinv q2")] prat_linear_less2 1);
  20.542 +by (auto_tac (claset() addEs [lemma1_qinv_prat_less,
  20.543 +                 lemma2_qinv_prat_less],simpset()));
  20.544 +qed "qinv_prat_less";
  20.545 +
  20.546 +Goal "!!(q1::prat). q1 < $#Abs_pnat 1 ==> $#Abs_pnat 1 < qinv(q1)";
  20.547 +by (dtac qinv_prat_less 1);
  20.548 +by (full_simp_tac (simpset() addsimps [qinv_1]) 1);
  20.549 +qed "prat_qinv_gt_1";
  20.550 +
  20.551 +Goalw [pnat_one_def] "!!(q1::prat). q1 < $#1p ==> $#1p < qinv(q1)";
  20.552 +by (etac prat_qinv_gt_1 1);
  20.553 +qed "prat_qinv_is_gt_1";
  20.554 +
  20.555 +Goalw [prat_less_def] "$#Abs_pnat 1 < $#Abs_pnat 1 + $#Abs_pnat 1";
  20.556 +by (Fast_tac 1); 
  20.557 +qed "prat_less_1_2";
  20.558 +
  20.559 +Goal "qinv($#Abs_pnat 1 + $#Abs_pnat 1) < $#Abs_pnat 1";
  20.560 +by (cut_facts_tac [prat_less_1_2 RS qinv_prat_less] 1);
  20.561 +by (asm_full_simp_tac (simpset() addsimps [qinv_1]) 1);
  20.562 +qed "prat_less_qinv_2_1";
  20.563 +
  20.564 +Goal "!!(x::prat). x < y ==> x*qinv(y) < $#Abs_pnat 1";
  20.565 +by (dres_inst_tac [("x","qinv(y)")] prat_mult_less2_mono1 1);
  20.566 +by (Asm_full_simp_tac 1);
  20.567 +qed "prat_mult_qinv_less_1";
  20.568 +
  20.569 +Goal "(x::prat) < x + x";
  20.570 +by (cut_inst_tac [("x","x")] 
  20.571 +    (prat_less_1_2 RS prat_mult_left_less2_mono1) 1);
  20.572 +by (asm_full_simp_tac (simpset() addsimps 
  20.573 +    [prat_add_mult_distrib2]) 1);
  20.574 +qed "prat_self_less_add_self";
  20.575 +
  20.576 +Goalw [prat_less_def] "(x::prat) < y + x";
  20.577 +by (res_inst_tac [("x","y")] exI 1);
  20.578 +by (simp_tac (simpset() addsimps [prat_add_commute]) 1);
  20.579 +qed "prat_self_less_add_right";
  20.580 +
  20.581 +Goal "(x::prat) < x + y";
  20.582 +by (rtac (prat_add_commute RS subst) 1);
  20.583 +by (simp_tac (simpset() addsimps [prat_self_less_add_right]) 1);
  20.584 +qed "prat_self_less_add_left";
  20.585 +
  20.586 +Goalw [prat_less_def] "!!y. $#1p < y ==> (x::prat) < x * y";
  20.587 +by (auto_tac (claset(),simpset() addsimps [pnat_one_def,
  20.588 +    prat_add_mult_distrib2]));
  20.589 +qed "prat_self_less_mult_right";
  20.590 +
  20.591 +(*** Properties of <= ***)
  20.592 +
  20.593 +Goalw [prat_le_def] "!!w. ~(w < z) ==> z <= (w::prat)";
  20.594 +by (assume_tac 1);
  20.595 +qed "prat_leI";
  20.596 +
  20.597 +Goalw [prat_le_def] "!!w. z<=w ==> ~(w<(z::prat))";
  20.598 +by (assume_tac 1);
  20.599 +qed "prat_leD";
  20.600 +
  20.601 +val prat_leE = make_elim prat_leD;
  20.602 +
  20.603 +Goal "!!w. (~(w < z)) = (z <= (w::prat))";
  20.604 +by (fast_tac (claset() addSIs [prat_leI,prat_leD]) 1);
  20.605 +qed "prat_less_le_iff";
  20.606 +
  20.607 +Goalw [prat_le_def] "!!z. ~ z <= w ==> w<(z::prat)";
  20.608 +by (Fast_tac 1);
  20.609 +qed "not_prat_leE";
  20.610 +
  20.611 +Goalw [prat_le_def] "!!z. z < w ==> z <= (w::prat)";
  20.612 +by (fast_tac (claset() addEs [prat_less_asym]) 1);
  20.613 +qed "prat_less_imp_le";
  20.614 +
  20.615 +Goalw [prat_le_def] "!!(x::prat). x <= y ==> x < y | x = y";
  20.616 +by (cut_facts_tac [prat_linear] 1);
  20.617 +by (fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym]) 1);
  20.618 +qed "prat_le_imp_less_or_eq";
  20.619 +
  20.620 +Goalw [prat_le_def] "!!z. z<w | z=w ==> z <=(w::prat)";
  20.621 +by (cut_facts_tac [prat_linear] 1);
  20.622 +by (fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym]) 1);
  20.623 +qed "prat_less_or_eq_imp_le";
  20.624 +
  20.625 +Goal "(x <= (y::prat)) = (x < y | x=y)";
  20.626 +by (REPEAT(ares_tac [iffI, prat_less_or_eq_imp_le, prat_le_imp_less_or_eq] 1));
  20.627 +qed "prat_le_eq_less_or_eq";
  20.628 +
  20.629 +Goal "w <= (w::prat)";
  20.630 +by (simp_tac (simpset() addsimps [prat_le_eq_less_or_eq]) 1);
  20.631 +qed "prat_le_refl";
  20.632 +
  20.633 +val prems = goal thy "!!i. [| i <= j; j < k |] ==> i < (k::prat)";
  20.634 +by (dtac prat_le_imp_less_or_eq 1);
  20.635 +by (fast_tac (claset() addIs [prat_less_trans]) 1);
  20.636 +qed "prat_le_less_trans";
  20.637 +
  20.638 +Goal "!! (i::prat). [| i < j; j <= k |] ==> i < k";
  20.639 +by (dtac prat_le_imp_less_or_eq 1);
  20.640 +by (fast_tac (claset() addIs [prat_less_trans]) 1);
  20.641 +qed "prat_less_le_trans";
  20.642 +
  20.643 +Goal "!!i. [| i <= j; j <= k |] ==> i <= (k::prat)";
  20.644 +by (EVERY1 [dtac prat_le_imp_less_or_eq, dtac prat_le_imp_less_or_eq,
  20.645 +            rtac prat_less_or_eq_imp_le, fast_tac (claset() addIs [prat_less_trans])]);
  20.646 +qed "prat_le_trans";
  20.647 +
  20.648 +Goal "!!z. [| z <= w; w <= z |] ==> z = (w::prat)";
  20.649 +by (EVERY1 [dtac prat_le_imp_less_or_eq, dtac prat_le_imp_less_or_eq,
  20.650 +            fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym])]);
  20.651 +qed "prat_le_anti_sym";
  20.652 +
  20.653 +Goal "!!x. [| ~ y < x; y ~= x |] ==> x < (y::prat)";
  20.654 +by (rtac not_prat_leE 1);
  20.655 +by (fast_tac (claset() addDs [prat_le_imp_less_or_eq]) 1);
  20.656 +qed "not_less_not_eq_prat_less";
  20.657 +
  20.658 +Goalw [prat_less_def] 
  20.659 +      "!!x. [| x1 < y1; x2 < y2 |] ==> x1 + x2 < y1 + (y2::prat)";
  20.660 +by (REPEAT(etac exE 1));
  20.661 +by (res_inst_tac [("x","T+Ta")] exI 1);
  20.662 +by (auto_tac (claset(),simpset() addsimps prat_add_ac));
  20.663 +qed "prat_add_less_mono";
  20.664 +
  20.665 +Goalw [prat_less_def] 
  20.666 +      "!!x. [| x1 < y1; x2 < y2 |] ==> x1 * x2 < y1 * (y2::prat)";
  20.667 +by (REPEAT(etac exE 1));
  20.668 +by (res_inst_tac [("x","T*Ta+T*x2+x1*Ta")] exI 1);
  20.669 +by (auto_tac (claset(),simpset() addsimps prat_add_ac @ 
  20.670 +    [prat_add_mult_distrib,prat_add_mult_distrib2]));
  20.671 +qed "prat_mult_less_mono";
  20.672 +
  20.673 +(* more prat_le *)
  20.674 +Goal "!!(q1::prat). q1 <= q2  ==> x * q1 <= x * q2";
  20.675 +by (dtac prat_le_imp_less_or_eq 1);
  20.676 +by (Step_tac 1);
  20.677 +by (auto_tac (claset() addSIs [prat_le_refl,
  20.678 +    prat_less_imp_le,prat_mult_left_less2_mono1],simpset()));
  20.679 +qed "prat_mult_left_le2_mono1";
  20.680 +
  20.681 +Goal "!!(q1::prat). q1 <= q2  ==> q1 * x <= q2 * x";
  20.682 +by (auto_tac (claset() addDs [prat_mult_left_le2_mono1],
  20.683 +    simpset() addsimps [prat_mult_commute]));
  20.684 +qed "prat_mult_le2_mono1";
  20.685 +
  20.686 +Goal 
  20.687 +      "!!(q1::prat). q1 <= q2  ==> qinv (q2) <= qinv (q1)";
  20.688 +by (dtac prat_le_imp_less_or_eq 1);
  20.689 +by (Step_tac 1);
  20.690 +by (auto_tac (claset() addSIs [prat_le_refl,
  20.691 +    prat_less_imp_le,qinv_prat_less],simpset()));
  20.692 +qed "qinv_prat_le";
  20.693 +
  20.694 +Goal "!!(q1::prat). q1 <= q2  ==> x + q1 <= x + q2";
  20.695 +by (dtac prat_le_imp_less_or_eq 1);
  20.696 +by (Step_tac 1);
  20.697 +by (auto_tac (claset() addSIs [prat_le_refl,
  20.698 +    prat_less_imp_le,prat_add_less2_mono1],
  20.699 +    simpset() addsimps [prat_add_commute]));
  20.700 +qed "prat_add_left_le2_mono1";
  20.701 +
  20.702 +Goal "!!(q1::prat). q1 <= q2  ==> q1 + x <= q2 + x";
  20.703 +by (auto_tac (claset() addDs [prat_add_left_le2_mono1],
  20.704 +    simpset() addsimps [prat_add_commute]));
  20.705 +qed "prat_add_le2_mono1";
  20.706 +
  20.707 +Goal "!!k l::prat. [|i<=j;  k<=l |] ==> i + k <= j + l";
  20.708 +by (etac (prat_add_le2_mono1 RS prat_le_trans) 1);
  20.709 +by (simp_tac (simpset() addsimps [prat_add_commute]) 1);
  20.710 +(*j moves to the end because it is free while k, l are bound*)
  20.711 +by (etac prat_add_le2_mono1 1);
  20.712 +qed "prat_add_le_mono";
  20.713 +
  20.714 +Goal "!!(x::prat). x + y < z + y ==> x < z";
  20.715 +by (rtac ccontr 1);
  20.716 +by (etac (prat_leI RS prat_le_imp_less_or_eq RS disjE) 1);
  20.717 +by (dres_inst_tac [("x","y"),("q1.0","z")] prat_add_less2_mono1 1);
  20.718 +by (auto_tac (claset() addIs [prat_less_asym],
  20.719 +    simpset() addsimps [prat_less_not_refl]));
  20.720 +qed "prat_add_right_less_cancel";
  20.721 +
  20.722 +Goal "!!(x::prat). y + x < y + z ==> x < z";
  20.723 +by (res_inst_tac [("y","y")] prat_add_right_less_cancel 1);
  20.724 +by (asm_full_simp_tac (simpset() addsimps [prat_add_commute]) 1);
  20.725 +qed "prat_add_left_less_cancel";
  20.726 +
  20.727 +(*** lemmas required for lemma_gleason9_34 in PReal : w*y > y/z ***)
  20.728 +Goalw [prat_pnat_def] "Abs_prat(ratrel^^{(x,y)}) = $#x*qinv($#y)";
  20.729 +by (auto_tac (claset(),simpset() addsimps [prat_mult,qinv,pnat_mult_1_left,
  20.730 +    pnat_mult_1]));
  20.731 +qed "Abs_prat_mult_qinv";
  20.732 +
  20.733 +Goal "Abs_prat(ratrel^^{(x,y)}) <= Abs_prat(ratrel^^{(x,Abs_pnat 1)})";
  20.734 +by (simp_tac (simpset() addsimps [Abs_prat_mult_qinv]) 1);
  20.735 +by (rtac prat_mult_left_le2_mono1 1);
  20.736 +by (rtac qinv_prat_le 1);
  20.737 +by (pnat_ind_tac "y" 1);
  20.738 +by (dres_inst_tac [("x","$#Abs_pnat 1")] prat_add_le2_mono1 2);
  20.739 +by (cut_facts_tac [prat_less_1_2 RS prat_less_imp_le] 2);
  20.740 +by (auto_tac (claset() addIs [prat_le_trans],
  20.741 +    simpset() addsimps [prat_le_refl,
  20.742 +    pSuc_is_plus_one,pnat_one_def,prat_pnat_add]));
  20.743 +qed "lemma_Abs_prat_le1";
  20.744 +
  20.745 +Goal "Abs_prat(ratrel^^{(x,Abs_pnat 1)}) <= Abs_prat(ratrel^^{(x*y,Abs_pnat 1)})";
  20.746 +by (simp_tac (simpset() addsimps [Abs_prat_mult_qinv]) 1);
  20.747 +by (rtac prat_mult_le2_mono1 1);
  20.748 +by (pnat_ind_tac "y" 1);
  20.749 +by (dres_inst_tac [("x","$#x")] prat_add_le2_mono1 2);
  20.750 +by (cut_inst_tac [("z","$#x")] (prat_self_less_add_self 
  20.751 +    RS prat_less_imp_le) 2);
  20.752 +by (auto_tac (claset() addIs [prat_le_trans],
  20.753 +    simpset() addsimps [prat_le_refl,
  20.754 +    pSuc_is_plus_one,pnat_one_def,prat_add_mult_distrib2,
  20.755 +    prat_pnat_add,prat_pnat_mult]));
  20.756 +qed "lemma_Abs_prat_le2";
  20.757 +
  20.758 +Goal "Abs_prat(ratrel^^{(x,z)}) <= Abs_prat(ratrel^^{(x*y,Abs_pnat 1)})";
  20.759 +by (fast_tac (claset() addIs [prat_le_trans,lemma_Abs_prat_le1,lemma_Abs_prat_le2]) 1);
  20.760 +qed "lemma_Abs_prat_le3";
  20.761 +
  20.762 +Goal "Abs_prat(ratrel^^{(x*y,Abs_pnat 1)}) * Abs_prat(ratrel^^{(w,x)}) = \
  20.763 +\         Abs_prat(ratrel^^{(w*y,Abs_pnat 1)})";
  20.764 +by (full_simp_tac (simpset() addsimps [prat_mult,
  20.765 +    pnat_mult_1,pnat_mult_1_left] @ pnat_mult_ac) 1);
  20.766 +qed "pre_lemma_gleason9_34";
  20.767 +
  20.768 +Goal "Abs_prat(ratrel^^{(y*x,Abs_pnat 1*y)}) = \
  20.769 +\         Abs_prat(ratrel^^{(x,Abs_pnat 1)})";
  20.770 +by (auto_tac (claset(),simpset() addsimps 
  20.771 +    [pnat_mult_1,pnat_mult_1_left] @ pnat_mult_ac));
  20.772 +qed "pre_lemma_gleason9_34b";
  20.773 +
  20.774 +Goal "($#n < $#m) = (n < m)";
  20.775 +by (auto_tac (claset(),simpset() addsimps [prat_less_def,
  20.776 +    pnat_less_iff,prat_pnat_add]));
  20.777 +by (res_inst_tac [("z","T")] eq_Abs_prat 1);
  20.778 +by (auto_tac (claset() addDs [pnat_eq_lessI],
  20.779 +    simpset() addsimps [prat_add,pnat_mult_1,
  20.780 +    pnat_mult_1_left,prat_pnat_def,pnat_less_iff RS sym]));
  20.781 +qed "prat_pnat_less_iff";
  20.782 +
  20.783 +Addsimps [prat_pnat_less_iff];
  20.784 +
  20.785 +(***)(***)(***)(***)(***)(***)(***)(***)(***)(***)(***)(***)(***)(***)
  20.786 +
  20.787 +(*** prove witness that will be required to prove non-emptiness ***)
  20.788 +(*** of preal type as defined using Dedekind Sections in PReal ***)
  20.789 +(*** Show that exists positive real `one' ***)
  20.790 +
  20.791 +Goal "? q. q: {x::prat. x < $#Abs_pnat 1}";
  20.792 +by (fast_tac (claset() addIs [prat_less_qinv_2_1]) 1);
  20.793 +qed "lemma_prat_less_1_memEx";
  20.794 +
  20.795 +Goal "{x::prat. x < $#Abs_pnat 1} ~= {}";
  20.796 +by (rtac notI 1);
  20.797 +by (cut_facts_tac [lemma_prat_less_1_memEx] 1);
  20.798 +by (Asm_full_simp_tac 1);
  20.799 +qed "lemma_prat_less_1_set_non_empty";
  20.800 +
  20.801 +Goalw [psubset_def] "{} < {x::prat. x < $#Abs_pnat 1}";
  20.802 +by (asm_full_simp_tac (simpset() addsimps 
  20.803 +         [lemma_prat_less_1_set_non_empty RS not_sym]) 1);
  20.804 +qed "empty_set_psubset_lemma_prat_less_1_set";
  20.805 +
  20.806 +(*** exists rational not in set --- $#Abs_pnat 1 itself ***)
  20.807 +Goal "? q. q ~: {x::prat. x < $#Abs_pnat 1}";
  20.808 +by (res_inst_tac [("x","$#Abs_pnat 1")] exI 1);
  20.809 +by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  20.810 +qed "lemma_prat_less_1_not_memEx";
  20.811 +
  20.812 +Goal "{x::prat. x < $#Abs_pnat 1} ~= {q::prat. True}";
  20.813 +by (rtac notI 1);
  20.814 +by (cut_facts_tac [lemma_prat_less_1_not_memEx] 1);
  20.815 +by (Asm_full_simp_tac 1);
  20.816 +qed "lemma_prat_less_1_set_not_rat_set";
  20.817 +
  20.818 +Goalw [psubset_def,subset_def] 
  20.819 +      "{x::prat. x < $#Abs_pnat 1} < {q::prat. True}";
  20.820 +by (asm_full_simp_tac (simpset() addsimps 
  20.821 +      [lemma_prat_less_1_set_not_rat_set,
  20.822 +       lemma_prat_less_1_not_memEx]) 1);
  20.823 +qed "lemma_prat_less_1_set_psubset_rat_set";
  20.824 +
  20.825 +(*** prove non_emptiness of type ***)
  20.826 +Goal "{x::prat. x < $#Abs_pnat 1} : {A. {} < A & A < {q::prat. True} & \
  20.827 +\                                        (!y: A. ((!z. z < y --> z: A) & \
  20.828 +\                                        (? u: A. y < u)))}";
  20.829 +by (auto_tac (claset() addDs [prat_less_trans],
  20.830 +    simpset() addsimps [empty_set_psubset_lemma_prat_less_1_set,
  20.831 +                       lemma_prat_less_1_set_psubset_rat_set]));
  20.832 +by (dtac prat_dense 1);
  20.833 +by (Fast_tac 1);
  20.834 +qed "preal_1";
  20.835 +
  20.836 +
  20.837 +
  20.838 +
  20.839 +
  20.840 +
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/HOL/Real/PRat.thy	Thu Jun 25 13:57:34 1998 +0200
    21.3 @@ -0,0 +1,49 @@
    21.4 +(*  Title       : PRat.thy
    21.5 +    Author      : Jacques D. Fleuriot
    21.6 +    Copyright   : 1998  University of Cambridge
    21.7 +    Description : The positive rationals
    21.8 +*) 
    21.9 +
   21.10 +PRat = PNat + Equiv +
   21.11 +
   21.12 +constdefs
   21.13 +    ratrel   ::  "((pnat * pnat) * (pnat * pnat)) set"
   21.14 +    "ratrel  ==  {p. ? x1 y1 x2 y2. p=((x1::pnat,y1),(x2,y2)) & x1*y2 = x2*y1}" 
   21.15 +
   21.16 +typedef prat = "{x::(pnat*pnat).True}/ratrel"          (Equiv.quotient_def)
   21.17 +
   21.18 +instance
   21.19 +   prat  :: {ord,plus,times}
   21.20 +
   21.21 +
   21.22 +constdefs
   21.23 +
   21.24 +  prat_pnat :: pnat => prat              ("$#_" [80] 80)
   21.25 +  "$# m     == Abs_prat(ratrel^^{(m,Abs_pnat 1)})"
   21.26 +
   21.27 +  qinv      :: prat => prat
   21.28 +  "qinv(Q)  == Abs_prat(UN p:Rep_prat(Q). split (%x y. ratrel^^{(y,x)}) p)" 
   21.29 +
   21.30 +defs
   21.31 +
   21.32 +  prat_add_def  
   21.33 +  "P + Q == Abs_prat(UN p1:Rep_prat(P). UN p2:Rep_prat(Q).
   21.34 +                split(%x1 y1. split(%x2 y2. ratrel^^{(x1*y2 + x2*y1, y1*y2)}) p2) p1)"
   21.35 +
   21.36 +  prat_mult_def  
   21.37 +  "P * Q == Abs_prat(UN p1:Rep_prat(P). UN p2:Rep_prat(Q).
   21.38 +                split(%x1 y1. split(%x2 y2. ratrel^^{(x1*x2, y1*y2)}) p2) p1)"
   21.39 + 
   21.40 +  (*** Gleason p. 119 ***)
   21.41 +  prat_less_def
   21.42 +  "P < (Q::prat) == ? T. P + T = Q"
   21.43 +
   21.44 +  prat_le_def
   21.45 +  "P <= (Q::prat) == ~(Q < P)" 
   21.46 +
   21.47 +end
   21.48 +  
   21.49 +
   21.50 +
   21.51 +
   21.52 +
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/HOL/Real/PReal.ML	Thu Jun 25 13:57:34 1998 +0200
    22.3 @@ -0,0 +1,1332 @@
    22.4 +(*  Title       : PReal.ML
    22.5 +    Author      : Jacques D. Fleuriot
    22.6 +    Copyright   : 1998  University of Cambridge
    22.7 +    Description : The positive reals as Dedekind sections of positive
    22.8 +                  rationals. Fundamentals of Abstract Analysis 
    22.9 +                  [Gleason- p. 121] provides some of the definitions.
   22.10 +*)
   22.11 +
   22.12 +open PReal;
   22.13 +
   22.14 +Goal "inj_on Abs_preal preal";
   22.15 +by (rtac inj_on_inverseI 1);
   22.16 +by (etac Abs_preal_inverse 1);
   22.17 +qed "inj_on_Abs_preal";
   22.18 +
   22.19 +Addsimps [inj_on_Abs_preal RS inj_on_iff];
   22.20 +
   22.21 +Goal "inj(Rep_preal)";
   22.22 +by (rtac inj_inverseI 1);
   22.23 +by (rtac Rep_preal_inverse 1);
   22.24 +qed "inj_Rep_preal";
   22.25 +
   22.26 +Goalw [preal_def] "{} ~: preal";
   22.27 +by (Fast_tac 1);
   22.28 +qed "empty_not_mem_preal";
   22.29 +
   22.30 +(* {} : preal ==> P *)
   22.31 +bind_thm ("empty_not_mem_prealE", empty_not_mem_preal RS notE);
   22.32 +
   22.33 +Addsimps [empty_not_mem_preal];
   22.34 +
   22.35 +Goalw [preal_def] "{x::prat. x < $#Abs_pnat 1} : preal";
   22.36 +by (rtac preal_1 1);
   22.37 +qed "one_set_mem_preal";
   22.38 +
   22.39 +Addsimps [one_set_mem_preal];
   22.40 +
   22.41 +Goalw [preal_def] "!!x. x : preal ==> {} < x";
   22.42 +by (Fast_tac 1);
   22.43 +qed "preal_psubset_empty";
   22.44 +
   22.45 +Goal "{} < Rep_preal x";
   22.46 +by (rtac (Rep_preal RS preal_psubset_empty) 1);
   22.47 +qed "Rep_preal_psubset_empty";
   22.48 +
   22.49 +Goal "? x. x: Rep_preal X";
   22.50 +by (cut_inst_tac [("x","X")]  Rep_preal_psubset_empty 1);
   22.51 +by (auto_tac (claset() addIs [(equals0I RS sym)],
   22.52 +              simpset() addsimps [psubset_def]));
   22.53 +qed "mem_Rep_preal_Ex";
   22.54 +
   22.55 +Goalw [preal_def] 
   22.56 +      "!!A. [| {} < A; A < {q::prat. True}; \
   22.57 +\              (!y: A. ((!z. z < y --> z: A) & \
   22.58 +\                        (? u: A. y < u))) |] ==> A : preal";
   22.59 +by (Fast_tac 1);
   22.60 +qed "prealI1";
   22.61 +    
   22.62 +Goalw [preal_def] 
   22.63 +      "!!A. [| {} < A; A < {q::prat. True}; \
   22.64 +\              !y: A. (!z. z < y --> z: A); \
   22.65 +\              !y: A. (? u: A. y < u) |] ==> A : preal";
   22.66 +by (Best_tac 1);
   22.67 +qed "prealI2";
   22.68 +
   22.69 +Goalw [preal_def] 
   22.70 +      "!!A. A : preal ==> {} < A & A < {q::prat. True} & \
   22.71 +\                         (!y: A. ((!z. z < y --> z: A) & \
   22.72 +\                                  (? u: A. y < u)))";
   22.73 +by (Fast_tac 1);
   22.74 +qed "prealE_lemma";
   22.75 +
   22.76 +
   22.77 +AddSIs [prealI1,prealI2];
   22.78 +
   22.79 +Addsimps [Abs_preal_inverse];
   22.80 +
   22.81 +
   22.82 +Goalw [preal_def] 
   22.83 +      "!!A. A : preal ==> {} < A";
   22.84 +by (Fast_tac 1);
   22.85 +qed "prealE_lemma1";
   22.86 +
   22.87 +Goalw [preal_def] 
   22.88 +      "!!A. A : preal ==> A < {q::prat. True}";
   22.89 +by (Fast_tac 1);
   22.90 +qed "prealE_lemma2";
   22.91 +
   22.92 +Goalw [preal_def] 
   22.93 +      "!!A. A : preal ==> !y: A. (!z. z < y --> z: A)";
   22.94 +by (Fast_tac 1);
   22.95 +qed "prealE_lemma3";
   22.96 +
   22.97 +Goal 
   22.98 +      "!!A. [| A : preal; y: A |] ==> (!z. z < y --> z: A)";
   22.99 +by (fast_tac (claset() addSDs [prealE_lemma3]) 1);
  22.100 +qed "prealE_lemma3a";
  22.101 +
  22.102 +Goal 
  22.103 +      "!!A. [| A : preal; y: A; z < y |] ==> z: A";
  22.104 +by (fast_tac (claset() addSDs [prealE_lemma3a]) 1);
  22.105 +qed "prealE_lemma3b";
  22.106 +
  22.107 +Goalw [preal_def] 
  22.108 +      "!!A. A : preal ==> !y: A. (? u: A. y < u)";
  22.109 +by (Fast_tac 1);
  22.110 +qed "prealE_lemma4";
  22.111 +
  22.112 +Goal 
  22.113 +      "!!A. [| A : preal; y: A |] ==> ? u: A. y < u";
  22.114 +by (fast_tac (claset() addSDs [prealE_lemma4]) 1);
  22.115 +qed "prealE_lemma4a";
  22.116 +
  22.117 +Goal "? x. x~: Rep_preal X";
  22.118 +by (cut_inst_tac [("x","X")] Rep_preal 1);
  22.119 +by (dtac prealE_lemma2 1);
  22.120 +by (rtac ccontr 1);
  22.121 +by (auto_tac (claset(),simpset() addsimps [psubset_def]));
  22.122 +by (blast_tac (claset() addIs [set_ext] addEs [swap]) 1);
  22.123 +qed "not_mem_Rep_preal_Ex";
  22.124 +
  22.125 +(** prat_pnat: the injection from prat to preal **)
  22.126 +(** A few lemmas **)
  22.127 +Goal "{} < {xa::prat. xa < y}";
  22.128 +by (cut_facts_tac [qless_Ex] 1);
  22.129 +by (auto_tac (claset() addEs [equalityCE],
  22.130 +              simpset() addsimps [psubset_def]));
  22.131 +qed "lemma_prat_less_set_Ex";
  22.132 +
  22.133 +Goal "{xa::prat. xa < y} : preal";
  22.134 +by (cut_facts_tac [qless_Ex] 1);
  22.135 +by Safe_tac;
  22.136 +by (rtac lemma_prat_less_set_Ex 1);
  22.137 +by (auto_tac (claset() addIs [prat_less_trans],
  22.138 +    simpset() addsimps [psubset_def]));
  22.139 +by (eres_inst_tac [("c","y")] equalityCE 1);
  22.140 +by (auto_tac (claset() addDs [prat_less_irrefl],simpset()));
  22.141 +by (dres_inst_tac [("q1.0","ya")] prat_dense 1);
  22.142 +by (Fast_tac 1);
  22.143 +qed "lemma_prat_less_set_mem_preal";
  22.144 +
  22.145 +Goal "!!(x::prat). {xa. xa < x} = {x. x < y} ==> x = y";
  22.146 +by (cut_inst_tac [("q1.0","x"),("q2.0","y")] prat_linear 1);
  22.147 +by Auto_tac;
  22.148 +by (dtac prat_dense 1 THEN etac exE 1);
  22.149 +by (eres_inst_tac [("c","xa")] equalityCE 1);
  22.150 +by (auto_tac (claset() addDs [prat_less_asym],simpset()));
  22.151 +by (dtac prat_dense 1 THEN etac exE 1);
  22.152 +by (eres_inst_tac [("c","xa")] equalityCE 1);
  22.153 +by (auto_tac (claset() addDs [prat_less_asym],simpset()));
  22.154 +qed "lemma_prat_set_eq";
  22.155 +
  22.156 +Goal "inj(preal_prat)";
  22.157 +by (rtac injI 1);
  22.158 +by (rewtac preal_prat_def);
  22.159 +by (dtac (inj_on_Abs_preal RS inj_onD) 1);
  22.160 +by (rtac lemma_prat_less_set_mem_preal 1);
  22.161 +by (rtac lemma_prat_less_set_mem_preal 1);
  22.162 +by (etac lemma_prat_set_eq 1);
  22.163 +qed "inj_preal_prat";
  22.164 +
  22.165 +      (*** theorems for ordering ***)
  22.166 +(* prove introduction and elimination rules for preal_less *)
  22.167 +
  22.168 +Goalw [preal_less_def]
  22.169 +      "R1 < (R2::preal) = (Rep_preal(R1) < Rep_preal(R2))";
  22.170 +by (Fast_tac 1);
  22.171 +qed "preal_less_iff";
  22.172 +
  22.173 +Goalw [preal_less_def]
  22.174 +      "!! (R1::preal). R1 < R2 ==> (Rep_preal(R1) < Rep_preal(R2))";
  22.175 +by (Fast_tac  1);
  22.176 +qed "preal_lessI";
  22.177 +
  22.178 +Goalw [preal_less_def]
  22.179 +      "R1 < (R2::preal) --> (Rep_preal(R1) < Rep_preal(R2))";
  22.180 +by (Fast_tac  1);
  22.181 +qed "preal_lessE_lemma";
  22.182 +
  22.183 +Goal 
  22.184 +     "!! R1. [| R1 < (R2::preal); \
  22.185 +\               (Rep_preal(R1) < Rep_preal(R2)) ==> P |] \
  22.186 +\     ==> P";
  22.187 +by (dtac (preal_lessE_lemma RS mp) 1);
  22.188 +by Auto_tac;
  22.189 +qed "preal_lessE";
  22.190 +
  22.191 +(* A positive fraction not in a positive real is an upper bound *)
  22.192 +(* Gleason p. 122 - Remark (1)                                  *)
  22.193 +
  22.194 +Goal "!!x. x ~: Rep_preal(R) ==> !y: Rep_preal(R). y < x";
  22.195 +by (cut_inst_tac [("x1","R")] (Rep_preal RS prealE_lemma) 1);
  22.196 +by (auto_tac (claset() addIs [not_less_not_eq_prat_less],simpset()));
  22.197 +qed "not_in_preal_ub";
  22.198 +
  22.199 +(* preal_less is a strong order i.e nonreflexive and transitive *)
  22.200 +
  22.201 +Goalw [preal_less_def] "~ (x::preal) < x";
  22.202 +by (simp_tac (simpset() addsimps [psubset_def]) 1);
  22.203 +qed "preal_less_not_refl";
  22.204 +
  22.205 +(*** y < y ==> P ***)
  22.206 +bind_thm("preal_less_irrefl",preal_less_not_refl RS notE);
  22.207 +
  22.208 +Goal "!!(x::preal). x < y ==> x ~= y";
  22.209 +by (auto_tac (claset(),simpset() addsimps [preal_less_not_refl]));
  22.210 +qed "preal_not_refl2";
  22.211 +
  22.212 +Goalw  [preal_less_def] "!!(x::preal). [| x < y; y < z |] ==> x < z";
  22.213 +by (auto_tac (claset() addDs [subsetD,equalityI],
  22.214 +              simpset() addsimps [psubset_def]));
  22.215 +qed "preal_less_trans";
  22.216 +
  22.217 +Goal "!! (q1::preal). [| q1 < q2; q2 < q1 |] ==> P";
  22.218 +by (dtac preal_less_trans 1 THEN assume_tac 1);
  22.219 +by (asm_full_simp_tac (simpset() addsimps [preal_less_not_refl]) 1);
  22.220 +qed "preal_less_asym";
  22.221 +
  22.222 +Goalw [preal_less_def] 
  22.223 +      "(r1::preal) < r2 | r1 = r2 | r2 < r1";
  22.224 +by (auto_tac (claset() addSDs [inj_Rep_preal RS injD],
  22.225 +              simpset() addsimps [psubset_def]));
  22.226 +by (rtac prealE_lemma3b 1 THEN rtac Rep_preal 1);
  22.227 +by (assume_tac 1);
  22.228 +by (fast_tac (claset() addDs [not_in_preal_ub]) 1);
  22.229 +qed "preal_linear";
  22.230 +
  22.231 +Goal
  22.232 +    "!!(r1::preal). [| r1 < r2 ==> P;  r1 = r2 ==> P; \
  22.233 +\          r2 < r1 ==> P |] ==> P";
  22.234 +by (cut_inst_tac [("r1.0","r1"),("r2.0","r2")] preal_linear 1);
  22.235 +by Auto_tac;
  22.236 +qed "preal_linear_less2";
  22.237 +
  22.238 +  (*** Properties of addition ***)
  22.239 +
  22.240 +Goalw [preal_add_def] "(x::preal) + y = y + x";
  22.241 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
  22.242 +by (rtac set_ext 1);
  22.243 +by (blast_tac (claset() addIs [prat_add_commute RS subst]) 1);
  22.244 +qed "preal_add_commute";
  22.245 +
  22.246 +(** addition of two positive reals gives a positive real **)
  22.247 +(** lemmas for proving positive reals addition set in preal **)
  22.248 +
  22.249 +(** Part 1 of Dedekind sections def **)
  22.250 +Goal "{} < {w. ? x: Rep_preal R. ? y:Rep_preal S. w = x + y}";
  22.251 +by (cut_facts_tac [mem_Rep_preal_Ex,mem_Rep_preal_Ex] 1);
  22.252 +by (auto_tac (claset() addSIs [psubsetI] addEs [equalityCE],simpset()));
  22.253 +qed "preal_add_set_not_empty";
  22.254 +
  22.255 +(** Part 2 of Dedekind sections def **)
  22.256 +Goal "? q. q  ~: {w. ? x: Rep_preal R. ? y:Rep_preal S. w = x + y}";
  22.257 +by (cut_inst_tac [("X","R")] not_mem_Rep_preal_Ex 1);
  22.258 +by (cut_inst_tac [("X","S")] not_mem_Rep_preal_Ex 1);
  22.259 +by (REPEAT(etac exE 1));
  22.260 +by (REPEAT(dtac not_in_preal_ub 1));
  22.261 +by (res_inst_tac [("x","x+xa")] exI 1);
  22.262 +by (Auto_tac THEN (REPEAT(etac ballE 1)) THEN Auto_tac);
  22.263 +by (dtac prat_add_less_mono 1);
  22.264 +by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  22.265 +qed "preal_not_mem_add_set_Ex";
  22.266 +
  22.267 +Goal "{w. ? x: Rep_preal R. ? y:Rep_preal S. w = x + y} < {q. True}";
  22.268 +by (auto_tac (claset() addSIs [psubsetI],simpset()));
  22.269 +by (cut_inst_tac [("R","R"),("S","S")] preal_not_mem_add_set_Ex 1);
  22.270 +by (etac exE 1);
  22.271 +by (eres_inst_tac [("c","q")] equalityCE 1);
  22.272 +by Auto_tac;
  22.273 +qed "preal_add_set_not_prat_set";
  22.274 +
  22.275 +(** Part 3 of Dedekind sections def **)
  22.276 +Goal "!y: {w. ? x: Rep_preal R. ? y: Rep_preal S. w = x + y}. \
  22.277 +\         !z. z < y --> z : {w. ? x:Rep_preal R. ? y:Rep_preal S. w = x + y}";
  22.278 +by Auto_tac;
  22.279 +by (forward_tac [prat_mult_qinv_less_1] 1);
  22.280 +by (forw_inst_tac [("x","x"),("q2.0","$#Abs_pnat 1")] 
  22.281 +    prat_mult_less2_mono1 1);
  22.282 +by (forw_inst_tac [("x","ya"),("q2.0","$#Abs_pnat 1")] 
  22.283 +    prat_mult_less2_mono1 1);
  22.284 +by (Asm_full_simp_tac 1);
  22.285 +by (REPEAT(dtac (Rep_preal RS prealE_lemma3a) 1));
  22.286 +by (REPEAT(etac allE 1));
  22.287 +by Auto_tac;
  22.288 +by (REPEAT(rtac bexI 1));
  22.289 +by (auto_tac (claset(),simpset() addsimps [prat_add_mult_distrib2 
  22.290 +     RS sym,prat_add_assoc RS sym,prat_mult_assoc]));
  22.291 +qed "preal_add_set_lemma3";
  22.292 +
  22.293 +Goal "!y: {w. ? x: Rep_preal R. ? y: Rep_preal S. w = x + y}. \
  22.294 +\         ? u: {w. ? x: Rep_preal R. ? y: Rep_preal S. w = x + y}. y < u";
  22.295 +by Auto_tac;
  22.296 +by (dtac (Rep_preal RS prealE_lemma4a) 1);
  22.297 +by (auto_tac (claset() addIs [prat_add_less2_mono1],simpset()));
  22.298 +qed "preal_add_set_lemma4";
  22.299 +
  22.300 +Goal "{w. ? x: Rep_preal R. ? y: Rep_preal S. w = x + y} : preal";
  22.301 +by (rtac prealI2 1);
  22.302 +by (rtac preal_add_set_not_empty 1);
  22.303 +by (rtac preal_add_set_not_prat_set 1);
  22.304 +by (rtac preal_add_set_lemma3 1);
  22.305 +by (rtac preal_add_set_lemma4 1);
  22.306 +qed "preal_mem_add_set";
  22.307 +
  22.308 +Goalw [preal_add_def] "((x::preal) + y) + z = x + (y + z)";
  22.309 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
  22.310 +by (rtac set_ext 1);
  22.311 +by (rtac (preal_mem_add_set RS Abs_preal_inverse RS ssubst) 1);
  22.312 +by (rtac (preal_mem_add_set RS Abs_preal_inverse RS ssubst) 1);
  22.313 +by (auto_tac (claset(),simpset() addsimps prat_add_ac));
  22.314 +by (rtac bexI 1);
  22.315 +by (auto_tac (claset() addSIs [exI],simpset() addsimps prat_add_ac));
  22.316 +qed "preal_add_assoc";
  22.317 +
  22.318 +qed_goal "preal_add_left_commute" thy
  22.319 +    "(z1::preal) + (z2 + z3) = z2 + (z1 + z3)"
  22.320 + (fn _ => [rtac (preal_add_commute RS trans) 1, rtac (preal_add_assoc RS trans) 1,
  22.321 +           rtac (preal_add_commute RS arg_cong) 1]);
  22.322 +
  22.323 +(* Positive Reals addition is an AC operator *)
  22.324 +val preal_add_ac = [preal_add_assoc, preal_add_commute, preal_add_left_commute];
  22.325 +
  22.326 +  (*** Properties of multiplication ***)
  22.327 +
  22.328 +(** Proofs essentially same as for addition **)
  22.329 +
  22.330 +Goalw [preal_mult_def] "(x::preal) * y = y * x";
  22.331 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
  22.332 +by (rtac set_ext 1);
  22.333 +by (blast_tac (claset() addIs [prat_mult_commute RS subst]) 1);
  22.334 +qed "preal_mult_commute";
  22.335 +
  22.336 +(** multiplication of two positive reals gives a positive real **)
  22.337 +(** lemmas for proving positive reals multiplication set in preal **)
  22.338 +
  22.339 +(** Part 1 of Dedekind sections def **)
  22.340 +Goal "{} < {w. ? x: Rep_preal R. ? y:Rep_preal S. w = x * y}";
  22.341 +by (cut_facts_tac [mem_Rep_preal_Ex,mem_Rep_preal_Ex] 1);
  22.342 +by (auto_tac (claset() addSIs [psubsetI] addEs [equalityCE],simpset()));
  22.343 +qed "preal_mult_set_not_empty";
  22.344 +
  22.345 +(** Part 2 of Dedekind sections def **)
  22.346 +Goal "? q. q  ~: {w. ? x: Rep_preal R. ? y:Rep_preal S. w = x * y}";
  22.347 +by (cut_inst_tac [("X","R")] not_mem_Rep_preal_Ex 1);
  22.348 +by (cut_inst_tac [("X","S")] not_mem_Rep_preal_Ex 1);
  22.349 +by (REPEAT(etac exE 1));
  22.350 +by (REPEAT(dtac not_in_preal_ub 1));
  22.351 +by (res_inst_tac [("x","x*xa")] exI 1);
  22.352 +by (Auto_tac  THEN (REPEAT(etac ballE 1)) THEN Auto_tac );
  22.353 +by (dtac prat_mult_less_mono 1);
  22.354 +by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  22.355 +qed "preal_not_mem_mult_set_Ex";
  22.356 +
  22.357 +Goal "{w. ? x: Rep_preal R. ? y:Rep_preal S. w = x * y} < {q. True}";
  22.358 +by (auto_tac (claset() addSIs [psubsetI],simpset()));
  22.359 +by (cut_inst_tac [("R","R"),("S","S")] preal_not_mem_mult_set_Ex 1);
  22.360 +by (etac exE 1);
  22.361 +by (eres_inst_tac [("c","q")] equalityCE 1);
  22.362 +by Auto_tac;
  22.363 +qed "preal_mult_set_not_prat_set";
  22.364 +
  22.365 +(** Part 3 of Dedekind sections def **)
  22.366 +Goal "!y: {w. ? x: Rep_preal R. ? y: Rep_preal S. w = x * y}. \
  22.367 +\         !z. z < y --> z : {w. ? x:Rep_preal R. ? y:Rep_preal S. w = x * y}";
  22.368 +by Auto_tac;
  22.369 +by (forw_inst_tac [("x","qinv(ya)"),("q1.0","z")] 
  22.370 +    prat_mult_left_less2_mono1 1);
  22.371 +by (asm_full_simp_tac (simpset() addsimps prat_mult_ac) 1);
  22.372 +by (dtac (Rep_preal RS prealE_lemma3a) 1);
  22.373 +by (etac allE 1);
  22.374 +by (REPEAT(rtac bexI 1));
  22.375 +by (auto_tac (claset(),simpset() addsimps [prat_mult_assoc]));
  22.376 +qed "preal_mult_set_lemma3";
  22.377 +
  22.378 +Goal "!y: {w. ? x: Rep_preal R. ? y: Rep_preal S. w = x * y}. \
  22.379 +\         ? u: {w. ? x: Rep_preal R. ? y: Rep_preal S. w = x * y}. y < u";
  22.380 +by Auto_tac;
  22.381 +by (dtac (Rep_preal RS prealE_lemma4a) 1);
  22.382 +by (auto_tac (claset() addIs [prat_mult_less2_mono1],simpset()));
  22.383 +qed "preal_mult_set_lemma4";
  22.384 +
  22.385 +Goal "{w. ? x: Rep_preal R. ? y: Rep_preal S. w = x * y} : preal";
  22.386 +by (rtac prealI2 1);
  22.387 +by (rtac preal_mult_set_not_empty 1);
  22.388 +by (rtac preal_mult_set_not_prat_set 1);
  22.389 +by (rtac preal_mult_set_lemma3 1);
  22.390 +by (rtac preal_mult_set_lemma4 1);
  22.391 +qed "preal_mem_mult_set";
  22.392 +
  22.393 +Goalw [preal_mult_def] "((x::preal) * y) * z = x * (y * z)";
  22.394 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
  22.395 +by (rtac set_ext 1);
  22.396 +by (rtac (preal_mem_mult_set RS Abs_preal_inverse RS ssubst) 1);
  22.397 +by (rtac (preal_mem_mult_set RS Abs_preal_inverse RS ssubst) 1);
  22.398 +by (auto_tac (claset(),simpset() addsimps prat_mult_ac));
  22.399 +by (rtac bexI 1);
  22.400 +by (auto_tac (claset() addSIs [exI],simpset() addsimps prat_mult_ac));
  22.401 +qed "preal_mult_assoc";
  22.402 +
  22.403 +qed_goal "preal_mult_left_commute" thy
  22.404 +    "(z1::preal) * (z2 * z3) = z2 * (z1 * z3)"
  22.405 + (fn _ => [rtac (preal_mult_commute RS trans) 1, 
  22.406 +           rtac (preal_mult_assoc RS trans) 1,
  22.407 +           rtac (preal_mult_commute RS arg_cong) 1]);
  22.408 +
  22.409 +(* Positive Reals multiplication is an AC operator *)
  22.410 +val preal_mult_ac = [preal_mult_assoc, 
  22.411 +                     preal_mult_commute, 
  22.412 +                     preal_mult_left_commute];
  22.413 +
  22.414 +(* Positive Real 1 is the multiplicative identity element *) 
  22.415 +(* long *)
  22.416 +Goalw [preal_prat_def,preal_mult_def] "(@#($#Abs_pnat 1)) * z = z";
  22.417 +by (rtac (Rep_preal_inverse RS subst) 1);
  22.418 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
  22.419 +by (rtac (one_set_mem_preal RS Abs_preal_inverse RS ssubst) 1);
  22.420 +by (rtac set_ext 1);
  22.421 +by (auto_tac(claset(),simpset() addsimps [Rep_preal_inverse]));
  22.422 +by (EVERY1[dtac (Rep_preal RS prealE_lemma4a),etac bexE]);
  22.423 +by (dtac prat_mult_less_mono 1);
  22.424 +by (auto_tac (claset() addDs [Rep_preal RS prealE_lemma3a],simpset()));
  22.425 +by (EVERY1[forward_tac [Rep_preal RS prealE_lemma4a],etac bexE]);
  22.426 +by (forw_inst_tac [("x","qinv(u)"),("q1.0","x")] 
  22.427 +    prat_mult_less2_mono1 1);
  22.428 +by (rtac exI 1 THEN Auto_tac THEN res_inst_tac [("x","u")] bexI 1);
  22.429 +by (auto_tac (claset(),simpset() addsimps [prat_mult_assoc]));
  22.430 +qed "preal_mult_1";
  22.431 +
  22.432 +Goal "z * (@#($#Abs_pnat 1)) = z";
  22.433 +by (rtac (preal_mult_commute RS subst) 1);
  22.434 +by (rtac preal_mult_1 1);
  22.435 +qed "preal_mult_1_right";
  22.436 +
  22.437 +(** Lemmas **)
  22.438 +
  22.439 +qed_goal "preal_add_assoc_cong" thy
  22.440 +    "!!z. (z::preal) + v = z' + v' ==> z + (v + w) = z' + (v' + w)"
  22.441 + (fn _ => [(asm_simp_tac (simpset() addsimps [preal_add_assoc RS sym]) 1)]);
  22.442 +
  22.443 +qed_goal "preal_add_assoc_swap" thy "(z::preal) + (v + w) = v + (z + w)"
  22.444 + (fn _ => [(REPEAT (ares_tac [preal_add_commute RS preal_add_assoc_cong] 1))]);
  22.445 +
  22.446 +(** Distribution of multiplication across addition **)
  22.447 +(** lemmas for the proof **)
  22.448 +
  22.449 + (** lemmas **)
  22.450 +Goalw [preal_add_def] 
  22.451 +      "!!R. z: Rep_preal(R+S) ==> \
  22.452 +\           ? x: Rep_preal(R). ? y: Rep_preal(S). z = x + y";
  22.453 +by (dtac (preal_mem_add_set RS Abs_preal_inverse RS subst) 1);
  22.454 +by (Fast_tac 1);
  22.455 +qed "mem_Rep_preal_addD";
  22.456 +
  22.457 +Goalw [preal_add_def] 
  22.458 +      "!!R. ? x: Rep_preal(R). ? y: Rep_preal(S). z = x + y \
  22.459 +\      ==> z: Rep_preal(R+S)";
  22.460 +by (rtac (preal_mem_add_set RS Abs_preal_inverse RS ssubst) 1);
  22.461 +by (Fast_tac 1);
  22.462 +qed "mem_Rep_preal_addI";
  22.463 +
  22.464 +Goal " z: Rep_preal(R+S) = (? x: Rep_preal(R). \
  22.465 +\                                 ? y: Rep_preal(S). z = x + y)";
  22.466 +by (fast_tac (claset() addSIs [mem_Rep_preal_addD,mem_Rep_preal_addI]) 1);
  22.467 +qed "mem_Rep_preal_add_iff";
  22.468 +
  22.469 +Goalw [preal_mult_def] 
  22.470 +      "!!R. z: Rep_preal(R*S) ==> \
  22.471 +\           ? x: Rep_preal(R). ? y: Rep_preal(S). z = x * y";
  22.472 +by (dtac (preal_mem_mult_set RS Abs_preal_inverse RS subst) 1);
  22.473 +by (Fast_tac 1);
  22.474 +qed "mem_Rep_preal_multD";
  22.475 +
  22.476 +Goalw [preal_mult_def] 
  22.477 +      "!!R. ? x: Rep_preal(R). ? y: Rep_preal(S). z = x * y \
  22.478 +\      ==> z: Rep_preal(R*S)";
  22.479 +by (rtac (preal_mem_mult_set RS Abs_preal_inverse RS ssubst) 1);
  22.480 +by (Fast_tac 1);
  22.481 +qed "mem_Rep_preal_multI";
  22.482 +
  22.483 +Goal " z: Rep_preal(R*S) = (? x: Rep_preal(R). \
  22.484 +\                                 ? y: Rep_preal(S). z = x * y)";
  22.485 +by (fast_tac (claset() addSIs [mem_Rep_preal_multD,mem_Rep_preal_multI]) 1);
  22.486 +qed "mem_Rep_preal_mult_iff";
  22.487 +
  22.488 +(** More lemmas for preal_add_mult_distrib2 **)
  22.489 +goal PRat.thy "!!(a1::prat). a1 < a2 ==> a1 * b + a2 * c < a2 * (b + c)";
  22.490 +by (auto_tac (claset() addSIs [prat_add_less2_mono1,prat_mult_less2_mono1],
  22.491 +              simpset() addsimps [prat_add_mult_distrib2]));
  22.492 +qed "lemma_prat_add_mult_mono";
  22.493 +
  22.494 +Goal "!!xb. [| xb: Rep_preal z1; xc: Rep_preal z2; ya: \
  22.495 +\                  Rep_preal w; yb: Rep_preal w |] ==> \
  22.496 +\                  xb * ya + xc * yb: Rep_preal (z1 * w + z2 * w)";
  22.497 +by (fast_tac (claset() addIs [mem_Rep_preal_addI,mem_Rep_preal_multI]) 1);
  22.498 +qed "lemma_add_mult_mem_Rep_preal";
  22.499 +
  22.500 +Goal "!!xb. [| xb: Rep_preal z1; xc: Rep_preal z2; ya: \
  22.501 +\                  Rep_preal w; yb: Rep_preal w |] ==> \
  22.502 +\                  yb*(xb + xc): Rep_preal (w*(z1 + z2))";
  22.503 +by (fast_tac (claset() addIs [mem_Rep_preal_addI,mem_Rep_preal_multI]) 1);
  22.504 +qed "lemma_add_mult_mem_Rep_preal1";
  22.505 +
  22.506 +Goal "!!x. x: Rep_preal (w * z1 + w * z2) ==> \
  22.507 +\              x: Rep_preal (w * (z1 + z2))";
  22.508 +by (auto_tac (claset() addSDs [mem_Rep_preal_addD,mem_Rep_preal_multD],
  22.509 +              simpset()));
  22.510 +by (forw_inst_tac [("ya","xb"),("yb","xc"),("xb","ya"),("xc","yb")] 
  22.511 +                                   lemma_add_mult_mem_Rep_preal1 1);
  22.512 +by Auto_tac;
  22.513 +by (res_inst_tac [("q1.0","xb"),("q2.0","xc")] prat_linear_less2 1);
  22.514 +by (dres_inst_tac [("b","ya"),("c","yb")] lemma_prat_add_mult_mono 1);
  22.515 +by (rtac (Rep_preal RS prealE_lemma3b) 1);
  22.516 +by (auto_tac (claset(),simpset() addsimps [prat_add_mult_distrib2]));
  22.517 +by (dres_inst_tac [("ya","xc"),("yb","xb"),("xc","ya"),("xb","yb")] 
  22.518 +                                   lemma_add_mult_mem_Rep_preal1 1);
  22.519 +by Auto_tac;
  22.520 +by (dres_inst_tac [("b","yb"),("c","ya")] lemma_prat_add_mult_mono 1);
  22.521 +by (rtac (Rep_preal RS prealE_lemma3b) 1);
  22.522 +by (thin_tac "xc * ya + xc * yb  : Rep_preal (w * (z1 + z2))" 1);
  22.523 +by (auto_tac (claset(),simpset() addsimps [prat_add_mult_distrib,
  22.524 +              prat_add_commute] @ preal_add_ac ));
  22.525 +qed "lemma_preal_add_mult_distrib";
  22.526 +
  22.527 +Goal "!!x. x: Rep_preal (w * (z1 + z2)) ==> \
  22.528 +\              x: Rep_preal (w * z1 + w * z2)";
  22.529 +by (auto_tac (claset() addSDs [mem_Rep_preal_addD,mem_Rep_preal_multD]
  22.530 +              addSIs [bexI,mem_Rep_preal_addI,mem_Rep_preal_multI],
  22.531 +              simpset() addsimps [prat_add_mult_distrib2]));
  22.532 +qed "lemma_preal_add_mult_distrib2";
  22.533 +
  22.534 +Goal "(w * ((z1::preal) + z2)) = (w * z1) + (w * z2)";
  22.535 +by (rtac (inj_Rep_preal RS injD) 1);
  22.536 +by (rtac set_ext 1);
  22.537 +by (fast_tac (claset() addIs [lemma_preal_add_mult_distrib,
  22.538 +                       lemma_preal_add_mult_distrib2]) 1);
  22.539 +qed "preal_add_mult_distrib2";
  22.540 +
  22.541 +Goal "(((z1::preal) + z2) * w) = (z1 * w) + (z2 * w)";
  22.542 +by (simp_tac (simpset() addsimps [preal_mult_commute,
  22.543 +                       preal_add_mult_distrib2]) 1);
  22.544 +qed "preal_add_mult_distrib";
  22.545 +
  22.546 +(*** Prove existence of inverse ***)
  22.547 +(*** Inverse is a positive real ***)
  22.548 +
  22.549 +Goal "? y. qinv(y) ~:  Rep_preal X";
  22.550 +by (cut_inst_tac [("X","X")] not_mem_Rep_preal_Ex 1);
  22.551 +by (etac exE 1 THEN cut_inst_tac [("x","x")] prat_as_inverse_ex 1);
  22.552 +by Auto_tac;
  22.553 +qed "qinv_not_mem_Rep_preal_Ex";
  22.554 +
  22.555 +Goal "? q. q: {x. ? y. x < y & qinv y ~:  Rep_preal A}";
  22.556 +by (cut_inst_tac [("X","A")] qinv_not_mem_Rep_preal_Ex 1);
  22.557 +by Auto_tac;
  22.558 +by (cut_inst_tac [("y","y")] qless_Ex 1);
  22.559 +by (Fast_tac 1);
  22.560 +qed "lemma_preal_mem_inv_set_ex";
  22.561 +
  22.562 +(** Part 1 of Dedekind sections def **)
  22.563 +Goal "{} < {x. ? y. x < y & qinv y ~:  Rep_preal A}";
  22.564 +by (cut_facts_tac [lemma_preal_mem_inv_set_ex] 1);
  22.565 +by (auto_tac (claset() addSIs [psubsetI] addEs [equalityCE],simpset()));
  22.566 +qed "preal_inv_set_not_empty";
  22.567 +
  22.568 +(** Part 2 of Dedekind sections def **)
  22.569 +Goal "? y. qinv(y) :  Rep_preal X";
  22.570 +by (cut_inst_tac [("X","X")] mem_Rep_preal_Ex 1);
  22.571 +by (etac exE 1 THEN cut_inst_tac [("x","x")] prat_as_inverse_ex 1);
  22.572 +by Auto_tac;
  22.573 +qed "qinv_mem_Rep_preal_Ex";
  22.574 +
  22.575 +Goal "? x. x ~: {x. ? y. x < y & qinv y ~:  Rep_preal A}";
  22.576 +by (rtac ccontr 1);
  22.577 +by (cut_inst_tac [("X","A")] qinv_mem_Rep_preal_Ex 1);
  22.578 +by Auto_tac;
  22.579 +by (EVERY1[etac allE, etac exE, etac conjE]);
  22.580 +by (dtac qinv_prat_less 1 THEN dtac not_in_preal_ub 1);
  22.581 +by (eres_inst_tac [("x","qinv y")] ballE 1);
  22.582 +by (dtac prat_less_trans 1);
  22.583 +by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  22.584 +qed "preal_not_mem_inv_set_Ex";
  22.585 +
  22.586 +Goal "{x. ? y. x < y & qinv y ~:  Rep_preal A} < {q. True}";
  22.587 +by (auto_tac (claset() addSIs [psubsetI],simpset()));
  22.588 +by (cut_inst_tac [("A","A")]  preal_not_mem_inv_set_Ex 1);
  22.589 +by (etac exE 1);
  22.590 +by (eres_inst_tac [("c","x")] equalityCE 1);
  22.591 +by Auto_tac;
  22.592 +qed "preal_inv_set_not_prat_set";
  22.593 +
  22.594 +(** Part 3 of Dedekind sections def **)
  22.595 +Goal "! y: {x. ? y. x < y & qinv y ~: Rep_preal A}. \
  22.596 + \      !z. z < y --> z : {x. ? y. x < y & qinv y ~: Rep_preal A}";
  22.597 +by Auto_tac;
  22.598 +by (res_inst_tac [("x","ya")] exI 1);
  22.599 +by (auto_tac (claset() addIs [prat_less_trans],simpset()));
  22.600 +qed "preal_inv_set_lemma3";
  22.601 +
  22.602 +Goal "! y: {x. ? y. x < y & qinv y ~: Rep_preal A}. \
  22.603 +\       Bex {x. ? y. x < y & qinv y ~: Rep_preal A} (op < y)";
  22.604 +by (blast_tac (claset() addDs [prat_dense]) 1);
  22.605 +qed "preal_inv_set_lemma4";
  22.606 +
  22.607 +Goal "{x. ? y. x < y & qinv(y) ~: Rep_preal(A)} : preal";
  22.608 +by (rtac prealI2 1);
  22.609 +by (rtac preal_inv_set_not_empty 1);
  22.610 +by (rtac preal_inv_set_not_prat_set 1);
  22.611 +by (rtac preal_inv_set_lemma3 1);
  22.612 +by (rtac preal_inv_set_lemma4 1);
  22.613 +qed "preal_mem_inv_set";
  22.614 +
  22.615 +(*more lemmas for inverse *)
  22.616 +Goal "!!x. x: Rep_preal(pinv(A)*A) ==> x: Rep_preal(@#($#Abs_pnat 1))";
  22.617 +by (auto_tac (claset() addSDs [mem_Rep_preal_multD],
  22.618 +              simpset() addsimps [pinv_def,preal_prat_def] ));
  22.619 +by (dtac (preal_mem_inv_set RS Abs_preal_inverse RS subst) 1);
  22.620 +by (auto_tac (claset() addSDs [not_in_preal_ub],simpset()));
  22.621 +by (dtac prat_mult_less_mono 1 THEN Blast_tac 1);
  22.622 +by (auto_tac (claset(),simpset()));
  22.623 +qed "preal_mem_mult_invD";
  22.624 +
  22.625 +(*** Gleason's Lemma 9-3.4 p 122 ***)
  22.626 +Goal "!!p. ! xa : Rep_preal(A). xa + x : Rep_preal(A) ==> \
  22.627 +\            ? xb : Rep_preal(A). xb + ($#p)*x : Rep_preal(A)";
  22.628 +by (cut_facts_tac [mem_Rep_preal_Ex] 1);
  22.629 +by (res_inst_tac [("n","p")] pnat_induct 1);
  22.630 +by (auto_tac (claset(),simpset() addsimps [pnat_one_def,
  22.631 +    pSuc_is_plus_one,prat_add_mult_distrib,prat_pnat_add,prat_add_assoc RS sym]));
  22.632 +qed "lemma1_gleason9_34";
  22.633 +
  22.634 +Goal "Abs_prat (ratrel ^^ {(y, z)}) < xb + \
  22.635 +\         Abs_prat (ratrel ^^ {(x*y, Abs_pnat 1)})*Abs_prat (ratrel ^^ {(w, x)})";
  22.636 +by (res_inst_tac [("j","Abs_prat (ratrel ^^ {(x * y, Abs_pnat 1)}) *\
  22.637 +\                   Abs_prat (ratrel ^^ {(w, x)})")] prat_le_less_trans 1);
  22.638 +by (rtac prat_self_less_add_right 2);
  22.639 +by (auto_tac (claset() addIs [lemma_Abs_prat_le3],
  22.640 +    simpset() addsimps [prat_mult,pre_lemma_gleason9_34b,pnat_mult_assoc]));
  22.641 +qed "lemma1b_gleason9_34";
  22.642 +
  22.643 +Goal "!!A. ! xa : Rep_preal(A). xa + x : Rep_preal(A) ==> False";
  22.644 +by (cut_inst_tac [("X","A")] not_mem_Rep_preal_Ex 1);
  22.645 +by (etac exE 1);
  22.646 +by (dtac not_in_preal_ub 1);
  22.647 +by (res_inst_tac [("z","x")] eq_Abs_prat 1);
  22.648 +by (res_inst_tac [("z","xa")] eq_Abs_prat 1);
  22.649 +by (dres_inst_tac [("p","y*xb")] lemma1_gleason9_34 1);
  22.650 +by (etac bexE 1);
  22.651 +by (cut_inst_tac [("x","y"),("y","xb"),("w","xaa"),
  22.652 +    ("z","ya"),("xb","xba")] lemma1b_gleason9_34 1);
  22.653 +by (dres_inst_tac [("x","xba + $#(y * xb) * x")]  bspec 1);
  22.654 +by (auto_tac (claset() addIs [prat_less_asym],
  22.655 +    simpset() addsimps [prat_pnat_def]));
  22.656 +qed "lemma_gleason9_34a";
  22.657 +
  22.658 +Goal "? r: Rep_preal(R). r + x ~: Rep_preal(R)";
  22.659 +by (rtac ccontr 1);
  22.660 +by (blast_tac (claset() addIs [lemma_gleason9_34a]) 1);
  22.661 +qed "lemma_gleason9_34";
  22.662 +
  22.663 +(*** Gleason's Lemma 9-3.6  ***)
  22.664 +(*  lemmas for Gleason 9-3.6  *)
  22.665 +(*                            *) 
  22.666 +(******************************)
  22.667 +
  22.668 +Goal "r + r*qinv(xa)*Q3 = r*qinv(xa)*(xa + Q3)";
  22.669 +by (full_simp_tac (simpset() addsimps [prat_add_mult_distrib2,
  22.670 +    prat_mult_assoc]) 1);
  22.671 +qed "lemma1_gleason9_36";
  22.672 +
  22.673 +Goal "r*qinv(xa)*(xa*x) = r*x";
  22.674 +by (full_simp_tac (simpset() addsimps prat_mult_ac) 1);
  22.675 +qed "lemma2_gleason9_36";
  22.676 +(******)
  22.677 +
  22.678 +(*** FIXME: long! ***)
  22.679 +Goal "!!A. $#1p < x ==> ? r: Rep_preal(A). r*x ~: Rep_preal(A)";
  22.680 +by (res_inst_tac [("X1","A")] (mem_Rep_preal_Ex RS exE) 1);
  22.681 +by (res_inst_tac [("Q","xa*x : Rep_preal(A)")] (excluded_middle RS disjE) 1);
  22.682 +by (Fast_tac 1);
  22.683 +by (dres_inst_tac [("x","xa")] prat_self_less_mult_right 1);
  22.684 +by (etac prat_lessE 1);
  22.685 +by (cut_inst_tac [("R","A"),("x","Q3")] lemma_gleason9_34 1);
  22.686 +by (dtac sym 1 THEN Auto_tac );
  22.687 +by (forward_tac [not_in_preal_ub] 1);
  22.688 +by (dres_inst_tac [("x","xa + Q3")] bspec 1 THEN assume_tac 1);
  22.689 +by (dtac prat_add_right_less_cancel 1);
  22.690 +by (dres_inst_tac [("x","qinv(xa)*Q3")] prat_mult_less2_mono1 1);
  22.691 +by (dres_inst_tac [("x","r")] prat_add_less2_mono2 1);
  22.692 +by (asm_full_simp_tac (simpset() addsimps
  22.693 +    [prat_mult_assoc RS sym,lemma1_gleason9_36]) 1);
  22.694 +by (dtac sym 1);
  22.695 +by (auto_tac (claset(),simpset() addsimps [lemma2_gleason9_36]));
  22.696 +by (res_inst_tac [("x","r")] bexI 1);
  22.697 +by (rtac notI 1);
  22.698 +by (dres_inst_tac [("y","r*x")] (Rep_preal RS prealE_lemma3b) 1);
  22.699 +by Auto_tac;
  22.700 +qed "lemma_gleason9_36";
  22.701 +
  22.702 +Goal "!!A. $#Abs_pnat 1 < x ==> ? r: Rep_preal(A). r*x ~: Rep_preal(A)";
  22.703 +by (rtac lemma_gleason9_36 1);
  22.704 +by (asm_simp_tac (simpset() addsimps [pnat_one_def]) 1);
  22.705 +qed "lemma_gleason9_36a";
  22.706 +
  22.707 +(*** Part 2 of existence of inverse ***)
  22.708 +Goal "!!x. x: Rep_preal(@#($#Abs_pnat 1)) ==> x: Rep_preal(pinv(A)*A)";
  22.709 +by (auto_tac (claset() addSIs [mem_Rep_preal_multI],
  22.710 +              simpset() addsimps [pinv_def,preal_prat_def] ));
  22.711 +by (rtac (preal_mem_inv_set RS Abs_preal_inverse RS ssubst) 1);
  22.712 +by (dtac prat_qinv_gt_1 1);
  22.713 +by (dres_inst_tac [("A","A")] lemma_gleason9_36a 1);
  22.714 +by Auto_tac;
  22.715 +by (dtac (Rep_preal RS prealE_lemma4a) 1);
  22.716 +by (Auto_tac  THEN dtac qinv_prat_less 1);
  22.717 +by (res_inst_tac [("x","qinv(u)*x")] exI 1);
  22.718 +by (rtac conjI 1);
  22.719 +by (res_inst_tac [("x","qinv(r)*x")] exI 1);
  22.720 +by (auto_tac (claset() addIs [prat_mult_less2_mono1],
  22.721 +    simpset() addsimps [qinv_mult_eq,qinv_qinv]));
  22.722 +by (res_inst_tac [("x","u")] bexI 1);
  22.723 +by (auto_tac (claset(),simpset() addsimps [prat_mult_assoc,
  22.724 +    prat_mult_left_commute]));
  22.725 +qed "preal_mem_mult_invI";
  22.726 +
  22.727 +Goal "pinv(A)*A = (@#($#Abs_pnat 1))";
  22.728 +by (rtac (inj_Rep_preal RS injD) 1);
  22.729 +by (rtac set_ext 1);
  22.730 +by (fast_tac (claset() addDs [preal_mem_mult_invD,preal_mem_mult_invI]) 1);
  22.731 +qed "preal_mult_inv";
  22.732 +
  22.733 +Goal "A*pinv(A) = (@#($#Abs_pnat 1))";
  22.734 +by (rtac (preal_mult_commute RS subst) 1);
  22.735 +by (rtac preal_mult_inv 1);
  22.736 +qed "preal_mult_inv_right";
  22.737 +
  22.738 +val [prem] = goal thy
  22.739 +    "(!!u. z = Abs_preal(u) ==> P) ==> P";
  22.740 +by (cut_inst_tac [("x1","z")] 
  22.741 +    (rewrite_rule [preal_def] (Rep_preal RS Abs_preal_inverse)) 1);
  22.742 +by (res_inst_tac [("u","Rep_preal z")] prem 1);
  22.743 +by (dtac (inj_Rep_preal RS injD) 1);
  22.744 +by (Asm_simp_tac 1);
  22.745 +qed "eq_Abs_preal";
  22.746 +
  22.747 +(*** Lemmas/Theorem(s) need lemma_gleason9_34 ***)
  22.748 +Goal "Rep_preal (R1) <= Rep_preal(R1 + R2)";
  22.749 +by (cut_inst_tac [("X","R2")] mem_Rep_preal_Ex 1);
  22.750 +by (auto_tac (claset() addSIs [bexI] addIs [(Rep_preal RS prealE_lemma3b),
  22.751 +   prat_self_less_add_left,mem_Rep_preal_addI],simpset()));
  22.752 +qed "Rep_preal_self_subset";
  22.753 +
  22.754 +Goal "~ Rep_preal (R1 + R2) <= Rep_preal(R1)";
  22.755 +by (cut_inst_tac [("X","R2")] mem_Rep_preal_Ex 1);
  22.756 +by (etac exE 1);
  22.757 +by (cut_inst_tac [("R","R1")] lemma_gleason9_34 1);
  22.758 +by (auto_tac (claset() addIs [mem_Rep_preal_addI],simpset()));
  22.759 +qed "Rep_preal_sum_not_subset";
  22.760 +
  22.761 +Goal "Rep_preal (R1 + R2) ~= Rep_preal(R1)";
  22.762 +by (rtac notI 1);
  22.763 +by (etac equalityE 1);
  22.764 +by (asm_full_simp_tac (simpset() addsimps [Rep_preal_sum_not_subset]) 1);
  22.765 +qed "Rep_preal_sum_not_eq";
  22.766 +
  22.767 +(*** at last --- Gleason prop. 9-3.5(iii) p. 123 ***)
  22.768 +Goalw [preal_less_def,psubset_def] "(R1::preal) < R1 + R2";
  22.769 +by (simp_tac (simpset() addsimps [Rep_preal_self_subset,
  22.770 +    Rep_preal_sum_not_eq RS not_sym]) 1);
  22.771 +qed "preal_self_less_add_left";
  22.772 +
  22.773 +Goal "(R1::preal) < R2 + R1";
  22.774 +by (simp_tac (simpset() addsimps [preal_add_commute,preal_self_less_add_left]) 1);
  22.775 +qed "preal_self_less_add_right";
  22.776 +
  22.777 +(*** Properties of <= ***)
  22.778 +
  22.779 +Goalw [preal_le_def,psubset_def,preal_less_def] 
  22.780 +                     "!!w. z<=w ==> ~(w<(z::preal))";
  22.781 +by (auto_tac  (claset() addDs [equalityI],simpset()));
  22.782 +qed "preal_leD";
  22.783 +
  22.784 +val preal_leE = make_elim preal_leD;
  22.785 +
  22.786 +Goalw [preal_le_def,psubset_def,preal_less_def]
  22.787 +                   "!!z. ~ z <= w ==> w<(z::preal)";
  22.788 +by (cut_inst_tac [("r1.0","w"),("r2.0","z")] preal_linear 1);
  22.789 +by (auto_tac  (claset(),simpset() addsimps [preal_less_def,psubset_def]));
  22.790 +qed "not_preal_leE";
  22.791 +		       
  22.792 +Goal "!!w. ~(w < z) ==> z <= (w::preal)";
  22.793 +by (fast_tac (claset() addIs [not_preal_leE]) 1);
  22.794 +qed "preal_leI";
  22.795 +
  22.796 +Goal "!!w. (~(w < z)) = (z <= (w::preal))";
  22.797 +by (fast_tac (claset() addSIs [preal_leI,preal_leD]) 1);
  22.798 +qed "preal_less_le_iff";
  22.799 +
  22.800 +Goalw [preal_le_def,preal_less_def,psubset_def] 
  22.801 +                  "!!z. z < w ==> z <= (w::preal)";
  22.802 +by (Fast_tac 1);
  22.803 +qed "preal_less_imp_le";
  22.804 +
  22.805 +Goalw [preal_le_def,preal_less_def,psubset_def] 
  22.806 +                      "!!(x::preal). x <= y ==> x < y | x = y";
  22.807 +by (auto_tac (claset() addIs [inj_Rep_preal RS injD],simpset()));
  22.808 +qed "preal_le_imp_less_or_eq";
  22.809 +
  22.810 +Goalw [preal_le_def,preal_less_def,psubset_def] 
  22.811 +                       "!!(x::preal). x < y | x = y ==> x <=y";
  22.812 +by Auto_tac;
  22.813 +qed "preal_less_or_eq_imp_le";
  22.814 +
  22.815 +Goal "(x <= (y::preal)) = (x < y | x=y)";
  22.816 +by (REPEAT(ares_tac [iffI, preal_less_or_eq_imp_le, preal_le_imp_less_or_eq] 1));
  22.817 +qed "preal_le_eq_less_or_eq";
  22.818 +
  22.819 +Goalw [preal_le_def] "w <= (w::preal)";
  22.820 +by (Simp_tac 1);
  22.821 +qed "preal_le_refl";
  22.822 +
  22.823 +val prems = goal thy "!!i. [| i <= j; j < k |] ==> i < (k::preal)";
  22.824 +by (dtac preal_le_imp_less_or_eq 1);
  22.825 +by (fast_tac (claset() addIs [preal_less_trans]) 1);
  22.826 +qed "preal_le_less_trans";
  22.827 +
  22.828 +val prems = goal thy "!!i. [| i < j; j <= k |] ==> i < (k::preal)";
  22.829 +by (dtac preal_le_imp_less_or_eq 1);
  22.830 +by (fast_tac (claset() addIs [preal_less_trans]) 1);
  22.831 +qed "preal_less_le_trans";
  22.832 +
  22.833 +Goal "!!i. [| i <= j; j <= k |] ==> i <= (k::preal)";
  22.834 +by (EVERY1 [dtac preal_le_imp_less_or_eq, dtac preal_le_imp_less_or_eq,
  22.835 +            rtac preal_less_or_eq_imp_le, fast_tac (claset() addIs [preal_less_trans])]);
  22.836 +qed "preal_le_trans";
  22.837 +
  22.838 +Goal "!!z. [| z <= w; w <= z |] ==> z = (w::preal)";
  22.839 +by (EVERY1 [dtac preal_le_imp_less_or_eq, dtac preal_le_imp_less_or_eq,
  22.840 +            fast_tac (claset() addEs [preal_less_irrefl,preal_less_asym])]);
  22.841 +qed "preal_le_anti_sym";
  22.842 +
  22.843 +Goal "!!x. [| ~ y < x; y ~= x |] ==> x < (y::preal)";
  22.844 +by (rtac not_preal_leE 1);
  22.845 +by (fast_tac (claset() addDs [preal_le_imp_less_or_eq]) 1);
  22.846 +qed "not_less_not_eq_preal_less";
  22.847 +
  22.848 +(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)
  22.849 +
  22.850 +(**** Set up all lemmas for proving A < B ==> ?D. A + D = B ****)
  22.851 +(**** Gleason prop. 9-3.5(iv) p. 123 ****)
  22.852 +(**** Define the D required and show that it is a positive real ****)
  22.853 +
  22.854 +(* useful lemmas - proved elsewhere? *)
  22.855 +Goalw [psubset_def] "!!A. A < B ==> ? x. x ~: A & x : B";
  22.856 +by (etac conjE 1);
  22.857 +by (etac swap 1);
  22.858 +by (etac equalityI 1);
  22.859 +by Auto_tac;
  22.860 +qed "lemma_psubset_mem";
  22.861 +
  22.862 +Goalw [psubset_def] "~ (A::'a set) < A";
  22.863 +by (Fast_tac 1);
  22.864 +qed "lemma_psubset_not_refl";
  22.865 +
  22.866 +Goalw [psubset_def] "!!(A::'a set). [| A < B; B < C |] ==> A < C";
  22.867 +by (auto_tac (claset() addDs [subset_antisym],simpset()));
  22.868 +qed "psubset_trans";
  22.869 +
  22.870 +Goalw [psubset_def] "!!(A::'a set). [| A <= B; B < C |] ==> A < C";
  22.871 +by (auto_tac (claset() addDs [subset_antisym],simpset()));
  22.872 +qed "subset_psubset_trans";
  22.873 +
  22.874 +Goalw [psubset_def] "!!(A::'a set). [| A < B; B <= C |] ==> A < C";
  22.875 +by (auto_tac (claset() addDs [subset_antisym],simpset()));
  22.876 +qed "subset_psubset_trans2";
  22.877 +
  22.878 +Goalw [psubset_def] "!!(A::'a set). [| A < B; c : A |] ==> c : B";
  22.879 +by (auto_tac (claset() addDs [subsetD],simpset()));
  22.880 +qed "psubsetD";
  22.881 +
  22.882 +(** Part 1 of Dedekind sections def **)
  22.883 +Goalw [preal_less_def]
  22.884 +     "!!A. A < B ==> \
  22.885 +\     ? q. q : {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}";
  22.886 +by (EVERY1[dtac lemma_psubset_mem, etac exE, etac conjE]);
  22.887 +by (dres_inst_tac [("x1","B")] (Rep_preal RS prealE_lemma4a) 1);
  22.888 +by (auto_tac (claset(),simpset() addsimps [prat_less_def]));
  22.889 +qed "lemma_ex_mem_less_left_add1";
  22.890 +
  22.891 +Goal
  22.892 +     "!!A. A < B ==> \
  22.893 +\       {} < {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}";
  22.894 +by (dtac lemma_ex_mem_less_left_add1 1);
  22.895 +by (auto_tac (claset() addSIs [psubsetI] addEs [equalityCE],simpset()));
  22.896 +qed "preal_less_set_not_empty";
  22.897 +
  22.898 +(** Part 2 of Dedekind sections def **)
  22.899 +Goal "? q. q ~: {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}";
  22.900 +by (cut_inst_tac [("X","B")] not_mem_Rep_preal_Ex 1);
  22.901 +by (etac exE 1);
  22.902 +by (res_inst_tac [("x","x")] exI 1);
  22.903 +by Auto_tac;
  22.904 +by (cut_inst_tac [("x","x"),("y","n")] prat_self_less_add_right 1);
  22.905 +by (auto_tac (claset() addDs [Rep_preal RS prealE_lemma3b],simpset()));
  22.906 +qed "lemma_ex_not_mem_less_left_add1";
  22.907 +
  22.908 +Goal "{d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)} < {q. True}";
  22.909 +by (auto_tac (claset() addSIs [psubsetI],simpset()));
  22.910 +by (cut_inst_tac [("A","A"),("B","B")] lemma_ex_not_mem_less_left_add1 1);
  22.911 +by (etac exE 1);
  22.912 +by (eres_inst_tac [("c","q")] equalityCE 1);
  22.913 +by Auto_tac;
  22.914 +qed "preal_less_set_not_prat_set";
  22.915 +
  22.916 +(** Part 3 of Dedekind sections def **)
  22.917 +Goal "!!A. A < B ==> ! y: {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}. \
  22.918 + \      !z. z < y --> z : {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}";
  22.919 +by Auto_tac;
  22.920 +by (dres_inst_tac [("x","n")] prat_add_less2_mono2 1);
  22.921 +by (dtac (Rep_preal RS prealE_lemma3b) 1);
  22.922 +by Auto_tac;
  22.923 +qed "preal_less_set_lemma3";
  22.924 +
  22.925 +Goal "!!A. A < B ==> ! y: {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}. \
  22.926 +\       Bex {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)} (op < y)";
  22.927 +by Auto_tac;
  22.928 +by (dtac (Rep_preal RS prealE_lemma4a) 1);
  22.929 +by (auto_tac (claset(),simpset() addsimps [prat_less_def,prat_add_assoc]));
  22.930 +qed "preal_less_set_lemma4";
  22.931 +
  22.932 +Goal 
  22.933 +     "!! (A::preal). A < B ==> \
  22.934 +\     {d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}: preal";
  22.935 +by (rtac prealI2 1);
  22.936 +by (rtac preal_less_set_not_empty 1);
  22.937 +by (rtac preal_less_set_not_prat_set 2);
  22.938 +by (rtac preal_less_set_lemma3 2);
  22.939 +by (rtac preal_less_set_lemma4 3);
  22.940 +by Auto_tac;
  22.941 +qed "preal_mem_less_set";
  22.942 +
  22.943 +(** proving that A + D <= B **)
  22.944 +Goalw [preal_le_def] 
  22.945 +       "!! (A::preal). A < B ==> \
  22.946 +\         A + Abs_preal({d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}) <= B";
  22.947 +by (rtac subsetI 1);
  22.948 +by (dtac mem_Rep_preal_addD 1);
  22.949 +by (auto_tac (claset(),simpset() addsimps [
  22.950 +    preal_mem_less_set RS Abs_preal_inverse]));
  22.951 +by (dtac not_in_preal_ub 1);
  22.952 +by (dtac bspec 1 THEN assume_tac 1);
  22.953 +by (dres_inst_tac [("x","y")] prat_add_less2_mono1 1);
  22.954 +by (dres_inst_tac [("x1","B")] (Rep_preal RS prealE_lemma3b) 1);
  22.955 +by Auto_tac;
  22.956 +qed "preal_less_add_left_subsetI";
  22.957 +
  22.958 +(** proving that B <= A + D  --- trickier **)
  22.959 +(** lemma **)
  22.960 +Goal "!!x. x : Rep_preal(B) ==> ? e. x + e : Rep_preal(B)";
  22.961 +by (dtac (Rep_preal RS prealE_lemma4a) 1);
  22.962 +by (auto_tac (claset(),simpset() addsimps [prat_less_def]));
  22.963 +qed "lemma_sum_mem_Rep_preal_ex";
  22.964 +
  22.965 +Goalw [preal_le_def] 
  22.966 +       "!! (A::preal). A < B ==> \
  22.967 +\         B <= A + Abs_preal({d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)})";
  22.968 +by (rtac subsetI 1);
  22.969 +by (res_inst_tac [("Q","x: Rep_preal(A)")] (excluded_middle RS disjE) 1);
  22.970 +by (rtac mem_Rep_preal_addI 1);
  22.971 +by (dtac lemma_sum_mem_Rep_preal_ex 1);
  22.972 +by (etac exE 1);
  22.973 +by (cut_inst_tac [("R","A"),("x","e")] lemma_gleason9_34 1 THEN etac bexE 1);
  22.974 +by (dtac not_in_preal_ub 1 THEN dtac bspec 1 THEN assume_tac 1);
  22.975 +by (etac prat_lessE 1);
  22.976 +by (res_inst_tac [("x","r")] bexI 1);
  22.977 +by (res_inst_tac [("x","Q3")] bexI 1);
  22.978 +by (cut_facts_tac [Rep_preal_self_subset] 4);
  22.979 +by (auto_tac (claset(),simpset() addsimps [
  22.980 +    preal_mem_less_set RS Abs_preal_inverse]));
  22.981 +by (res_inst_tac [("x","r+e")] exI 1);
  22.982 +by (asm_full_simp_tac (simpset() addsimps prat_add_ac) 1);
  22.983 +qed "preal_less_add_left_subsetI2";
  22.984 +
  22.985 +(*** required proof ***)
  22.986 +Goal "!! (A::preal). A < B ==> \
  22.987 +\         A + Abs_preal({d. ? n. n ~: Rep_preal(A) & n + d : Rep_preal(B)}) = B";
  22.988 +by (blast_tac (claset() addIs [preal_le_anti_sym,
  22.989 +                preal_less_add_left_subsetI,preal_less_add_left_subsetI2]) 1);
  22.990 +qed "preal_less_add_left";
  22.991 +
  22.992 +Goal "!! (A::preal). A < B ==> ? D. A + D = B";
  22.993 +by (fast_tac (claset() addDs [preal_less_add_left]) 1);
  22.994 +qed "preal_less_add_left_Ex";        
  22.995 +
  22.996 +Goal "!!(A::preal). A < B ==> A + C < B + C";
  22.997 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
  22.998 +    simpset() addsimps [preal_add_assoc]));
  22.999 +by (res_inst_tac [("y1","D")] (preal_add_commute RS subst) 1);
 22.1000 +by (auto_tac (claset() addIs [preal_self_less_add_left],
 22.1001 +          simpset() addsimps [preal_add_assoc RS sym]));
 22.1002 +qed "preal_add_less2_mono1";
 22.1003 +
 22.1004 +Goal "!!(A::preal). A < B ==> C + A < C + B";
 22.1005 +by (auto_tac (claset() addIs [preal_add_less2_mono1],
 22.1006 +    simpset() addsimps [preal_add_commute]));
 22.1007 +qed "preal_add_less2_mono2";
 22.1008 +
 22.1009 +Goal 
 22.1010 +      "!!(q1::preal). q1 < q2 ==> q1 * x < q2 * x";
 22.1011 +by (dtac preal_less_add_left_Ex 1);
 22.1012 +by (auto_tac (claset(),simpset() addsimps [preal_add_mult_distrib,
 22.1013 +    preal_self_less_add_left]));
 22.1014 +qed "preal_mult_less_mono1";
 22.1015 +
 22.1016 +Goal "!!(q1::preal). q1 < q2  ==> x * q1 < x * q2";
 22.1017 +by (auto_tac (claset() addDs [preal_mult_less_mono1],
 22.1018 +    simpset() addsimps [preal_mult_commute]));
 22.1019 +qed "preal_mult_left_less_mono1";
 22.1020 +
 22.1021 +Goal "!!(q1::preal). q1 <= q2  ==> x * q1 <= x * q2";
 22.1022 +by (dtac preal_le_imp_less_or_eq 1);
 22.1023 +by (Step_tac 1);
 22.1024 +by (auto_tac (claset() addSIs [preal_le_refl,
 22.1025 +    preal_less_imp_le,preal_mult_left_less_mono1],simpset()));
 22.1026 +qed "preal_mult_left_le_mono1";
 22.1027 + 
 22.1028 +Goal "!!(q1::preal). q1 <= q2  ==> q1 * x <= q2 * x";
 22.1029 +by (auto_tac (claset() addDs [preal_mult_left_le_mono1],
 22.1030 +    simpset() addsimps [preal_mult_commute]));
 22.1031 +qed "preal_mult_le_mono1";
 22.1032 + 
 22.1033 +Goal "!!(q1::preal). q1 <= q2  ==> x + q1 <= x + q2";
 22.1034 +by (dtac preal_le_imp_less_or_eq 1);
 22.1035 +by (Step_tac 1);
 22.1036 +by (auto_tac (claset() addSIs [preal_le_refl,
 22.1037 +    preal_less_imp_le,preal_add_less2_mono1],
 22.1038 +    simpset() addsimps [preal_add_commute]));
 22.1039 +qed "preal_add_left_le_mono1";
 22.1040 +
 22.1041 +Goal "!!(q1::preal). q1 <= q2  ==> q1 + x <= q2 + x";
 22.1042 +by (auto_tac (claset() addDs [preal_add_left_le_mono1],
 22.1043 +    simpset() addsimps [preal_add_commute]));
 22.1044 +qed "preal_add_le_mono1";
 22.1045 + 
 22.1046 +Goal "!!k l::preal. [|i<=j;  k<=l |] ==> i + k <= j + l";
 22.1047 +by (etac (preal_add_le_mono1 RS preal_le_trans) 1);
 22.1048 +by (simp_tac (simpset() addsimps [preal_add_commute]) 1);
 22.1049 +(*j moves to the end because it is free while k, l are bound*)
 22.1050 +by (etac preal_add_le_mono1 1);
 22.1051 +qed "preal_add_le_mono";
 22.1052 +
 22.1053 +Goal "!!(A::preal). A + C < B + C ==> A < B";
 22.1054 +by (cut_facts_tac [preal_linear] 1);
 22.1055 +by (auto_tac (claset() addEs [preal_less_irrefl],simpset()));
 22.1056 +by (dres_inst_tac [("A","B"),("C","C")] preal_add_less2_mono1 1);
 22.1057 +by (fast_tac (claset() addDs [preal_less_trans] 
 22.1058 +                addEs [preal_less_irrefl]) 1);
 22.1059 +qed "preal_add_right_less_cancel";
 22.1060 +
 22.1061 +Goal "!!(A::preal). C + A < C + B ==> A < B";
 22.1062 +by (auto_tac (claset() addEs [preal_add_right_less_cancel],
 22.1063 +              simpset() addsimps [preal_add_commute]));
 22.1064 +qed "preal_add_left_less_cancel";
 22.1065 +
 22.1066 +Goal "((A::preal) + C < B + C) = (A < B)";
 22.1067 +by (REPEAT(ares_tac [iffI,preal_add_less2_mono1,
 22.1068 +    preal_add_right_less_cancel] 1));
 22.1069 +qed "preal_add_less_iff1";
 22.1070 +
 22.1071 +Addsimps [preal_add_less_iff1];
 22.1072 +
 22.1073 +Goal "(C + (A::preal) < C + B) = (A < B)";
 22.1074 +by (REPEAT(ares_tac [iffI,preal_add_less2_mono2,
 22.1075 +    preal_add_left_less_cancel] 1));
 22.1076 +qed "preal_add_less_iff2";
 22.1077 +
 22.1078 +Addsimps [preal_add_less_iff2];
 22.1079 +
 22.1080 +Goal 
 22.1081 +      "!!x1. [| x1 < y1; x2 < y2 |] ==> x1 + x2 < y1 + (y2::preal)";
 22.1082 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
 22.1083 +    simpset() addsimps  preal_add_ac));
 22.1084 +by (rtac (preal_add_assoc RS subst) 1);
 22.1085 +by (rtac preal_self_less_add_right 1);
 22.1086 +qed "preal_add_less_mono";
 22.1087 +
 22.1088 +Goal 
 22.1089 +      "!!x1. [| x1 < y1; x2 < y2 |] ==> x1 * x2 < y1 * (y2::preal)";
 22.1090 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
 22.1091 +              simpset() addsimps [preal_add_mult_distrib,
 22.1092 +              preal_add_mult_distrib2,preal_self_less_add_left,
 22.1093 +              preal_add_assoc] @ preal_mult_ac));
 22.1094 +qed "preal_mult_less_mono";
 22.1095 +
 22.1096 +Goal "!!(A::preal). A + C = B + C ==> A = B";
 22.1097 +by (cut_facts_tac [preal_linear] 1);
 22.1098 +by Auto_tac;
 22.1099 +by (ALLGOALS(dres_inst_tac [("C","C")] preal_add_less2_mono1));
 22.1100 +by (auto_tac (claset() addEs [preal_less_irrefl],simpset()));
 22.1101 +qed "preal_add_right_cancel";
 22.1102 +
 22.1103 +Goal "!!(A::preal). C + A = C + B ==> A = B";
 22.1104 +by (auto_tac (claset() addIs [preal_add_right_cancel],
 22.1105 +              simpset() addsimps [preal_add_commute]));
 22.1106 +qed "preal_add_left_cancel";
 22.1107 +
 22.1108 +Goal "(C + A = C + B) = ((A::preal) = B)";
 22.1109 +by (fast_tac (claset() addIs [preal_add_left_cancel]) 1);
 22.1110 +qed "preal_add_left_cancel_iff";
 22.1111 +
 22.1112 +Goal "(A + C = B + C) = ((A::preal) = B)";
 22.1113 +by (fast_tac (claset() addIs [preal_add_right_cancel]) 1);
 22.1114 +qed "preal_add_right_cancel_iff";
 22.1115 +
 22.1116 +Addsimps [preal_add_left_cancel_iff,preal_add_right_cancel_iff];
 22.1117 +
 22.1118 +(*** Completeness of preal ***)
 22.1119 +
 22.1120 +(*** prove that supremum is a cut ***)
 22.1121 +Goal "!!P. ? (X::preal). X: P ==> \
 22.1122 +\         ? q.  q: {w. ? X. X : P & w : Rep_preal X}";
 22.1123 +by Safe_tac;
 22.1124 +by (cut_inst_tac [("X","X")] mem_Rep_preal_Ex 1);
 22.1125 +by Auto_tac;
 22.1126 +qed "preal_sup_mem_Ex";
 22.1127 +
 22.1128 +(** Part 1 of Dedekind def **)
 22.1129 +Goal "!!P. ? (X::preal). X: P ==> \
 22.1130 +\         {} < {w. ? X : P. w : Rep_preal X}";
 22.1131 +by (dtac preal_sup_mem_Ex 1);
 22.1132 +by (auto_tac (claset() addSIs [psubsetI] addEs [equalityCE],simpset()));
 22.1133 +qed "preal_sup_set_not_empty";
 22.1134 +
 22.1135 +(** Part 2 of Dedekind sections def **) 
 22.1136 +Goalw [preal_less_def] "!!P. ? Y. (! X: P. X < Y)  \             
 22.1137 +\         ==> ? q. q ~: {w. ? X. X: P & w: Rep_preal(X)}"; (**)
 22.1138 +by (auto_tac (claset(),simpset() addsimps [psubset_def]));
 22.1139 +by (cut_inst_tac [("X","Y")] not_mem_Rep_preal_Ex 1);
 22.1140 +by (etac exE 1);
 22.1141 +by (res_inst_tac [("x","x")] exI 1);
 22.1142 +by (auto_tac (claset() addSDs [bspec],simpset()));
 22.1143 +qed "preal_sup_not_mem_Ex";
 22.1144 +
 22.1145 +Goalw [preal_le_def] "!!P. ? Y. (! X: P. X <= Y)  \
 22.1146 +\         ==> ? q. q ~: {w. ? X. X: P & w: Rep_preal(X)}";
 22.1147 +by (Step_tac 1);
 22.1148 +by (cut_inst_tac [("X","Y")] not_mem_Rep_preal_Ex 1);
 22.1149 +by (etac exE 1);
 22.1150 +by (res_inst_tac [("x","x")] exI 1);
 22.1151 +by (auto_tac (claset() addSDs [bspec],simpset()));
 22.1152 +qed "preal_sup_not_mem_Ex1";
 22.1153 +
 22.1154 +Goal "!!P. ? Y. (! X: P. X < Y)  \                                    
 22.1155 +\         ==> {w. ? X: P. w: Rep_preal(X)} < {q. True}";       (**)
 22.1156 +by (dtac preal_sup_not_mem_Ex 1);
 22.1157 +by (auto_tac (claset() addSIs [psubsetI],simpset()));
 22.1158 +by (eres_inst_tac [("c","q")] equalityCE 1);
 22.1159 +by Auto_tac;
 22.1160 +qed "preal_sup_set_not_prat_set";
 22.1161 +
 22.1162 +Goal "!!P. ? Y. (! X: P. X <= Y)  \
 22.1163 +\         ==> {w. ? X: P. w: Rep_preal(X)} < {q. True}";
 22.1164 +by (dtac preal_sup_not_mem_Ex1 1);
 22.1165 +by (auto_tac (claset() addSIs [psubsetI],simpset()));
 22.1166 +by (eres_inst_tac [("c","q")] equalityCE 1);
 22.1167 +by Auto_tac;
 22.1168 +qed "preal_sup_set_not_prat_set1";
 22.1169 +
 22.1170 +(** Part 3 of Dedekind sections def **)
 22.1171 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X < Y) |] \              
 22.1172 +\         ==> ! y: {w. ? X: P. w: Rep_preal X}. \
 22.1173 +\             !z. z < y --> z: {w. ? X: P. w: Rep_preal X}";         (**)
 22.1174 +by (auto_tac(claset() addEs [Rep_preal RS prealE_lemma3b],simpset()));
 22.1175 +qed "preal_sup_set_lemma3";
 22.1176 +
 22.1177 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X <= Y) |] \
 22.1178 +\         ==> ! y: {w. ? X: P. w: Rep_preal X}. \
 22.1179 +\             !z. z < y --> z: {w. ? X: P. w: Rep_preal X}";
 22.1180 +by (auto_tac(claset() addEs [Rep_preal RS prealE_lemma3b],simpset()));
 22.1181 +qed "preal_sup_set_lemma3_1";
 22.1182 +
 22.1183 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X < Y) |] \              
 22.1184 +\         ==>  !y: {w. ? X: P. w: Rep_preal X}. \                        
 22.1185 +\             Bex {w. ? X: P. w: Rep_preal X} (op < y)";                (**)
 22.1186 +by (blast_tac (claset() addDs [(Rep_preal RS prealE_lemma4a)]) 1);
 22.1187 +qed "preal_sup_set_lemma4";
 22.1188 +
 22.1189 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X <= Y) |] \
 22.1190 +\         ==>  !y: {w. ? X: P. w: Rep_preal X}. \
 22.1191 +\             Bex {w. ? X: P. w: Rep_preal X} (op < y)";
 22.1192 +by (blast_tac (claset() addDs [(Rep_preal RS prealE_lemma4a)]) 1);
 22.1193 +qed "preal_sup_set_lemma4_1";
 22.1194 +
 22.1195 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X < Y) |] \            
 22.1196 +\         ==> {w. ? X: P. w: Rep_preal(X)}: preal";                      (**)
 22.1197 +by (rtac prealI2 1);
 22.1198 +by (rtac preal_sup_set_not_empty 1);
 22.1199 +by (rtac preal_sup_set_not_prat_set 2);
 22.1200 +by (rtac preal_sup_set_lemma3 3);
 22.1201 +by (rtac preal_sup_set_lemma4 5);
 22.1202 +by Auto_tac;
 22.1203 +qed "preal_sup";
 22.1204 +
 22.1205 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X <= Y) |] \
 22.1206 +\         ==> {w. ? X: P. w: Rep_preal(X)}: preal";
 22.1207 +by (rtac prealI2 1);
 22.1208 +by (rtac preal_sup_set_not_empty 1);
 22.1209 +by (rtac preal_sup_set_not_prat_set1 2);
 22.1210 +by (rtac preal_sup_set_lemma3_1 3);
 22.1211 +by (rtac preal_sup_set_lemma4_1 5);
 22.1212 +by Auto_tac;
 22.1213 +qed "preal_sup1";
 22.1214 +
 22.1215 +Goalw [psup_def] "!!P. ? Y. (! X:P. X < Y) ==> ! x: P. x <= psup P";      (**) 
 22.1216 +by (auto_tac (claset(),simpset() addsimps [preal_le_def]));
 22.1217 +by (rtac (preal_sup RS Abs_preal_inverse RS ssubst) 1);
 22.1218 +by Auto_tac;
 22.1219 +qed "preal_psup_leI";
 22.1220 +
 22.1221 +Goalw [psup_def] "!!P. ? Y. (! X:P. X <= Y) ==> ! x: P. x <= psup P";
 22.1222 +by (auto_tac (claset(),simpset() addsimps [preal_le_def]));
 22.1223 +by (rtac (preal_sup1 RS Abs_preal_inverse RS ssubst) 1);
 22.1224 +by (auto_tac (claset(),simpset() addsimps [preal_le_def]));
 22.1225 +qed "preal_psup_leI2";
 22.1226 +
 22.1227 +Goal "!!P. [| ? Y. (! X:P. X < Y); x : P |] ==> x <= psup P";              (**)
 22.1228 +by (blast_tac (claset() addSDs [preal_psup_leI]) 1);
 22.1229 +qed "preal_psup_leI2b";
 22.1230 +
 22.1231 +Goal "!!P. [| ? Y. (! X:P. X <= Y); x : P |] ==> x <= psup P";
 22.1232 +by (blast_tac (claset() addSDs [preal_psup_leI2]) 1);
 22.1233 +qed "preal_psup_leI2a";
 22.1234 +
 22.1235 +Goalw [psup_def] "!!P. [| ? X. X : P; ! X:P. X < Y |] ==> psup P <= Y";   (**)
 22.1236 +by (auto_tac (claset(),simpset() addsimps [preal_le_def]));
 22.1237 +by (dtac (([exI,exI] MRS preal_sup) RS Abs_preal_inverse RS subst) 1);
 22.1238 +by (rotate_tac 1 2);
 22.1239 +by (assume_tac 2);
 22.1240 +by (auto_tac (claset() addSDs [bspec],simpset() addsimps [preal_less_def,psubset_def]));
 22.1241 +qed "psup_le_ub";
 22.1242 +
 22.1243 +Goalw [psup_def] "!!P. [| ? X. X : P; ! X:P. X <= Y |] ==> psup P <= Y";
 22.1244 +by (auto_tac (claset(),simpset() addsimps [preal_le_def]));
 22.1245 +by (dtac (([exI,exI] MRS preal_sup1) RS Abs_preal_inverse RS subst) 1);
 22.1246 +by (rotate_tac 1 2);
 22.1247 +by (assume_tac 2);
 22.1248 +by (auto_tac (claset() addSDs [bspec],
 22.1249 +    simpset() addsimps [preal_less_def,psubset_def,preal_le_def]));
 22.1250 +qed "psup_le_ub1";
 22.1251 +
 22.1252 +(** supremum property **)
 22.1253 +Goal "!!P. [|? (X::preal). X: P; ? Y. (! X:P. X < Y) |] \                  
 22.1254 +\         ==> (!Y. (? X: P. Y < X) = (Y < psup P))";              
 22.1255 +by (forward_tac [preal_sup RS Abs_preal_inverse] 1);
 22.1256 +by (Fast_tac 1);
 22.1257 +by (auto_tac (claset() addSIs [psubsetI],simpset() addsimps [psup_def,preal_less_def]));
 22.1258 +by (blast_tac (claset() addDs [psubset_def RS meta_eq_to_obj_eq RS iffD1]) 1);
 22.1259 +by (rotate_tac 4 1);
 22.1260 +by (asm_full_simp_tac (simpset() addsimps [psubset_def]) 1);
 22.1261 +by (dtac bspec 1 THEN assume_tac 1);
 22.1262 +by (REPEAT(etac conjE 1));
 22.1263 +by (EVERY1[rtac swap, assume_tac, rtac set_ext]);
 22.1264 +by (auto_tac (claset() addSDs [lemma_psubset_mem],simpset()));
 22.1265 +by (cut_inst_tac [("r1.0","Xa"),("r2.0","Ya")] preal_linear 1);
 22.1266 +by (auto_tac (claset() addDs [psubsetD],simpset() addsimps [preal_less_def]));
 22.1267 +qed "preal_complete";
 22.1268 +
 22.1269 +(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)
 22.1270 +    (****** Embedding ******)
 22.1271 +(*** mapping from prat into preal ***)
 22.1272 +
 22.1273 +Goal "!!z1. x < z1 + z2 ==> x * z1 * qinv (z1 + z2) < z1";
 22.1274 +by (dres_inst_tac [("x","z1 * qinv (z1 + z2)")] prat_mult_less2_mono1 1);
 22.1275 +by (asm_full_simp_tac (simpset() addsimps prat_mult_ac) 1);
 22.1276 +qed "lemma_preal_rat_less";
 22.1277 +
 22.1278 +Goal "!!z1. x < z1 + z2 ==> x * z2 * qinv (z1 + z2) < z2";
 22.1279 +by (stac prat_add_commute 1);
 22.1280 +by (dtac (prat_add_commute RS subst) 1);
 22.1281 +by (etac lemma_preal_rat_less 1);
 22.1282 +qed "lemma_preal_rat_less2";
 22.1283 +
 22.1284 +Goalw [preal_prat_def,preal_add_def] 
 22.1285 +            "@#((z1::prat) + z2) = @#z1 + @#z2";
 22.1286 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
 22.1287 +by (auto_tac (claset() addIs [prat_add_less_mono] addSIs [set_ext],simpset() addsimps 
 22.1288 +    [lemma_prat_less_set_mem_preal RS Abs_preal_inverse]));
 22.1289 +by (res_inst_tac [("x","x*z1*qinv(z1+z2)")] exI 1 THEN rtac conjI 1);
 22.1290 +by (etac lemma_preal_rat_less 1);
 22.1291 +by (res_inst_tac [("x","x*z2*qinv(z1+z2)")] exI 1 THEN rtac conjI 1);
 22.1292 +by (etac lemma_preal_rat_less2 1);
 22.1293 +by (asm_full_simp_tac (simpset() addsimps [prat_add_mult_distrib RS sym,
 22.1294 +     prat_add_mult_distrib2 RS sym] @ prat_mult_ac) 1);
 22.1295 +qed "preal_prat_add";
 22.1296 +
 22.1297 +Goal "!!xa. x < xa ==> x*z1*qinv(xa) < z1";
 22.1298 +by (dres_inst_tac [("x","z1 * qinv xa")] prat_mult_less2_mono1 1);
 22.1299 +by (dtac (prat_mult_left_commute RS subst) 1);
 22.1300 +by (asm_full_simp_tac (simpset() addsimps prat_mult_ac) 1);
 22.1301 +qed "lemma_preal_rat_less3";
 22.1302 +
 22.1303 +Goal "!!xa. xa < z1 * z2 ==> xa*z2*qinv(z1*z2) < z2";
 22.1304 +by (dres_inst_tac [("x","z2 * qinv(z1*z2)")] prat_mult_less2_mono1 1);
 22.1305 +by (dtac (prat_mult_left_commute RS subst) 1);
 22.1306 +by (asm_full_simp_tac (simpset() addsimps prat_mult_ac) 1);
 22.1307 +qed "lemma_preal_rat_less4";
 22.1308 +
 22.1309 +Goalw [preal_prat_def,preal_mult_def] 
 22.1310 +            "@#((z1::prat) * z2) = @#z1 * @#z2";
 22.1311 +by (res_inst_tac [("f","Abs_preal")] arg_cong 1);
 22.1312 +by (auto_tac (claset() addIs [prat_mult_less_mono] addSIs [set_ext],simpset() addsimps 
 22.1313 +    [lemma_prat_less_set_mem_preal RS Abs_preal_inverse]));
 22.1314 +by (dtac prat_dense 1);
 22.1315 +by (Step_tac 1);
 22.1316 +by (res_inst_tac [("x","x*z1*qinv(xa)")] exI 1 THEN rtac conjI 1);
 22.1317 +by (etac lemma_preal_rat_less3 1);
 22.1318 +by (res_inst_tac [("x"," xa*z2*qinv(z1*z2)")] exI 1 THEN rtac conjI 1);
 22.1319 +by (etac lemma_preal_rat_less4 1);
 22.1320 +by (asm_full_simp_tac (simpset() 
 22.1321 +    addsimps [qinv_mult_eq RS sym] @ prat_mult_ac) 1);
 22.1322 +by (asm_full_simp_tac (simpset() 
 22.1323 +    addsimps [prat_mult_assoc RS sym]) 1);
 22.1324 +qed "preal_prat_mult";
 22.1325 +
 22.1326 +Goalw [preal_prat_def,preal_less_def] 
 22.1327 +      "(@#p < @#q) = (p < q)";
 22.1328 +by (auto_tac (claset() addSDs [lemma_prat_set_eq] addEs [prat_less_trans],
 22.1329 +    simpset() addsimps [lemma_prat_less_set_mem_preal,
 22.1330 +    psubset_def,prat_less_not_refl]));
 22.1331 +by (res_inst_tac [("q1.0","p"),("q2.0","q")] prat_linear_less2 1);
 22.1332 +by (auto_tac (claset() addIs [prat_less_irrefl],simpset()));
 22.1333 +qed "preal_prat_less_iff";
 22.1334 +
 22.1335 +Addsimps [preal_prat_less_iff];
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/HOL/Real/PReal.thy	Thu Jun 25 13:57:34 1998 +0200
    23.3 @@ -0,0 +1,42 @@
    23.4 +(*   Title       : PReal.thy
    23.5 +    Author      : Jacques D. Fleuriot
    23.6 +    Copyright   : 1998  University of Cambridge
    23.7 +    Description : The positive reals as Dedekind sections of positive
    23.8 +                  rationals. Fundamentals of Abstract Analysis [Gleason- p. 121] 
    23.9 +                  provides some of the definitions.
   23.10 +*)
   23.11 +
   23.12 +PReal = PRat +
   23.13 +
   23.14 +typedef preal = "{A::prat set. {} < A & A < {q::prat. True} &
   23.15 +                               (!y: A. ((!z. z < y --> z: A) &
   23.16 +                                        (? u: A. y < u)))}"      (preal_1)
   23.17 +instance
   23.18 +   preal :: {ord, plus, times}
   23.19 +
   23.20 +constdefs
   23.21 +  preal_prat :: prat => preal              ("@#_" [80] 80)
   23.22 +   "@# q     == Abs_preal({x::prat. x < q})"
   23.23 +
   23.24 +  pinv       :: preal => preal
   23.25 +  "pinv(R)   == Abs_preal({w. ? y. w < y & qinv y ~: Rep_preal(R)})" 
   23.26 +
   23.27 +  psup       :: preal set => preal
   23.28 +  "psup(P)   == Abs_preal({w. ? X: P. w: Rep_preal(X)})"
   23.29 +
   23.30 +defs
   23.31 +
   23.32 +  preal_add_def
   23.33 +        "R + S == Abs_preal({w. ? x: Rep_preal(R). ? y: Rep_preal(S). w = x + y})"
   23.34 +
   23.35 +  preal_mult_def
   23.36 +        "R * S == Abs_preal({w. ? x: Rep_preal(R). ? y: Rep_preal(S). w = x * y})"
   23.37 +
   23.38 +  preal_less_def
   23.39 +        "R < (S::preal) == Rep_preal(R) < Rep_preal(S)"
   23.40 +
   23.41 +  preal_le_def
   23.42 +        "R <= (S::preal) == Rep_preal(R) <= Rep_preal(S)"
   23.43 + 
   23.44 +end
   23.45 +
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/HOL/Real/RComplete.ML	Thu Jun 25 13:57:34 1998 +0200
    24.3 @@ -0,0 +1,218 @@
    24.4 +(*  Title       : RComplete.thy
    24.5 +    Author      : Jacques D. Fleuriot
    24.6 +    Copyright   : 1998  University of Cambridge
    24.7 +    Description : Completeness theorems for positive
    24.8 +                  reals and reals 
    24.9 +*) 
   24.10 +
   24.11 +
   24.12 +open RComplete;
   24.13 +
   24.14 +Goal "!!(x::real). [| isLub R S x; isLub R S y |] ==> x = y";
   24.15 +by (forward_tac [isLub_isUb] 1);
   24.16 +by (forw_inst_tac [("x","y")] isLub_isUb 1);
   24.17 +by (blast_tac (claset() addSIs [real_le_anti_sym]
   24.18 +                addSDs [isLub_le_isUb]) 1);
   24.19 +qed "real_isLub_unique";
   24.20 +
   24.21 +Goalw [setle_def,setge_def] 
   24.22 +         "!!x::real. [| x <=* S'; S <= S' |] ==> x <=* S";
   24.23 +by (Blast_tac 1);
   24.24 +qed "real_order_restrict";
   24.25 +
   24.26 +(*----------------------------------------------------------------
   24.27 +           Completeness theorem for the positive reals(again)
   24.28 + ----------------------------------------------------------------*)
   24.29 +
   24.30 +Goal "!!S. [| ALL x: S. 0r < x; \
   24.31 +\                 EX x. x: S; \
   24.32 +\                 EX u. isUb (UNIV::real set) S u \
   24.33 +\              |] ==> EX t. isLub (UNIV::real set) S t";
   24.34 +by (res_inst_tac [("x","%#psup({w. %#w : S})")] exI 1);
   24.35 +by (auto_tac (claset(),simpset() addsimps [isLub_def,leastP_def,isUb_def]));
   24.36 +by (auto_tac (claset() addSIs [setleI,setgeI] 
   24.37 +    addSDs [real_gt_zero_preal_Ex RS iffD1],simpset()));
   24.38 +by (forw_inst_tac [("x","y")] bspec 1 THEN assume_tac 1);
   24.39 +by (dtac (real_gt_zero_preal_Ex RS iffD1) 1);
   24.40 +by (auto_tac (claset(),simpset() addsimps [real_preal_le_iff]));
   24.41 +by (rtac preal_psup_leI2a 1);
   24.42 +by (forw_inst_tac [("y","%#ya")] setleD 1 THEN assume_tac 1);
   24.43 +by (forward_tac  [real_ge_preal_preal_Ex] 1);
   24.44 +by (Step_tac 1);
   24.45 +by (res_inst_tac [("x","y")] exI 1);
   24.46 +by (blast_tac (claset() addSDs [setleD] addIs [real_preal_le_iff RS iffD1]) 1);
   24.47 +by (forw_inst_tac [("x","x")] bspec 1 THEN assume_tac 1);
   24.48 +by (forward_tac [isUbD2] 1);
   24.49 +by (dtac (real_gt_zero_preal_Ex RS iffD1) 1);
   24.50 +by (auto_tac (claset() addSDs [isUbD,
   24.51 +    real_ge_preal_preal_Ex],simpset() addsimps [real_preal_le_iff]));
   24.52 +by (blast_tac (claset() addSDs [setleD] addSIs 
   24.53 +    [psup_le_ub1] addIs [real_preal_le_iff RS iffD1]) 1);
   24.54 +qed "posreals_complete";
   24.55 +
   24.56 +
   24.57 +(*-------------------------------
   24.58 +    Lemmas
   24.59 + -------------------------------*)
   24.60 +Goal "! y : {z. ? x: P. z = x + %~xa + 1r} Int {x. 0r < x}. 0r < y";
   24.61 +by Auto_tac;
   24.62 +qed "real_sup_lemma3";
   24.63 + 
   24.64 +(* lemmas re-arranging the terms *)
   24.65 +Goal "(S <= Y + %~X + Z) = (S + X + %~Z <= Y)";
   24.66 +by (Step_tac 1);
   24.67 +by (dres_inst_tac [("x","%~Z")] real_add_le_mono1 1);
   24.68 +by (dres_inst_tac [("x","Z")] real_add_le_mono1 2);
   24.69 +by (auto_tac (claset(),simpset() addsimps [real_add_assoc,
   24.70 +    real_add_minus,real_add_zero_right,real_add_minus_left]));
   24.71 +by (dres_inst_tac [("x","X")] real_add_le_mono1 1);
   24.72 +by (dres_inst_tac [("x","%~X")] real_add_le_mono1 2);
   24.73 +by (auto_tac (claset(),simpset() addsimps [real_add_assoc,
   24.74 +    real_add_minus,real_add_zero_right,real_add_minus_left]));
   24.75 +by (auto_tac (claset(),simpset() addsimps [real_add_commute]));
   24.76 +qed "lemma_le_swap";
   24.77 +
   24.78 +Goal "(xa <= S + X + %~Z) = (xa + %~X + Z <= S)";
   24.79 +by (Step_tac 1);
   24.80 +by (dres_inst_tac [("x","Z")] real_add_le_mono1 1);
   24.81 +by (dres_inst_tac [("x","%~Z")] real_add_le_mono1 2);
   24.82 +by (auto_tac (claset(),simpset() addsimps [real_add_assoc,
   24.83 +    real_add_minus,real_add_zero_right,real_add_minus_left]));
   24.84 +by (dres_inst_tac [("x","%~X")] real_add_le_mono1 1);
   24.85 +by (dres_inst_tac [("x","X")] real_add_le_mono1 2);
   24.86 +by (auto_tac (claset(),simpset() addsimps [real_add_assoc,
   24.87 +    real_add_minus,real_add_zero_right,real_add_minus_left]));
   24.88 +by (auto_tac (claset(),simpset() addsimps [real_add_commute]));
   24.89 +qed "lemma_le_swap2";
   24.90 +
   24.91 +Goal "!!x. [| 0r < x + %~X + 1r; x < xa |] ==> 0r < xa + %~X + 1r";
   24.92 +by (dtac real_add_less_mono 1);
   24.93 +by (assume_tac 1);
   24.94 +by (dres_inst_tac [("C","%~x"),("A","0r + x")] real_add_less_mono2 1);
   24.95 +by (asm_full_simp_tac (simpset() addsimps [real_add_zero_right,
   24.96 +    real_add_assoc RS sym,real_add_minus_left,real_add_zero_left]) 1);
   24.97 +by (asm_full_simp_tac (simpset() addsimps real_add_ac) 1);
   24.98 +qed "lemma_real_complete1";
   24.99 +
  24.100 +Goal "!!x. [| x + %~X + 1r <= S; xa < x |] ==> xa + %~X + 1r <= S";
  24.101 +by (dtac real_less_imp_le 1);
  24.102 +by (dtac real_add_le_mono 1);
  24.103 +by (assume_tac 1);
  24.104 +by (asm_full_simp_tac (simpset() addsimps real_add_ac) 1);
  24.105 +by (dres_inst_tac [("x","%~x"),("q2.0","x + S")] real_add_left_le_mono1 1);
  24.106 +by (asm_full_simp_tac (simpset() addsimps [real_add_assoc RS sym,
  24.107 +        real_add_minus_left,real_add_zero_left]) 1);
  24.108 +qed "lemma_real_complete2";
  24.109 +
  24.110 +Goal "!!x. [| x + %~X + 1r <= S; xa < x |] ==> xa <= S + X + %~1r"; (**)
  24.111 +by (rtac (lemma_le_swap2 RS iffD2) 1);
  24.112 +by (etac lemma_real_complete2 1);
  24.113 +by (assume_tac 1);
  24.114 +qed "lemma_real_complete2a";
  24.115 +
  24.116 +Goal "!!x. [| x + %~X + 1r <= S; xa <= x |] ==> xa <= S + X + %~1r";
  24.117 +by (rotate_tac 1 1);
  24.118 +by (etac (real_le_imp_less_or_eq RS disjE) 1);
  24.119 +by (blast_tac (claset() addIs [lemma_real_complete2a]) 1);
  24.120 +by (blast_tac (claset() addIs [(lemma_le_swap2 RS iffD2)]) 1);
  24.121 +qed "lemma_real_complete2b";
  24.122 +
  24.123 +(*------------------------------------
  24.124 +      reals Completeness (again!)
  24.125 + ------------------------------------*)
  24.126 +Goal "!!(S::real set). [| EX X. X: S; \
  24.127 +\                             EX Y. isUb (UNIV::real set) S Y \
  24.128 +\                          |] ==> EX t. isLub (UNIV :: real set) S t";
  24.129 +by (Step_tac 1);
  24.130 +by (subgoal_tac "? u. u: {z. ? x: S. z = x + %~X + 1r} \
  24.131 +\                Int {x. 0r < x}" 1);
  24.132 +by (subgoal_tac "isUb (UNIV::real set) ({z. ? x: S. z = x + %~X + 1r} \
  24.133 +\                Int {x. 0r < x})  (Y + %~X + 1r)" 1); 
  24.134 +by (cut_inst_tac [("P","S"),("xa","X")] real_sup_lemma3 1);
  24.135 +by (EVERY1[forward_tac [exI RSN (3,posreals_complete)], Blast_tac, Blast_tac, Step_tac]);
  24.136 +by (res_inst_tac [("x","t + X + %~1r")] exI 1);
  24.137 +by (rtac isLubI2 1);
  24.138 +by (rtac setgeI 2 THEN Step_tac 2);
  24.139 +by (subgoal_tac "isUb (UNIV:: real set) ({z. ? x: S. z = x + %~X + 1r} \
  24.140 +\                Int {x. 0r < x})  (y + %~X + 1r)" 2); 
  24.141 +by (dres_inst_tac [("y","(y + %~ X + 1r)")] isLub_le_isUb 2 
  24.142 +      THEN assume_tac 2);
  24.143 +by (etac (lemma_le_swap RS subst) 2);
  24.144 +by (rtac (setleI RS isUbI) 1);
  24.145 +by (Step_tac 1);
  24.146 +by (res_inst_tac [("R1.0","x"),("R2.0","y")] real_linear_less2 1);
  24.147 +by (stac lemma_le_swap2 1);
  24.148 +by (forward_tac [isLubD2] 1 THEN assume_tac 2);
  24.149 +by (Step_tac 1);
  24.150 +by (Blast_tac 1);
  24.151 +by (dtac lemma_real_complete1 1 THEN REPEAT(assume_tac 1));
  24.152 +by (stac lemma_le_swap2 1);
  24.153 +by (forward_tac [isLubD2] 1 THEN assume_tac 2);
  24.154 +by (Blast_tac 1);
  24.155 +by (rtac lemma_real_complete2b 1);
  24.156 +by (etac real_less_imp_le 2);
  24.157 +by (blast_tac (claset() addSIs [isLubD2]) 1 THEN Step_tac 1);
  24.158 +by (blast_tac (claset() addDs [isUbD] addSIs [(setleI RS isUbI)]
  24.159 +    addIs [real_add_le_mono1,real_add_assoc RS ssubst]) 1);
  24.160 +by (blast_tac (claset() addDs [isUbD] addSIs [(setleI RS isUbI)]
  24.161 +    addIs [real_add_le_mono1,real_add_assoc RS ssubst]) 1);
  24.162 +by (auto_tac (claset(),simpset() addsimps [real_add_assoc RS sym,
  24.163 +     real_add_minus,real_add_zero_left,real_zero_less_one]));
  24.164 +qed "reals_complete";
  24.165 +
  24.166 +(*----------------------------------------------------------------
  24.167 +        Related property: Archimedean property of reals
  24.168 + ----------------------------------------------------------------*)
  24.169 +
  24.170 +Goal "(ALL m. x*%%#m + x <= t) = (ALL m. x*%%#m <= t + %~x)";
  24.171 +by Auto_tac;
  24.172 +by (ALLGOALS(dres_inst_tac [("x","m")] spec));
  24.173 +by (dres_inst_tac [("x","%~x")] real_add_le_mono1 1);
  24.174 +by (dres_inst_tac [("x","x")] real_add_le_mono1 2);
  24.175 +by (auto_tac (claset(),simpset() addsimps [real_add_assoc,
  24.176 +      real_add_minus,real_add_minus_left,real_add_zero_right]));
  24.177 +qed "lemma_arch";
  24.178 +
  24.179 +Goal "!!x. 0r < x ==> EX n. rinv(%%#n) < x";
  24.180 +by (stac real_nat_rinv_Ex_iff 1);
  24.181 +by (EVERY1[rtac ccontr, Asm_full_simp_tac]);
  24.182 +by (fold_tac [real_le_def]);
  24.183 +by (subgoal_tac "isUb (UNIV::real set) {z. EX n. z = x*%%#n} 1r" 1);
  24.184 +by (subgoal_tac "EX X. X : {z. EX n. z = x*%%#n}" 1);
  24.185 +by (dtac reals_complete 1);
  24.186 +by (auto_tac (claset() addIs [isUbI,setleI],simpset()));
  24.187 +by (subgoal_tac "ALL m. x*(%%#Suc m) <= t" 1);
  24.188 +by (asm_full_simp_tac (simpset() addsimps 
  24.189 +   [real_nat_Suc,real_add_mult_distrib2]) 1);
  24.190 +by (blast_tac (claset() addIs [isLubD2]) 2);
  24.191 +by (asm_full_simp_tac (simpset() addsimps [lemma_arch]) 1);
  24.192 +by (subgoal_tac "isUb (UNIV::real set) {z. EX n. z = x*%%#n} (t + %~x)" 1);
  24.193 +by (blast_tac (claset() addSIs [isUbI,setleI]) 2);
  24.194 +by (dres_inst_tac [("y","t+%~x")] isLub_le_isUb 1);
  24.195 +by (dres_inst_tac [("x","%~t")] real_add_left_le_mono1 2);
  24.196 +by (auto_tac (claset() addDs [real_le_less_trans,
  24.197 +    (real_minus_zero_less_iff2 RS iffD2)], simpset() 
  24.198 +    addsimps [real_less_not_refl,real_add_assoc RS sym,
  24.199 +    real_add_minus_left,real_add_zero_left]));
  24.200 +qed "reals_Archimedean";
  24.201 +
  24.202 +Goal "EX n. (x::real) < %%#n";
  24.203 +by (res_inst_tac [("R1.0","x"),("R2.0","0r")] real_linear_less2 1);
  24.204 +by (res_inst_tac [("x","0")] exI 1);
  24.205 +by (res_inst_tac [("x","0")] exI 2);
  24.206 +by (auto_tac (claset() addEs [real_less_trans],
  24.207 +    simpset() addsimps [real_nat_one,real_zero_less_one]));
  24.208 +by (forward_tac [(real_rinv_gt_zero RS reals_Archimedean)] 1);
  24.209 +by (Step_tac 1 THEN res_inst_tac [("x","n")] exI 1);
  24.210 +by (forw_inst_tac [("y","rinv x")] real_mult_less_mono1 1);
  24.211 +by (auto_tac (claset(),simpset() addsimps [real_not_refl2 RS not_sym]));
  24.212 +by (dres_inst_tac [("n1","n"),("y","1r")] 
  24.213 +     (real_nat_less_zero RS real_mult_less_mono2)  1);
  24.214 +by (auto_tac (claset(),simpset() addsimps [real_nat_less_zero,
  24.215 +    real_not_refl2 RS not_sym,real_mult_assoc RS sym]));
  24.216 +qed "reals_Archimedean2";
  24.217 +
  24.218 +
  24.219 +
  24.220 +
  24.221 +
    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/HOL/Real/RComplete.thy	Thu Jun 25 13:57:34 1998 +0200
    25.3 @@ -0,0 +1,9 @@
    25.4 +(*  Title       : RComplete.thy
    25.5 +    Author      : Jacques D. Fleuriot
    25.6 +    Copyright   : 1998  University of Cambridge
    25.7 +    Description : Completeness theorems for positive
    25.8 +                  reals and reals 
    25.9 +*) 
   25.10 +
   25.11 +RComplete = Lubs + Real
   25.12 +
    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/HOL/Real/README.html	Thu Jun 25 13:57:34 1998 +0200
    26.3 @@ -0,0 +1,29 @@
    26.4 +<!-- $Id$ -->
    26.5 +<HTML><HEAD><TITLE>HOL/Real/README</TITLE></HEAD><BODY>
    26.6 +
    26.7 +<H2>Real--Dedekind Cut Construction of the Real Line</H2>
    26.8 +
    26.9 +<P>Requires <A HREF="../Integ/Equiv.thy">Equiv.thy</A> in the subdirectory <A
   26.10 +HREF="../Integ">HOL/Integ</A>.
   26.11 +
   26.12 +<UL>
   26.13 +<LI><A HREF="PNat.thy">PNat</A>  The positive integers (very much the same as <A HREF="../Nat.thy">Nat.thy</A>!) 
   26.14 +<LI><A HREF="PRat.thy">PRat</A>  The positive rationals
   26.15 +<LI><A HREF="PReal.thy">PReal</A> The positive reals constructed using Dedekind cuts
   26.16 +<LI><A HREF="Real.thy">Real</A>  The real numbers
   26.17 +<LI><A HREF="Lubs.thy">Lubs</A>  Definition of upper bounds, lubs and so on. 
   26.18 +     (Useful e.g. in Fleuriot's NSA theory)
   26.19 +<LI><A HREF="RComplete.thy">RComplete</A> Proof of completeness of reals in form of the supremum 
   26.20 +            property. Also proofs that the reals have the Archimedean
   26.21 +            property.
   26.22 +<LI><A HREF="RealAbs.thy">RealAbs</A> The absolute value function defined for the reals
   26.23 +</UL>
   26.24 +
   26.25 +<P>Last modified on $Date$
   26.26 +
   26.27 +<HR>
   26.28 +
   26.29 +<ADDRESS>
   26.30 +<A NAME="lcp@cl.cam.ac.uk" HREF="mailto:lcp@cl.cam.ac.uk">lcp@cl.cam.ac.uk</A>
   26.31 +</ADDRESS>
   26.32 +</BODY></HTML>
    27.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.2 +++ b/src/HOL/Real/ROOT.ML	Thu Jun 25 13:57:34 1998 +0200
    27.3 @@ -0,0 +1,15 @@
    27.4 +(*  Title:      HOL/Real/ROOT
    27.5 +    ID:         $Id$
    27.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    27.7 +    Copyright   1998  University of Cambridge
    27.8 +
    27.9 +Construction of the Reals using Dedekind Cuts, by Jacques Fleuriot
   27.10 +*)
   27.11 +
   27.12 +HOL_build_completed;    (*Make examples fail if HOL did*)
   27.13 +
   27.14 +writeln"Root file for HOL/Real";
   27.15 +
   27.16 +set proof_timing;
   27.17 +time_use_thy "RealAbs";
   27.18 +time_use_thy "RComplete";
    28.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.2 +++ b/src/HOL/Real/Real.ML	Thu Jun 25 13:57:34 1998 +0200
    28.3 @@ -0,0 +1,1464 @@
    28.4 +(*  Title       : Real.ML
    28.5 +    Author      : Jacques D. Fleuriot
    28.6 +    Copyright   : 1998  University of Cambridge
    28.7 +    Description : The reals
    28.8 +*)
    28.9 +
   28.10 +open Real;
   28.11 +
   28.12 +(*** Proving that realrel is an equivalence relation ***)
   28.13 +
   28.14 +Goal
   28.15 +    "!! x1. [| (x1::preal) + y2 = x2 + y1; x2 + y3 = x3 + y2 |] \
   28.16 +\            ==> x1 + y3 = x3 + y1";        
   28.17 +by (res_inst_tac [("C","y2")] preal_add_right_cancel 1);
   28.18 +by (rotate_tac 1 1 THEN dtac sym 1);
   28.19 +by (asm_full_simp_tac (simpset() addsimps preal_add_ac) 1);
   28.20 +by (rtac (preal_add_left_commute RS subst) 1);
   28.21 +by (res_inst_tac [("x1","x1")] (preal_add_assoc RS subst) 1);
   28.22 +by (asm_full_simp_tac (simpset() addsimps preal_add_ac) 1);
   28.23 +qed "preal_trans_lemma";
   28.24 +
   28.25 +(** Natural deduction for realrel **)
   28.26 +
   28.27 +Goalw [realrel_def]
   28.28 +    "(((x1,y1),(x2,y2)): realrel) = (x1 + y2 = x2 + y1)";
   28.29 +by (Fast_tac 1);
   28.30 +qed "realrel_iff";
   28.31 +
   28.32 +Goalw [realrel_def]
   28.33 +    "!!x1 x2. [| x1 + y2 = x2 + y1 |] ==> ((x1,y1),(x2,y2)): realrel";
   28.34 +by (Fast_tac  1);
   28.35 +qed "realrelI";
   28.36 +
   28.37 +Goalw [realrel_def]
   28.38 +  "p: realrel --> (EX x1 y1 x2 y2. \
   28.39 +\                  p = ((x1,y1),(x2,y2)) & x1 + y2 = x2 + y1)";
   28.40 +by (Fast_tac 1);
   28.41 +qed "realrelE_lemma";
   28.42 +
   28.43 +val [major,minor] = goal thy
   28.44 +  "[| p: realrel;  \
   28.45 +\     !!x1 y1 x2 y2. [| p = ((x1,y1),(x2,y2));  x1+y2 = x2+y1 \
   28.46 +\                    |] ==> Q |] ==> Q";
   28.47 +by (cut_facts_tac [major RS (realrelE_lemma RS mp)] 1);
   28.48 +by (REPEAT (eresolve_tac [asm_rl,exE,conjE,minor] 1));
   28.49 +qed "realrelE";
   28.50 +
   28.51 +AddSIs [realrelI];
   28.52 +AddSEs [realrelE];
   28.53 +
   28.54 +Goal "(x,x): realrel";
   28.55 +by (stac surjective_pairing 1 THEN rtac (refl RS realrelI) 1);
   28.56 +qed "realrel_refl";
   28.57 +
   28.58 +Goalw [equiv_def, refl_def, sym_def, trans_def]
   28.59 +    "equiv {x::(preal*preal).True} realrel";
   28.60 +by (fast_tac (claset() addSIs [realrel_refl] 
   28.61 +                      addSEs [sym,preal_trans_lemma]) 1);
   28.62 +qed "equiv_realrel";
   28.63 +
   28.64 +val equiv_realrel_iff =
   28.65 +    [TrueI, TrueI] MRS 
   28.66 +    ([CollectI, CollectI] MRS 
   28.67 +    (equiv_realrel RS eq_equiv_class_iff));
   28.68 +
   28.69 +Goalw  [real_def,realrel_def,quotient_def] "realrel^^{(x,y)}:real";
   28.70 +by (Blast_tac 1);
   28.71 +qed "realrel_in_real";
   28.72 +
   28.73 +Goal "inj_on Abs_real real";
   28.74 +by (rtac inj_on_inverseI 1);
   28.75 +by (etac Abs_real_inverse 1);
   28.76 +qed "inj_on_Abs_real";
   28.77 +
   28.78 +Addsimps [equiv_realrel_iff,inj_on_Abs_real RS inj_on_iff,
   28.79 +          realrel_iff, realrel_in_real, Abs_real_inverse];
   28.80 +
   28.81 +Addsimps [equiv_realrel RS eq_equiv_class_iff];
   28.82 +val eq_realrelD = equiv_realrel RSN (2,eq_equiv_class);
   28.83 +
   28.84 +Goal "inj(Rep_real)";
   28.85 +by (rtac inj_inverseI 1);
   28.86 +by (rtac Rep_real_inverse 1);
   28.87 +qed "inj_Rep_real";
   28.88 +
   28.89 +(** real_preal: the injection from preal to real **)
   28.90 +Goal "inj(real_preal)";
   28.91 +by (rtac injI 1);
   28.92 +by (rewtac real_preal_def);
   28.93 +by (dtac (inj_on_Abs_real RS inj_onD) 1);
   28.94 +by (REPEAT (rtac realrel_in_real 1));
   28.95 +by (dtac eq_equiv_class 1);
   28.96 +by (rtac equiv_realrel 1);
   28.97 +by (Fast_tac 1);
   28.98 +by Safe_tac;
   28.99 +by (Asm_full_simp_tac 1);
  28.100 +qed "inj_real_preal";
  28.101 +
  28.102 +val [prem] = goal thy
  28.103 +    "(!!x y. z = Abs_real(realrel^^{(x,y)}) ==> P) ==> P";
  28.104 +by (res_inst_tac [("x1","z")] 
  28.105 +    (rewrite_rule [real_def] Rep_real RS quotientE) 1);
  28.106 +by (dres_inst_tac [("f","Abs_real")] arg_cong 1);
  28.107 +by (res_inst_tac [("p","x")] PairE 1);
  28.108 +by (rtac prem 1);
  28.109 +by (asm_full_simp_tac (simpset() addsimps [Rep_real_inverse]) 1);
  28.110 +qed "eq_Abs_real";
  28.111 +
  28.112 +(**** real_minus: additive inverse on real ****)
  28.113 +
  28.114 +Goalw [congruent_def]
  28.115 +  "congruent realrel (%p. split (%x y. realrel^^{(y,x)}) p)";
  28.116 +by Safe_tac;
  28.117 +by (asm_full_simp_tac (simpset() addsimps [preal_add_commute]) 1);
  28.118 +qed "real_minus_congruent";
  28.119 +
  28.120 +(*Resolve th against the corresponding facts for real_minus*)
  28.121 +val real_minus_ize = RSLIST [equiv_realrel, real_minus_congruent];
  28.122 +
  28.123 +Goalw [real_minus_def]
  28.124 +      "%~ (Abs_real(realrel^^{(x,y)})) = Abs_real(realrel ^^ {(y,x)})";
  28.125 +by (res_inst_tac [("f","Abs_real")] arg_cong 1);
  28.126 +by (simp_tac (simpset() addsimps 
  28.127 +   [realrel_in_real RS Abs_real_inverse,real_minus_ize UN_equiv_class]) 1);
  28.128 +qed "real_minus";
  28.129 +
  28.130 +Goal "%~ (%~ z) = z";
  28.131 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.132 +by (asm_simp_tac (simpset() addsimps [real_minus]) 1);
  28.133 +qed "real_minus_minus";
  28.134 +
  28.135 +Addsimps [real_minus_minus];
  28.136 +
  28.137 +Goal "inj(real_minus)";
  28.138 +by (rtac injI 1);
  28.139 +by (dres_inst_tac [("f","real_minus")] arg_cong 1);
  28.140 +by (asm_full_simp_tac (simpset() addsimps [real_minus_minus]) 1);
  28.141 +qed "inj_real_minus";
  28.142 +
  28.143 +Goalw [real_zero_def] "%~0r = 0r";
  28.144 +by (simp_tac (simpset() addsimps [real_minus]) 1);
  28.145 +qed "real_minus_zero";
  28.146 +
  28.147 +Addsimps [real_minus_zero];
  28.148 +
  28.149 +Goal "(%~x = 0r) = (x = 0r)"; 
  28.150 +by (res_inst_tac [("z","x")] eq_Abs_real 1);
  28.151 +by (auto_tac (claset(),simpset() addsimps [real_zero_def,
  28.152 +    real_minus] @ preal_add_ac));
  28.153 +qed "real_minus_zero_iff";
  28.154 +
  28.155 +Addsimps [real_minus_zero_iff];
  28.156 +
  28.157 +Goal "(%~x ~= 0r) = (x ~= 0r)"; 
  28.158 +by Auto_tac;
  28.159 +qed "real_minus_not_zero_iff";
  28.160 +
  28.161 +(*** Congruence property for addition ***)
  28.162 +Goalw [congruent2_def]
  28.163 +    "congruent2 realrel (%p1 p2.                  \
  28.164 +\         split (%x1 y1. split (%x2 y2. realrel^^{(x1+x2, y1+y2)}) p2) p1)";
  28.165 +by Safe_tac;
  28.166 +by (asm_simp_tac (simpset() addsimps [preal_add_assoc]) 1);
  28.167 +by (res_inst_tac [("z1.1","x1a")] (preal_add_left_commute RS ssubst) 1);
  28.168 +by (asm_simp_tac (simpset() addsimps [preal_add_assoc RS sym]) 1);
  28.169 +by (asm_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.170 +qed "real_add_congruent2";
  28.171 +
  28.172 +(*Resolve th against the corresponding facts for real_add*)
  28.173 +val real_add_ize = RSLIST [equiv_realrel, real_add_congruent2];
  28.174 +
  28.175 +Goalw [real_add_def]
  28.176 +  "Abs_real(realrel^^{(x1,y1)}) + Abs_real(realrel^^{(x2,y2)}) = \
  28.177 +\  Abs_real(realrel^^{(x1+x2, y1+y2)})";
  28.178 +by (asm_simp_tac
  28.179 +    (simpset() addsimps [real_add_ize UN_equiv_class2]) 1);
  28.180 +qed "real_add";
  28.181 +
  28.182 +Goal "(z::real) + w = w + z";
  28.183 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.184 +by (res_inst_tac [("z","w")] eq_Abs_real 1);
  28.185 +by (asm_simp_tac (simpset() addsimps (preal_add_ac @ [real_add])) 1);
  28.186 +qed "real_add_commute";
  28.187 +
  28.188 +Goal "((z1::real) + z2) + z3 = z1 + (z2 + z3)";
  28.189 +by (res_inst_tac [("z","z1")] eq_Abs_real 1);
  28.190 +by (res_inst_tac [("z","z2")] eq_Abs_real 1);
  28.191 +by (res_inst_tac [("z","z3")] eq_Abs_real 1);
  28.192 +by (asm_simp_tac (simpset() addsimps [real_add, preal_add_assoc]) 1);
  28.193 +qed "real_add_assoc";
  28.194 +
  28.195 +(*For AC rewriting*)
  28.196 +Goal "(x::real)+(y+z)=y+(x+z)";
  28.197 +by (rtac (real_add_commute RS trans) 1);
  28.198 +by (rtac (real_add_assoc RS trans) 1);
  28.199 +by (rtac (real_add_commute RS arg_cong) 1);
  28.200 +qed "real_add_left_commute";
  28.201 +
  28.202 +(* real addition is an AC operator *)
  28.203 +val real_add_ac = [real_add_assoc,real_add_commute,real_add_left_commute];
  28.204 +
  28.205 +Goalw [real_preal_def,real_zero_def] "0r + z = z";
  28.206 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.207 +by (asm_full_simp_tac (simpset() addsimps [real_add] @ preal_add_ac) 1);
  28.208 +qed "real_add_zero_left";
  28.209 +
  28.210 +Goal "z + 0r = z";
  28.211 +by (simp_tac (simpset() addsimps [real_add_zero_left,real_add_commute]) 1);
  28.212 +qed "real_add_zero_right";
  28.213 +
  28.214 +Goalw [real_zero_def] "z + %~z = 0r";
  28.215 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.216 +by (asm_full_simp_tac (simpset() addsimps [real_minus,
  28.217 +        real_add, preal_add_commute]) 1);
  28.218 +qed "real_add_minus";
  28.219 +
  28.220 +Goal "%~z + z = 0r";
  28.221 +by (simp_tac (simpset() addsimps 
  28.222 +    [real_add_commute,real_add_minus]) 1);
  28.223 +qed "real_add_minus_left";
  28.224 +
  28.225 +Goal "? y. (x::real) + y = 0r";
  28.226 +by (fast_tac (claset() addIs [real_add_minus]) 1);
  28.227 +qed "real_minus_ex";
  28.228 +
  28.229 +Goal "?! y. (x::real) + y = 0r";
  28.230 +by (auto_tac (claset() addIs [real_add_minus],simpset()));
  28.231 +by (dres_inst_tac [("f","%x. ya+x")] arg_cong 1);
  28.232 +by (asm_full_simp_tac (simpset() addsimps [real_add_assoc RS sym]) 1);
  28.233 +by (asm_full_simp_tac (simpset() addsimps [real_add_commute,
  28.234 +    real_add_zero_right,real_add_zero_left]) 1);
  28.235 +qed "real_minus_ex1";
  28.236 +
  28.237 +Goal "?! y. y + (x::real) = 0r";
  28.238 +by (auto_tac (claset() addIs [real_add_minus_left],simpset()));
  28.239 +by (dres_inst_tac [("f","%x. x+ya")] arg_cong 1);
  28.240 +by (asm_full_simp_tac (simpset() addsimps [real_add_assoc]) 1);
  28.241 +by (asm_full_simp_tac (simpset() addsimps [real_add_commute,
  28.242 +    real_add_zero_right,real_add_zero_left]) 1);
  28.243 +qed "real_minus_left_ex1";
  28.244 +
  28.245 +Goal "!!y. x + y = 0r ==> x = %~y";
  28.246 +by (cut_inst_tac [("z","y")] real_add_minus_left 1);
  28.247 +by (res_inst_tac [("x1","y")] (real_minus_left_ex1 RS ex1E) 1);
  28.248 +by (Blast_tac 1);
  28.249 +qed "real_add_minus_eq_minus";
  28.250 +
  28.251 +Goal "? y. x = %~y";
  28.252 +by (cut_inst_tac [("x","x")] real_minus_ex 1);
  28.253 +by (etac exE 1 THEN dtac real_add_minus_eq_minus 1);
  28.254 +by (Fast_tac 1);
  28.255 +qed "real_as_add_inverse_ex";
  28.256 +
  28.257 +(* real_minus_add_distrib *)
  28.258 +Goal "%~(x + y) = %~x + %~y";
  28.259 +by (res_inst_tac [("z","x")] eq_Abs_real 1);
  28.260 +by (res_inst_tac [("z","y")] eq_Abs_real 1);
  28.261 +by (auto_tac (claset(),simpset() addsimps [real_minus,real_add]));
  28.262 +qed "real_minus_add_eq";
  28.263 +
  28.264 +val real_minus_add_distrib = real_minus_add_eq;
  28.265 +
  28.266 +Goal "((x::real) + y = x + z) = (y = z)";
  28.267 +by (Step_tac 1);
  28.268 +by (dres_inst_tac [("f","%t.%~x + t")] arg_cong 1);
  28.269 +by (asm_full_simp_tac (simpset() addsimps [real_add_minus_left,
  28.270 +                 real_add_assoc RS sym,real_add_zero_left]) 1);
  28.271 +qed "real_add_left_cancel";
  28.272 +
  28.273 +Goal "(y + (x::real)= z + x) = (y = z)";
  28.274 +by (simp_tac (simpset() addsimps [real_add_commute,real_add_left_cancel]) 1);
  28.275 +qed "real_add_right_cancel";
  28.276 +
  28.277 +(*** Congruence property for multiplication ***)
  28.278 +Goal "!!(x1::preal). [| x1 + y2 = x2 + y1 |] ==> \
  28.279 +\         x * x1 + y * y1 + (x * y2 + x2 * y) = \
  28.280 +\         x * x2 + y * y2 + (x * y1 + x1 * y)";
  28.281 +by (asm_full_simp_tac (simpset() addsimps [preal_add_left_commute,
  28.282 +    preal_add_assoc RS sym,preal_add_mult_distrib2 RS sym]) 1);
  28.283 +by (rtac (preal_mult_commute RS subst) 1);
  28.284 +by (res_inst_tac [("y1","x2")] (preal_mult_commute RS subst) 1);
  28.285 +by (asm_full_simp_tac (simpset() addsimps [preal_add_assoc,
  28.286 +    preal_add_mult_distrib2 RS sym]) 1);
  28.287 +by (asm_full_simp_tac (simpset() addsimps [preal_add_commute]) 1);
  28.288 +qed "real_mult_congruent2_lemma";
  28.289 +
  28.290 +Goal 
  28.291 +    "congruent2 realrel (%p1 p2.                  \
  28.292 +\         split (%x1 y1. split (%x2 y2. realrel^^{(x1*x2 + y1*y2, x1*y2+x2*y1)}) p2) p1)";
  28.293 +by (rtac (equiv_realrel RS congruent2_commuteI) 1);
  28.294 +by Safe_tac;
  28.295 +by (rewtac split_def);
  28.296 +by (asm_simp_tac (simpset() addsimps [preal_mult_commute,preal_add_commute]) 1);
  28.297 +by (auto_tac (claset(),simpset() addsimps [real_mult_congruent2_lemma]));
  28.298 +qed "real_mult_congruent2";
  28.299 +
  28.300 +(*Resolve th against the corresponding facts for real_mult*)
  28.301 +val real_mult_ize = RSLIST [equiv_realrel, real_mult_congruent2];
  28.302 +
  28.303 +Goalw [real_mult_def]
  28.304 +   "Abs_real((realrel^^{(x1,y1)})) * Abs_real((realrel^^{(x2,y2)})) =   \
  28.305 +\   Abs_real(realrel ^^ {(x1*x2+y1*y2,x1*y2+x2*y1)})";
  28.306 +by (simp_tac (simpset() addsimps [real_mult_ize UN_equiv_class2]) 1);
  28.307 +qed "real_mult";
  28.308 +
  28.309 +Goal "(z::real) * w = w * z";
  28.310 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.311 +by (res_inst_tac [("z","w")] eq_Abs_real 1);
  28.312 +by (asm_simp_tac (simpset() addsimps ([real_mult] @ preal_add_ac @ preal_mult_ac)) 1);
  28.313 +qed "real_mult_commute";
  28.314 +
  28.315 +Goal "((z1::real) * z2) * z3 = z1 * (z2 * z3)";
  28.316 +by (res_inst_tac [("z","z1")] eq_Abs_real 1);
  28.317 +by (res_inst_tac [("z","z2")] eq_Abs_real 1);
  28.318 +by (res_inst_tac [("z","z3")] eq_Abs_real 1);
  28.319 +by (asm_simp_tac (simpset() addsimps ([preal_add_mult_distrib2,real_mult] @ 
  28.320 +                                     preal_add_ac @ preal_mult_ac)) 1);
  28.321 +qed "real_mult_assoc";
  28.322 +
  28.323 +qed_goal "real_mult_left_commute" thy
  28.324 +    "(z1::real) * (z2 * z3) = z2 * (z1 * z3)"
  28.325 + (fn _ => [rtac (real_mult_commute RS trans) 1, rtac (real_mult_assoc RS trans) 1,
  28.326 +           rtac (real_mult_commute RS arg_cong) 1]);
  28.327 +
  28.328 +(* real multiplication is an AC operator *)
  28.329 +val real_mult_ac = [real_mult_assoc, real_mult_commute, real_mult_left_commute];
  28.330 +
  28.331 +Goalw [real_one_def,pnat_one_def] "1r * z = z";
  28.332 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.333 +by (asm_full_simp_tac (simpset() addsimps [real_mult,
  28.334 +    preal_add_mult_distrib2,preal_mult_1_right] 
  28.335 +    @ preal_mult_ac @ preal_add_ac) 1);
  28.336 +qed "real_mult_1";
  28.337 +
  28.338 +Goal "z * 1r = z";
  28.339 +by (simp_tac (simpset() addsimps [real_mult_commute,
  28.340 +    real_mult_1]) 1);
  28.341 +qed "real_mult_1_right";
  28.342 +
  28.343 +Goalw [real_zero_def,pnat_one_def] "0r * z = 0r";
  28.344 +by (res_inst_tac [("z","z")] eq_Abs_real 1);
  28.345 +by (asm_full_simp_tac (simpset() addsimps [real_mult,
  28.346 +    preal_add_mult_distrib2,preal_mult_1_right] 
  28.347 +    @ preal_mult_ac @ preal_add_ac) 1);
  28.348 +qed "real_mult_0";
  28.349 +
  28.350 +Goal "z * 0r = 0r";
  28.351 +by (simp_tac (simpset() addsimps [real_mult_commute,
  28.352 +    real_mult_0]) 1);
  28.353 +qed "real_mult_0_right";
  28.354 +
  28.355 +Addsimps [real_mult_0_right,real_mult_0];
  28.356 +
  28.357 +Goal "%~(x * y) = %~x * y";
  28.358 +by (res_inst_tac [("z","x")] eq_Abs_real 1);
  28.359 +by (res_inst_tac [("z","y")] eq_Abs_real 1);
  28.360 +by (auto_tac (claset(),simpset() addsimps [real_minus,real_mult] 
  28.361 +    @ preal_mult_ac @ preal_add_ac));
  28.362 +qed "real_minus_mult_eq1";
  28.363 +
  28.364 +Goal "%~(x * y) = x * %~y";
  28.365 +by (res_inst_tac [("z","x")] eq_Abs_real 1);
  28.366 +by (res_inst_tac [("z","y")] eq_Abs_real 1);
  28.367 +by (auto_tac (claset(),simpset() addsimps [real_minus,real_mult] 
  28.368 +    @ preal_mult_ac @ preal_add_ac));
  28.369 +qed "real_minus_mult_eq2";
  28.370 +
  28.371 +Goal "%~x*%~y = x*y";
  28.372 +by (full_simp_tac (simpset() addsimps [real_minus_mult_eq2 RS sym,
  28.373 +    real_minus_mult_eq1 RS sym]) 1);
  28.374 +qed "real_minus_mult_cancel";
  28.375 +
  28.376 +Addsimps [real_minus_mult_cancel];
  28.377 +
  28.378 +Goal "%~x*y = x*%~y";
  28.379 +by (full_simp_tac (simpset() addsimps [real_minus_mult_eq2 RS sym,
  28.380 +    real_minus_mult_eq1 RS sym]) 1);
  28.381 +qed "real_minus_mult_commute";
  28.382 +
  28.383 +(*-----------------------------------------------------------------------------
  28.384 +
  28.385 + -----------------------------------------------------------------------------*)
  28.386 +
  28.387 +(** Lemmas **)
  28.388 +
  28.389 +qed_goal "real_add_assoc_cong" thy
  28.390 +    "!!z. (z::real) + v = z' + v' ==> z + (v + w) = z' + (v' + w)"
  28.391 + (fn _ => [(asm_simp_tac (simpset() addsimps [real_add_assoc RS sym]) 1)]);
  28.392 +
  28.393 +qed_goal "real_add_assoc_swap" thy "(z::real) + (v + w) = v + (z + w)"
  28.394 + (fn _ => [(REPEAT (ares_tac [real_add_commute RS real_add_assoc_cong] 1))]);
  28.395 +
  28.396 +Goal "((z1::real) + z2) * w = (z1 * w) + (z2 * w)";
  28.397 +by (res_inst_tac [("z","z1")] eq_Abs_real 1);
  28.398 +by (res_inst_tac [("z","z2")] eq_Abs_real 1);
  28.399 +by (res_inst_tac [("z","w")] eq_Abs_real 1);
  28.400 +by (asm_simp_tac 
  28.401 +    (simpset() addsimps ([preal_add_mult_distrib2, real_add, real_mult] @ 
  28.402 +                        preal_add_ac @ preal_mult_ac)) 1);
  28.403 +qed "real_add_mult_distrib";
  28.404 +
  28.405 +val real_mult_commute'= read_instantiate [("z","w")] real_mult_commute;
  28.406 +
  28.407 +Goal "(w::real) * (z1 + z2) = (w * z1) + (w * z2)";
  28.408 +by (simp_tac (simpset() addsimps [real_mult_commute',real_add_mult_distrib]) 1);
  28.409 +qed "real_add_mult_distrib2";
  28.410 +
  28.411 +val real_mult_simps = [real_mult_1, real_mult_1_right];
  28.412 +Addsimps real_mult_simps;
  28.413 +
  28.414 +(*** one and zero are distinct ***)
  28.415 +Goalw [real_zero_def,real_one_def] "0r ~= 1r";
  28.416 +by (auto_tac (claset(),simpset() addsimps 
  28.417 +   [preal_self_less_add_left RS preal_not_refl2]));
  28.418 +qed "real_zero_not_eq_one";
  28.419 +
  28.420 +(*** existence of inverse ***)
  28.421 +(** lemma -- alternative definition for 0r **)
  28.422 +Goalw [real_zero_def] "0r = Abs_real (realrel ^^ {(x, x)})";
  28.423 +by (auto_tac (claset(),simpset() addsimps [preal_add_commute]));
  28.424 +qed "real_zero_iff";
  28.425 +
  28.426 +Goalw [real_zero_def,real_one_def] 
  28.427 +          "!!(x::real). x ~= 0r ==> ? y. x*y = 1r";
  28.428 +by (res_inst_tac [("z","x")] eq_Abs_real 1);
  28.429 +by (cut_inst_tac [("r1.0","xa"),("r2.0","y")] preal_linear 1);
  28.430 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
  28.431 +           simpset() addsimps [real_zero_iff RS sym]));
  28.432 +by (res_inst_tac [("x","Abs_real (realrel ^^ {(@#$#1p,pinv(D)+@#$#1p)})")] exI 1);
  28.433 +by (res_inst_tac [("x","Abs_real (realrel ^^ {(pinv(D)+@#$#1p,@#$#1p)})")] exI 2);
  28.434 +by (auto_tac (claset(),simpset() addsimps [real_mult,
  28.435 +    pnat_one_def,preal_mult_1_right,preal_add_mult_distrib2,
  28.436 +    preal_add_mult_distrib,preal_mult_1,preal_mult_inv_right] 
  28.437 +    @ preal_add_ac @ preal_mult_ac));
  28.438 +qed "real_mult_inv_right_ex";
  28.439 +
  28.440 +Goal "!!(x::real). x ~= 0r ==> ? y. y*x = 1r";
  28.441 +by (asm_simp_tac (simpset() addsimps [real_mult_commute,
  28.442 +    real_mult_inv_right_ex]) 1);
  28.443 +qed "real_mult_inv_left_ex";
  28.444 +
  28.445 +Goalw [rinv_def] "!!(x::real). x ~= 0r ==> rinv(x)*x = 1r";
  28.446 +by (forward_tac [real_mult_inv_left_ex] 1);
  28.447 +by (Step_tac 1);
  28.448 +by (rtac selectI2 1);
  28.449 +by Auto_tac;
  28.450 +qed "real_mult_inv_left";
  28.451 +
  28.452 +Goal "!!(x::real). x ~= 0r ==> x*rinv(x) = 1r";
  28.453 +by (auto_tac (claset() addIs [real_mult_commute RS subst],
  28.454 +              simpset() addsimps [real_mult_inv_left]));
  28.455 +qed "real_mult_inv_right";
  28.456 +
  28.457 +Goal "!!a. (c::real) ~= 0r ==> (c*a=c*b) = (a=b)";
  28.458 +by Auto_tac;
  28.459 +by (dres_inst_tac [("f","%x. x*rinv c")] arg_cong 1);
  28.460 +by (asm_full_simp_tac (simpset() addsimps [real_mult_inv_right] @ real_mult_ac)  1);
  28.461 +qed "real_mult_left_cancel";
  28.462 +    
  28.463 +Goal "!!a. (c::real) ~= 0r ==> (a*c=b*c) = (a=b)";
  28.464 +by (Step_tac 1);
  28.465 +by (dres_inst_tac [("f","%x. x*rinv c")] arg_cong 1);
  28.466 +by (asm_full_simp_tac (simpset() addsimps [real_mult_inv_right] @ real_mult_ac)  1);
  28.467 +qed "real_mult_right_cancel";
  28.468 +
  28.469 +Goalw [rinv_def] "!!x. x ~= 0r ==> rinv(x) ~= 0r";
  28.470 +by (forward_tac [real_mult_inv_left_ex] 1);
  28.471 +by (etac exE 1);
  28.472 +by (rtac selectI2 1);
  28.473 +by (auto_tac (claset(),simpset() addsimps [real_mult_0,
  28.474 +    real_zero_not_eq_one]));
  28.475 +qed "rinv_not_zero";
  28.476 +
  28.477 +Addsimps [real_mult_inv_left,real_mult_inv_right];
  28.478 +
  28.479 +Goal "!!x. x ~= 0r ==> rinv(rinv x) = x";
  28.480 +by (res_inst_tac [("c1","rinv x")] (real_mult_right_cancel RS iffD1) 1);
  28.481 +by (etac rinv_not_zero 1);
  28.482 +by (auto_tac (claset() addDs [rinv_not_zero],simpset()));
  28.483 +qed "real_rinv_rinv";
  28.484 +
  28.485 +Goalw [rinv_def] "rinv(1r) = 1r";
  28.486 +by (cut_facts_tac [real_zero_not_eq_one RS 
  28.487 +       not_sym RS real_mult_inv_left_ex] 1);
  28.488 +by (etac exE 1);
  28.489 +by (rtac selectI2 1);
  28.490 +by (auto_tac (claset(),simpset() addsimps 
  28.491 +    [real_zero_not_eq_one RS not_sym]));
  28.492 +qed "real_rinv_1";
  28.493 +
  28.494 +Goal "!!x. x ~= 0r ==> rinv(%~x) = %~rinv(x)";
  28.495 +by (res_inst_tac [("c1","%~x")] (real_mult_right_cancel RS iffD1) 1);
  28.496 +by Auto_tac;
  28.497 +qed "real_minus_rinv";
  28.498 +
  28.499 +      (*** theorems for ordering ***)
  28.500 +(* prove introduction and elimination rules for real_less *)
  28.501 +
  28.502 +Goalw [real_less_def]
  28.503 + "P < (Q::real) = (EX x1 y1 x2 y2. x1 + y2 < x2 + y1 & \
  28.504 +\                                  (x1,y1::preal):Rep_real(P) & \
  28.505 +\                                  (x2,y2):Rep_real(Q))";
  28.506 +by (Fast_tac 1);
  28.507 +qed "real_less_iff";
  28.508 +
  28.509 +Goalw [real_less_def]
  28.510 + "!!P. [| x1 + y2 < x2 + y1; (x1,y1::preal):Rep_real(P); \
  28.511 +\         (x2,y2):Rep_real(Q) |] ==> P < (Q::real)";
  28.512 +by (Fast_tac 1);
  28.513 +qed "real_lessI";
  28.514 +
  28.515 +Goalw [real_less_def]
  28.516 +     "!! R1. [| R1 < (R2::real); \
  28.517 +\         !!x1 x2 y1 y2. x1 + y2 < x2 + y1 ==> P; \
  28.518 +\         !!x1 y1. (x1,y1::preal):Rep_real(R1) ==> P; \ 
  28.519 +\         !!x2 y2. (x2,y2::preal):Rep_real(R2) ==> P |] \
  28.520 +\     ==> P";
  28.521 +by Auto_tac;
  28.522 +qed "real_lessE";
  28.523 +
  28.524 +Goalw [real_less_def]
  28.525 + "!!R1. R1 < (R2::real) ==> (EX x1 y1 x2 y2. x1 + y2 < x2 + y1 & \
  28.526 +\                                  (x1,y1::preal):Rep_real(R1) & \
  28.527 +\                                  (x2,y2):Rep_real(R2))";
  28.528 +by (Fast_tac 1);
  28.529 +qed "real_lessD";
  28.530 +
  28.531 +(* real_less is a strong order i.e nonreflexive and transitive *)
  28.532 +(*** lemmas ***)
  28.533 +Goal "!!(x::preal). [| x = y; x1 = y1 |] ==> x + y1 = x1 + y";
  28.534 +by (asm_simp_tac (simpset() addsimps [preal_add_commute]) 1);
  28.535 +qed "preal_lemma_eq_rev_sum";
  28.536 +
  28.537 +Goal "!!(b::preal). x + (b + y) = x1 + (b + y1) ==> x + y = x1 + y1";
  28.538 +by (asm_full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.539 +qed "preal_add_left_commute_cancel";
  28.540 +
  28.541 +Goal 
  28.542 +     "!!(x::preal). [| x + y2a = x2a + y; \
  28.543 +\                      x + y2b = x2b + y |] \
  28.544 +\                   ==> x2a + y2b = x2b + y2a";
  28.545 +by (dtac preal_lemma_eq_rev_sum 1);
  28.546 +by (assume_tac 1);
  28.547 +by (thin_tac "x + y2b = x2b + y" 1);
  28.548 +by (asm_full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.549 +by (dtac preal_add_left_commute_cancel 1);
  28.550 +by (asm_full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.551 +qed "preal_lemma_for_not_refl";
  28.552 +
  28.553 +Goal "~ (R::real) < R";
  28.554 +by (res_inst_tac [("z","R")] eq_Abs_real 1);
  28.555 +by (auto_tac (claset(),simpset() addsimps [real_less_def]));
  28.556 +by (dtac preal_lemma_for_not_refl 1);
  28.557 +by (assume_tac 1 THEN rotate_tac 2 1);
  28.558 +by (auto_tac (claset(),simpset() addsimps [preal_less_not_refl]));
  28.559 +qed "real_less_not_refl";
  28.560 +
  28.561 +(*** y < y ==> P ***)
  28.562 +bind_thm("real_less_irrefl",real_less_not_refl RS notE);
  28.563 +
  28.564 +Goal "!!(x::real). x < y ==> x ~= y";
  28.565 +by (auto_tac (claset(),simpset() addsimps [real_less_not_refl]));
  28.566 +qed "real_not_refl2";
  28.567 +
  28.568 +(* lemma re-arranging and eliminating terms *)
  28.569 +Goal "!! (a::preal). [| a + b = c + d; \
  28.570 +\            x2b + d + (c + y2e) < a + y2b + (x2e + b) |] \
  28.571 +\         ==> x2b + y2e < x2e + y2b";
  28.572 +by (asm_full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.573 +by (res_inst_tac [("C","c+d")] preal_add_left_less_cancel 1);
  28.574 +by (asm_full_simp_tac (simpset() addsimps [preal_add_assoc RS sym]) 1);
  28.575 +qed "preal_lemma_trans";
  28.576 +
  28.577 +(** heavy re-writing involved*)
  28.578 +Goal "!!(R1::real). [| R1 < R2; R2 < R3 |] ==> R1 < R3";
  28.579 +by (res_inst_tac [("z","R1")] eq_Abs_real 1);
  28.580 +by (res_inst_tac [("z","R2")] eq_Abs_real 1);
  28.581 +by (res_inst_tac [("z","R3")] eq_Abs_real 1);
  28.582 +by (auto_tac (claset(),simpset() addsimps [real_less_def]));
  28.583 +by (REPEAT(rtac exI 1));
  28.584 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.585 +by (REPEAT(Blast_tac 2));
  28.586 +by (dtac preal_lemma_for_not_refl 1 THEN assume_tac 1);
  28.587 +by (blast_tac (claset() addDs [preal_add_less_mono] 
  28.588 +    addIs [preal_lemma_trans]) 1);
  28.589 +qed "real_less_trans";
  28.590 +
  28.591 +Goal "!! (R1::real). [| R1 < R2; R2 < R1 |] ==> P";
  28.592 +by (dtac real_less_trans 1 THEN assume_tac 1);
  28.593 +by (asm_full_simp_tac (simpset() addsimps [real_less_not_refl]) 1);
  28.594 +qed "real_less_asym";
  28.595 +
  28.596 +(****)(****)(****)(****)(****)(****)(****)(****)(****)(****)
  28.597 +    (****** Map and more real_less ******)
  28.598 +(*** mapping from preal into real ***)
  28.599 +Goalw [real_preal_def] 
  28.600 +            "%#((z1::preal) + z2) = %#z1 + %#z2";
  28.601 +by (asm_simp_tac (simpset() addsimps [real_add,
  28.602 +       preal_add_mult_distrib,preal_mult_1] addsimps preal_add_ac) 1);
  28.603 +qed "real_preal_add";
  28.604 +
  28.605 +Goalw [real_preal_def] 
  28.606 +            "%#((z1::preal) * z2) = %#z1* %#z2";
  28.607 +by (full_simp_tac (simpset() addsimps [real_mult,
  28.608 +        preal_add_mult_distrib2,preal_mult_1,
  28.609 +        preal_mult_1_right,pnat_one_def] 
  28.610 +        @ preal_add_ac @ preal_mult_ac) 1);
  28.611 +qed "real_preal_mult";
  28.612 +
  28.613 +Goalw [real_preal_def]
  28.614 +      "!!(x::preal). y < x ==> ? m. Abs_real (realrel ^^ {(x,y)}) = %#m";
  28.615 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
  28.616 +    simpset() addsimps preal_add_ac));
  28.617 +qed "real_preal_ExI";
  28.618 +
  28.619 +Goalw [real_preal_def]
  28.620 +      "!!(x::preal). ? m. Abs_real (realrel ^^ {(x,y)}) = %#m ==> y < x";
  28.621 +by (auto_tac (claset(),simpset() addsimps 
  28.622 +    [preal_add_commute,preal_add_assoc]));
  28.623 +by (asm_full_simp_tac (simpset() addsimps 
  28.624 +    [preal_add_assoc RS sym,preal_self_less_add_left]) 1);
  28.625 +qed "real_preal_ExD";
  28.626 +
  28.627 +Goal "(? m. Abs_real (realrel ^^ {(x,y)}) = %#m) = (y < x)";
  28.628 +by (fast_tac (claset() addSIs [real_preal_ExI,real_preal_ExD]) 1);
  28.629 +qed "real_preal_iff";
  28.630 +
  28.631 +(*** Gleason prop 9-4.4 p 127 ***)
  28.632 +Goalw [real_preal_def,real_zero_def] 
  28.633 +      "? m. (x::real) = %#m | x = 0r | x = %~(%#m)";
  28.634 +by (res_inst_tac [("z","x")] eq_Abs_real 1);
  28.635 +by (auto_tac (claset(),simpset() addsimps [real_minus] @ preal_add_ac));
  28.636 +by (cut_inst_tac [("r1.0","x"),("r2.0","y")] preal_linear 1);
  28.637 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
  28.638 +    simpset() addsimps [preal_add_assoc RS sym]));
  28.639 +by (auto_tac (claset(),simpset() addsimps [preal_add_commute]));
  28.640 +qed "real_preal_trichotomy";
  28.641 +
  28.642 +Goal "!!x. [| !!m. x = %#m ==> P; \
  28.643 +\            x = 0r ==> P; \
  28.644 +\            !!m. x = %~(%#m) ==> P |] ==> P";
  28.645 +by (cut_inst_tac [("x","x")] real_preal_trichotomy 1);
  28.646 +by Auto_tac;
  28.647 +qed "real_preal_trichotomyE";
  28.648 +
  28.649 +Goalw [real_preal_def] "!!m1 m2. %#m1 < %#m2 ==> m1 < m2";
  28.650 +by (auto_tac (claset(),simpset() addsimps [real_less_def] @ preal_add_ac));
  28.651 +by (auto_tac (claset(),simpset() addsimps [preal_add_assoc RS sym]));
  28.652 +by (auto_tac (claset(),simpset() addsimps preal_add_ac));
  28.653 +qed "real_preal_lessD";
  28.654 +
  28.655 +Goal "!!m1 m2. m1 < m2 ==> %#m1 < %#m2";
  28.656 +by (dtac preal_less_add_left_Ex 1);
  28.657 +by (auto_tac (claset(),simpset() addsimps [real_preal_add,
  28.658 +    real_preal_def,real_less_def]));
  28.659 +by (REPEAT(rtac exI 1));
  28.660 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.661 +by (REPEAT(Fast_tac 2));
  28.662 +by (simp_tac (simpset() addsimps [preal_self_less_add_left] 
  28.663 +    delsimps [preal_add_less_iff2]) 1);
  28.664 +qed "real_preal_lessI";
  28.665 +
  28.666 +Goal "(%#m1 < %#m2) = (m1 < m2)";
  28.667 +by (fast_tac (claset() addIs [real_preal_lessI,real_preal_lessD]) 1);
  28.668 +qed "real_preal_less_iff1";
  28.669 +
  28.670 +Addsimps [real_preal_less_iff1];
  28.671 +
  28.672 +Goal "%~ %#m < %#m";
  28.673 +by (auto_tac (claset(),simpset() addsimps 
  28.674 +    [real_preal_def,real_less_def,real_minus]));
  28.675 +by (REPEAT(rtac exI 1));
  28.676 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.677 +by (REPEAT(Fast_tac 2));
  28.678 +by (full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.679 +by (full_simp_tac (simpset() addsimps [preal_self_less_add_right,
  28.680 +    preal_add_assoc RS sym]) 1);
  28.681 +qed "real_preal_minus_less_self";
  28.682 +
  28.683 +Goalw [real_zero_def] "%~ %#m < 0r";
  28.684 +by (auto_tac (claset(),simpset() addsimps 
  28.685 +    [real_preal_def,real_less_def,real_minus]));
  28.686 +by (REPEAT(rtac exI 1));
  28.687 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.688 +by (REPEAT(Fast_tac 2));
  28.689 +by (full_simp_tac (simpset() addsimps 
  28.690 +  [preal_self_less_add_right] @ preal_add_ac) 1);
  28.691 +qed "real_preal_minus_less_zero";
  28.692 +
  28.693 +Goal "~ 0r < %~ %#m";
  28.694 +by (cut_facts_tac [real_preal_minus_less_zero] 1);
  28.695 +by (fast_tac (claset() addDs [real_less_trans] 
  28.696 +               addEs [real_less_irrefl]) 1);
  28.697 +qed "real_preal_not_minus_gt_zero";
  28.698 +
  28.699 +Goalw [real_zero_def] " 0r < %#m";
  28.700 +by (auto_tac (claset(),simpset() addsimps 
  28.701 +    [real_preal_def,real_less_def,real_minus]));
  28.702 +by (REPEAT(rtac exI 1));
  28.703 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.704 +by (REPEAT(Fast_tac 2));
  28.705 +by (full_simp_tac (simpset() addsimps 
  28.706 +  [preal_self_less_add_right] @ preal_add_ac) 1);
  28.707 +qed "real_preal_zero_less";
  28.708 +
  28.709 +Goal "~ %#m < 0r";
  28.710 +by (cut_facts_tac [real_preal_zero_less] 1);
  28.711 +by (fast_tac (claset() addDs [real_less_trans] 
  28.712 +               addEs [real_less_irrefl]) 1);
  28.713 +qed "real_preal_not_less_zero";
  28.714 +
  28.715 +Goal "0r < %~ %~ %#m";
  28.716 +by (simp_tac (simpset() addsimps 
  28.717 +    [real_preal_zero_less]) 1);
  28.718 +qed "real_minus_minus_zero_less";
  28.719 +
  28.720 +(* another lemma *)
  28.721 +Goalw [real_zero_def] " 0r < %#m + %#m1";
  28.722 +by (auto_tac (claset(),simpset() addsimps 
  28.723 +    [real_preal_def,real_less_def,real_add]));
  28.724 +by (REPEAT(rtac exI 1));
  28.725 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.726 +by (REPEAT(Fast_tac 2));
  28.727 +by (full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.728 +by (full_simp_tac (simpset() addsimps [preal_self_less_add_right,
  28.729 +    preal_add_assoc RS sym]) 1);
  28.730 +qed "real_preal_sum_zero_less";
  28.731 +
  28.732 +Goal "%~ %#m < %#m1";
  28.733 +by (auto_tac (claset(),simpset() addsimps 
  28.734 +    [real_preal_def,real_less_def,real_minus]));
  28.735 +by (REPEAT(rtac exI 1));
  28.736 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.737 +by (REPEAT(Fast_tac 2));
  28.738 +by (full_simp_tac (simpset() addsimps preal_add_ac) 1);
  28.739 +by (full_simp_tac (simpset() addsimps [preal_self_less_add_right,
  28.740 +    preal_add_assoc RS sym]) 1);
  28.741 +qed "real_preal_minus_less_all";
  28.742 +
  28.743 +Goal "~ %#m < %~ %#m1";
  28.744 +by (cut_facts_tac [real_preal_minus_less_all] 1);
  28.745 +by (fast_tac (claset() addDs [real_less_trans] 
  28.746 +               addEs [real_less_irrefl]) 1);
  28.747 +qed "real_preal_not_minus_gt_all";
  28.748 +
  28.749 +Goal "!!m1 m2. %~ %#m1 < %~ %#m2 ==> %#m2 < %#m1";
  28.750 +by (auto_tac (claset(),simpset() addsimps 
  28.751 +    [real_preal_def,real_less_def,real_minus]));
  28.752 +by (REPEAT(rtac exI 1));
  28.753 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.754 +by (REPEAT(Fast_tac 2));
  28.755 +by (auto_tac (claset(),simpset() addsimps preal_add_ac));
  28.756 +by (asm_full_simp_tac (simpset() addsimps [preal_add_assoc RS sym]) 1);
  28.757 +by (auto_tac (claset(),simpset() addsimps preal_add_ac));
  28.758 +qed "real_preal_minus_less_rev1";
  28.759 +
  28.760 +Goal "!!m1 m2. %#m1 < %#m2 ==> %~ %#m2 < %~ %#m1";
  28.761 +by (auto_tac (claset(),simpset() addsimps 
  28.762 +    [real_preal_def,real_less_def,real_minus]));
  28.763 +by (REPEAT(rtac exI 1));
  28.764 +by (EVERY[rtac conjI 1, rtac conjI 2]);
  28.765 +by (REPEAT(Fast_tac 2));
  28.766 +by (auto_tac (claset(),simpset() addsimps preal_add_ac));
  28.767 +by (asm_full_simp_tac (simpset() addsimps [preal_add_assoc RS sym]) 1);
  28.768 +by (auto_tac (claset(),simpset() addsimps preal_add_ac));
  28.769 +qed "real_preal_minus_less_rev2";
  28.770 +
  28.771 +Goal "(%~ %#m1 < %~ %#m2) = (%#m2 < %#m1)";
  28.772 +by (blast_tac (claset() addSIs [real_preal_minus_less_rev1,
  28.773 +               real_preal_minus_less_rev2]) 1);
  28.774 +qed "real_preal_minus_less_rev_iff";
  28.775 +
  28.776 +Addsimps [real_preal_minus_less_rev_iff];
  28.777 +
  28.778 +(*** linearity ***)
  28.779 +Goal "(R1::real) < R2 | R1 = R2 | R2 < R1";
  28.780 +by (res_inst_tac [("x","R1")]  real_preal_trichotomyE 1);
  28.781 +by (ALLGOALS(res_inst_tac [("x","R2")]  real_preal_trichotomyE));
  28.782 +by (auto_tac (claset() addSDs [preal_le_anti_sym],
  28.783 +              simpset() addsimps [preal_less_le_iff,real_preal_minus_less_zero,
  28.784 +               real_preal_zero_less,real_preal_minus_less_all]));
  28.785 +qed "real_linear";
  28.786 +
  28.787 +Goal
  28.788 +    "!!(R1::real). [| R1 < R2 ==> P;  R1 = R2 ==> P; \
  28.789 +\          R2 < R1 ==> P |] ==> P";
  28.790 +by (cut_inst_tac [("R1.0","R1"),("R2.0","R2")] real_linear 1);
  28.791 +by Auto_tac;
  28.792 +qed "real_linear_less2";
  28.793 +
  28.794 +(*** Properties of <= ***)
  28.795 +
  28.796 +Goalw [real_le_def] "!!w. ~(w < z) ==> z <= (w::real)";
  28.797 +by (assume_tac 1);
  28.798 +qed "real_leI";
  28.799 +
  28.800 +Goalw [real_le_def] "!!w. z<=w ==> ~(w<(z::real))";
  28.801 +by (assume_tac 1);
  28.802 +qed "real_leD";
  28.803 +
  28.804 +val real_leE = make_elim real_leD;
  28.805 +
  28.806 +Goal "!!w. (~(w < z)) = (z <= (w::real))";
  28.807 +by (fast_tac (claset() addSIs [real_leI,real_leD]) 1);
  28.808 +qed "real_less_le_iff";
  28.809 +
  28.810 +Goalw [real_le_def] "!!z. ~ z <= w ==> w<(z::real)";
  28.811 +by (Fast_tac 1);
  28.812 +qed "not_real_leE";
  28.813 +
  28.814 +Goalw [real_le_def] "!!z. z < w ==> z <= (w::real)";
  28.815 +by (fast_tac (claset() addEs [real_less_asym]) 1);
  28.816 +qed "real_less_imp_le";
  28.817 +
  28.818 +Goalw [real_le_def] "!!(x::real). x <= y ==> x < y | x = y";
  28.819 +by (cut_facts_tac [real_linear] 1);
  28.820 +by (fast_tac (claset() addEs [real_less_irrefl,real_less_asym]) 1);
  28.821 +qed "real_le_imp_less_or_eq";
  28.822 +
  28.823 +Goalw [real_le_def] "!!z. z<w | z=w ==> z <=(w::real)";
  28.824 +by (cut_facts_tac [real_linear] 1);
  28.825 +by (fast_tac (claset() addEs [real_less_irrefl,real_less_asym]) 1);
  28.826 +qed "real_less_or_eq_imp_le";
  28.827 +
  28.828 +Goal "(x <= (y::real)) = (x < y | x=y)";
  28.829 +by (REPEAT(ares_tac [iffI, real_less_or_eq_imp_le, real_le_imp_less_or_eq] 1));
  28.830 +qed "real_le_eq_less_or_eq";
  28.831 +
  28.832 +Goal "w <= (w::real)";
  28.833 +by (simp_tac (simpset() addsimps [real_le_eq_less_or_eq]) 1);
  28.834 +qed "real_le_refl";
  28.835 +
  28.836 +val prems = goal Real.thy "!!i. [| i <= j; j < k |] ==> i < (k::real)";
  28.837 +by (dtac real_le_imp_less_or_eq 1);
  28.838 +by (fast_tac (claset() addIs [real_less_trans]) 1);
  28.839 +qed "real_le_less_trans";
  28.840 +
  28.841 +Goal "!! (i::real). [| i < j; j <= k |] ==> i < k";
  28.842 +by (dtac real_le_imp_less_or_eq 1);
  28.843 +by (fast_tac (claset() addIs [real_less_trans]) 1);
  28.844 +qed "real_less_le_trans";
  28.845 +
  28.846 +Goal "!!i. [| i <= j; j <= k |] ==> i <= (k::real)";
  28.847 +by (EVERY1 [dtac real_le_imp_less_or_eq, dtac real_le_imp_less_or_eq,
  28.848 +            rtac real_less_or_eq_imp_le, fast_tac (claset() addIs [real_less_trans])]);
  28.849 +qed "real_le_trans";
  28.850 +
  28.851 +Goal "!!z. [| z <= w; w <= z |] ==> z = (w::real)";
  28.852 +by (EVERY1 [dtac real_le_imp_less_or_eq, dtac real_le_imp_less_or_eq,
  28.853 +            fast_tac (claset() addEs [real_less_irrefl,real_less_asym])]);
  28.854 +qed "real_le_anti_sym";
  28.855 +
  28.856 +Goal "!!x. [| ~ y < x; y ~= x |] ==> x < (y::real)";
  28.857 +by (rtac not_real_leE 1);
  28.858 +by (fast_tac (claset() addDs [real_le_imp_less_or_eq]) 1);
  28.859 +qed "not_less_not_eq_real_less";
  28.860 +
  28.861 +Goal "(0r < %~R) = (R < 0r)";
  28.862 +by (res_inst_tac [("x","R")]  real_preal_trichotomyE 1);
  28.863 +by (auto_tac (claset(),simpset() addsimps [real_preal_not_minus_gt_zero,
  28.864 +                        real_preal_not_less_zero,real_preal_zero_less,
  28.865 +                        real_preal_minus_less_zero]));
  28.866 +qed "real_minus_zero_less_iff";
  28.867 +
  28.868 +Addsimps [real_minus_zero_less_iff];
  28.869 +
  28.870 +Goal "(%~R < 0r) = (0r < R)";
  28.871 +by (res_inst_tac [("x","R")]  real_preal_trichotomyE 1);
  28.872 +by (auto_tac (claset(),simpset() addsimps [real_preal_not_minus_gt_zero,
  28.873 +                        real_preal_not_less_zero,real_preal_zero_less,
  28.874 +                        real_preal_minus_less_zero]));
  28.875 +qed "real_minus_zero_less_iff2";
  28.876 +
  28.877 +(** lemma **)
  28.878 +Goal "(0r < x) = (? y. x = %#y)";
  28.879 +by (auto_tac (claset(),simpset() addsimps [real_preal_zero_less]));
  28.880 +by (cut_inst_tac [("x","x")] real_preal_trichotomy 1);
  28.881 +by (blast_tac (claset() addSEs [real_less_irrefl,
  28.882 +     real_preal_not_minus_gt_zero RS notE]) 1);
  28.883 +qed "real_gt_zero_preal_Ex";
  28.884 +
  28.885 +Goal "!!x. %#z < x ==> ? y. x = %#y";
  28.886 +by (blast_tac (claset() addSDs [real_preal_zero_less RS real_less_trans]
  28.887 +               addIs [real_gt_zero_preal_Ex RS iffD1]) 1);
  28.888 +qed "real_gt_preal_preal_Ex";
  28.889 +
  28.890 +Goal "!!x. %#z <= x ==> ? y. x = %#y";
  28.891 +by (blast_tac (claset() addDs [real_le_imp_less_or_eq,
  28.892 +              real_gt_preal_preal_Ex]) 1);
  28.893 +qed "real_ge_preal_preal_Ex";
  28.894 +
  28.895 +Goal "!!y. y <= 0r ==> !x. y < %#x";
  28.896 +by (auto_tac (claset() addEs [real_le_imp_less_or_eq RS disjE]
  28.897 +              addIs [real_preal_zero_less RSN(2,real_less_trans)],
  28.898 +              simpset() addsimps [real_preal_zero_less]));
  28.899 +qed "real_less_all_preal";
  28.900 +
  28.901 +Goal "!!y. ~ 0r < y ==> !x. y < %#x";
  28.902 +by (blast_tac (claset() addSIs [real_less_all_preal,real_leI]) 1);
  28.903 +qed "real_less_all_real2";
  28.904 +
  28.905 +(**** Derive alternative definition for real_less ****)
  28.906 +(** lemma **)
  28.907 +Goal "!!(R::real). ? A. S + A = R";
  28.908 +by (res_inst_tac [("x","%~S + R")] exI 1);
  28.909 +by (simp_tac (simpset() addsimps [real_add_minus,
  28.910 +    real_add_zero_right] @ real_add_ac) 1);
  28.911 +qed "real_lemma_add_left_ex";
  28.912 +
  28.913 +Goal "!!(R::real). R < S ==> ? T. R + T = S";
  28.914 +by (res_inst_tac [("x","R")]  real_preal_trichotomyE 1);
  28.915 +by (ALLGOALS(res_inst_tac [("x","S")]  real_preal_trichotomyE));
  28.916 +by (auto_tac (claset() addSDs [preal_le_anti_sym] addSDs [preal_less_add_left_Ex],
  28.917 +              simpset() addsimps [preal_less_le_iff,real_preal_add,real_minus_add_eq,
  28.918 +               real_preal_minus_less_zero,real_less_not_refl,real_minus_ex,real_add_assoc,
  28.919 +               real_preal_zero_less,real_preal_minus_less_all,real_add_minus_left,
  28.920 +               real_preal_not_less_zero,real_add_zero_left,real_lemma_add_left_ex]));
  28.921 +qed "real_less_add_left_Ex";
  28.922 +
  28.923 +Goal "!!(R::real). R < S ==> ? T. 0r < T & R + T = S";
  28.924 +by (res_inst_tac [("x","R")]  real_preal_trichotomyE 1);
  28.925 +by (ALLGOALS(res_inst_tac [("x","S")]  real_preal_trichotomyE));
  28.926 +by (auto_tac (claset() addSDs [preal_less_add_left_Ex],
  28.927 +                         simpset() addsimps [real_preal_not_minus_gt_all,
  28.928 +            real_preal_add, real_preal_not_less_zero,real_less_not_refl,
  28.929 +    real_preal_not_minus_gt_zero,real_add_zero_left,real_minus_add_eq]));
  28.930 +by (res_inst_tac [("x","%#D")] exI 1);
  28.931 +by (res_inst_tac [("x","%#m+%#ma")] exI 2);
  28.932 +by (res_inst_tac [("x","%#m")] exI 3);
  28.933 +by (res_inst_tac [("x","%#D")] exI 4);
  28.934 +by (auto_tac (claset(),simpset() addsimps [real_preal_zero_less,
  28.935 +    real_preal_sum_zero_less,real_add_minus_left,real_add_assoc,
  28.936 +                          real_add_minus,real_add_zero_right]));
  28.937 +by (simp_tac (simpset() addsimps [real_add_assoc RS sym, 
  28.938 +            real_add_minus_left,real_add_zero_left]) 1);
  28.939 +qed "real_less_add_positive_left_Ex";
  28.940 +
  28.941 +(* lemmas *)
  28.942 +(** change naff name(s)! **)
  28.943 +Goal "!!S. (W < S) ==> (0r < S + %~W)";
  28.944 +by (dtac real_less_add_positive_left_Ex 1);
  28.945 +by (auto_tac (claset(),simpset() addsimps [real_add_minus,
  28.946 +    real_add_zero_right] @ real_add_ac));
  28.947 +qed "real_less_sum_gt_zero";
  28.948 +
  28.949 +Goal "!!S. T = S + W ==> S = T + %~W";
  28.950 +by (asm_simp_tac (simpset() addsimps [real_add_minus,
  28.951 +    real_add_zero_right] @ real_add_ac) 1);
  28.952 +qed "real_lemma_change_eq_subj";
  28.953 +
  28.954 +(* FIXME: long! *)
  28.955 +Goal "!!W. (0r < S + %~W) ==> (W < S)";
  28.956 +by (rtac ccontr 1);
  28.957 +by (dtac (real_leI RS real_le_imp_less_or_eq) 1);
  28.958 +by (auto_tac (claset(),
  28.959 +    simpset() addsimps [real_less_not_refl,real_add_minus]));
  28.960 +by (EVERY1[dtac real_less_add_positive_left_Ex, etac exE, etac conjE]);
  28.961 +by (asm_full_simp_tac (simpset() addsimps [real_add_zero_left]) 1);
  28.962 +by (dtac real_lemma_change_eq_subj 1);
  28.963 +by (auto_tac (claset(),simpset() addsimps [real_minus_minus]));
  28.964 +by (dtac real_less_sum_gt_zero 1);
  28.965 +by (asm_full_simp_tac (simpset() addsimps [real_minus_add_eq] @ real_add_ac) 1);
  28.966 +by (EVERY1[rotate_tac 1, dtac (real_add_left_commute RS ssubst)]);
  28.967 +by (auto_tac (claset() addEs [real_less_asym],
  28.968 +              simpset() addsimps [real_add_minus,real_add_zero_right]));
  28.969 +qed "real_sum_gt_zero_less";
  28.970 +
  28.971 +Goal "(0r < S + %~W) = (W < S)";
  28.972 +by (fast_tac (claset() addIs [real_less_sum_gt_zero,
  28.973 +    real_sum_gt_zero_less]) 1);
  28.974 +qed "real_less_sum_gt_0_iff";
  28.975 +
  28.976 +Goal "((x::real) < y) = (%~y < %~x)";
  28.977 +by (rtac (real_less_sum_gt_0_iff RS subst) 1);
  28.978 +by (res_inst_tac [("W1","x")] (real_less_sum_gt_0_iff RS subst) 1);
  28.979 +by (simp_tac (simpset() addsimps [real_add_commute]) 1);
  28.980 +qed "real_less_swap_iff";
  28.981 +
  28.982 +Goal "!!T. [| R + L = S; 0r < L |] ==> R < S";
  28.983 +by (rtac (real_less_sum_gt_0_iff RS iffD1) 1);
  28.984 +by (auto_tac (claset(),simpset() addsimps [
  28.985 +    real_add_minus,real_add_zero_right] @ real_add_ac));
  28.986 +qed "real_lemma_add_positive_imp_less";
  28.987 +
  28.988 +Goal "!!(R::real). ? T. 0r < T & R + T = S ==> R < S";
  28.989 +by (blast_tac (claset() addIs [real_lemma_add_positive_imp_less]) 1);
  28.990 +qed "real_ex_add_positive_left_less";
  28.991 +
  28.992 +(*** alternative definition for real_less ***)
  28.993 +Goal "!!(R::real). (? T. 0r < T & R + T = S) = (R < S)";
  28.994 +by (fast_tac (claset() addSIs [real_less_add_positive_left_Ex,
  28.995 +    real_ex_add_positive_left_less]) 1);
  28.996 +qed "real_less_iffdef";
  28.997 +
  28.998 +Goal "(0r < x) = (%~x < x)";
  28.999 +by (Step_tac 1);
 28.1000 +by (rtac ccontr 2 THEN forward_tac 
 28.1001 +    [real_leI RS real_le_imp_less_or_eq] 2);
 28.1002 +by (Step_tac 2);
 28.1003 +by (dtac (real_minus_zero_less_iff RS iffD2) 2);
 28.1004 +by (fast_tac (claset() addDs [real_less_trans]) 2);
 28.1005 +by (auto_tac (claset(),simpset() addsimps 
 28.1006 +    [real_gt_zero_preal_Ex,real_preal_minus_less_self]));
 28.1007 +qed "real_gt_zero_iff";
 28.1008 +
 28.1009 +Goal "(x < 0r) = (x < %~x)";
 28.1010 +by (rtac (real_minus_zero_less_iff RS subst) 1);
 28.1011 +by (stac real_gt_zero_iff 1);
 28.1012 +by (Full_simp_tac 1);
 28.1013 +qed "real_lt_zero_iff";
 28.1014 +
 28.1015 +Goalw [real_le_def] "(0r <= x) = (%~x <= x)";
 28.1016 +by (auto_tac (claset(),simpset() addsimps [real_lt_zero_iff RS sym]));
 28.1017 +qed "real_ge_zero_iff";
 28.1018 +
 28.1019 +Goalw [real_le_def] "(x <= 0r) = (x <= %~x)";
 28.1020 +by (auto_tac (claset(),simpset() addsimps [real_gt_zero_iff RS sym]));
 28.1021 +qed "real_le_zero_iff";
 28.1022 +
 28.1023 +Goal "(%#m1 <= %#m2) = (m1 <= m2)";
 28.1024 +by (auto_tac (claset() addSIs [preal_leI],
 28.1025 +    simpset() addsimps [real_less_le_iff RS sym]));
 28.1026 +by (dtac preal_le_less_trans 1 THEN assume_tac 1);
 28.1027 +by (etac preal_less_irrefl 1);
 28.1028 +qed "real_preal_le_iff";
 28.1029 +
 28.1030 +Goal "!!(x::real). [| 0r < x; 0r < y |] ==> 0r < x * y";
 28.1031 +by (auto_tac (claset(),simpset() addsimps [real_gt_zero_preal_Ex]));  
 28.1032 +by (res_inst_tac [("x","y*ya")] exI 1);
 28.1033 +by (full_simp_tac (simpset() addsimps [real_preal_mult]) 1);
 28.1034 +qed "real_mult_order";
 28.1035 +
 28.1036 +Goal "!!(x::real). [| x < 0r; y < 0r |] ==> 0r < x * y";
 28.1037 +by (REPEAT(dtac (real_minus_zero_less_iff RS iffD2) 1));
 28.1038 +by (dtac real_mult_order 1 THEN assume_tac 1);
 28.1039 +by (Asm_full_simp_tac 1);
 28.1040 +qed "real_mult_less_zero1";
 28.1041 +
 28.1042 +Goal "!!(x::real). [| 0r <= x; 0r <= y |] ==> 0r <= x * y";
 28.1043 +by (REPEAT(dtac real_le_imp_less_or_eq 1));
 28.1044 +by (auto_tac (claset() addIs [real_mult_order,
 28.1045 +    real_less_imp_le],simpset() addsimps [real_le_refl]));
 28.1046 +qed "real_le_mult_order";
 28.1047 +
 28.1048 +Goal "!!(x::real). [| x <= 0r; y <= 0r |] ==> 0r <= x * y";
 28.1049 +by (rtac real_less_or_eq_imp_le 1);
 28.1050 +by (dtac real_le_imp_less_or_eq 1 THEN etac disjE 1);
 28.1051 +by Auto_tac;
 28.1052 +by (dtac real_le_imp_less_or_eq 1);
 28.1053 +by (auto_tac (claset() addDs [real_mult_less_zero1],simpset()));
 28.1054 +qed "real_mult_le_zero1";
 28.1055 +
 28.1056 +Goal "!!(x::real). [| 0r <= x; y < 0r |] ==> x * y <= 0r";
 28.1057 +by (rtac real_less_or_eq_imp_le 1);
 28.1058 +by (dtac real_le_imp_less_or_eq 1 THEN etac disjE 1);
 28.1059 +by Auto_tac;
 28.1060 +by (dtac (real_minus_zero_less_iff RS iffD2) 1);
 28.1061 +by (rtac (real_minus_zero_less_iff RS subst) 1);
 28.1062 +by (blast_tac (claset() addDs [real_mult_order] 
 28.1063 +    addIs [real_minus_mult_eq2 RS ssubst]) 1);
 28.1064 +qed "real_mult_le_zero";
 28.1065 +
 28.1066 +Goal "!!(x::real). [| 0r < x; y < 0r |] ==> x*y < 0r";
 28.1067 +by (dtac (real_minus_zero_less_iff RS iffD2) 1);
 28.1068 +by (dtac real_mult_order 1 THEN assume_tac 1);
 28.1069 +by (rtac (real_minus_zero_less_iff RS iffD1) 1);
 28.1070 +by (asm_full_simp_tac (simpset() addsimps [real_minus_mult_eq2]) 1);
 28.1071 +qed "real_mult_less_zero";
 28.1072 +
 28.1073 +Goalw [real_one_def] "0r < 1r";
 28.1074 +by (auto_tac (claset() addIs [real_gt_zero_preal_Ex RS iffD2],
 28.1075 +    simpset() addsimps [real_preal_def]));
 28.1076 +qed "real_zero_less_one";
 28.1077 +
 28.1078 +(*** Completeness of reals ***)
 28.1079 +(** use supremum property of preal and theorems about real_preal **)
 28.1080 +              (*** a few lemmas ***)
 28.1081 +Goal "!!P y. ! x:P. 0r < x ==> ((? x:P. y < x) = (? X. %#X : P & y < %#X))";
 28.1082 +by (blast_tac (claset() addSDs [bspec,real_gt_zero_preal_Ex RS iffD1]) 1);
 28.1083 +qed "real_sup_lemma1";
 28.1084 +
 28.1085 +Goal "!!P. [| ! x:P. 0r < x; ? x. x: P; ? y. !x: P. x < y |] \
 28.1086 +\         ==> (? X. X: {w. %#w : P}) & (? Y. !X: {w. %#w : P}. X < Y)";
 28.1087 +by (rtac conjI 1);
 28.1088 +by (blast_tac (claset() addDs [bspec,real_gt_zero_preal_Ex RS iffD1]) 1);
 28.1089 +by Auto_tac;
 28.1090 +by (dtac bspec 1 THEN assume_tac 1);
 28.1091 +by (forward_tac [bspec] 1  THEN assume_tac 1);
 28.1092 +by (dtac real_less_trans 1 THEN assume_tac 1);
 28.1093 +by (dtac (real_gt_zero_preal_Ex RS iffD1) 1 THEN etac exE 1);
 28.1094 +by (res_inst_tac [("x","ya")] exI 1);
 28.1095 +by Auto_tac;
 28.1096 +by (dres_inst_tac [("x","%#X")] bspec 1 THEN assume_tac 1);
 28.1097 +by (etac real_preal_lessD 1);
 28.1098 +qed "real_sup_lemma2";
 28.1099 +
 28.1100 +(*-------------------------------------------------------------
 28.1101 +            Completeness of Positive Reals
 28.1102 + -------------------------------------------------------------*)
 28.1103 +
 28.1104 +(* Supremum property for the set of positive reals *)
 28.1105 +(* FIXME: long proof - can be improved - need only have one case split *)
 28.1106 +(* will do for now *)
 28.1107 +Goal "!!P. [| ! x:P. 0r < x; ? x. x: P; ? y. !x: P. x < y |] \
 28.1108 +\         ==> (? S. !y. (? x: P. y < x) = (y < S))";
 28.1109 +by (res_inst_tac [("x","%#psup({w. %#w : P})")] exI 1);
 28.1110 +by Auto_tac;
 28.1111 +by (forward_tac [real_sup_lemma2] 1 THEN Auto_tac);
 28.1112 +by (case_tac "0r < ya" 1);
 28.1113 +by (dtac (real_gt_zero_preal_Ex RS iffD1) 1);
 28.1114 +by (dtac real_less_all_real2 2);
 28.1115 +by Auto_tac;
 28.1116 +by (rtac (preal_complete RS spec RS iffD1) 1);
 28.1117 +by Auto_tac;
 28.1118 +by (forward_tac [real_gt_preal_preal_Ex] 1);
 28.1119 +by Auto_tac;
 28.1120 +(* second part *)
 28.1121 +by (rtac (real_sup_lemma1 RS iffD2) 1 THEN assume_tac 1);
 28.1122 +by (case_tac "0r < ya" 1);
 28.1123 +by (auto_tac (claset() addSDs [real_less_all_real2,
 28.1124 +        real_gt_zero_preal_Ex RS iffD1],simpset()));
 28.1125 +by (forward_tac [real_sup_lemma2] 2 THEN Auto_tac);
 28.1126 +by (forward_tac [real_sup_lemma2] 1 THEN Auto_tac);
 28.1127 +by (rtac (preal_complete RS spec RS iffD2 RS bexE) 1);
 28.1128 +by (Fast_tac 3);
 28.1129 +by (Fast_tac 1);
 28.1130 +by (Fast_tac 1);
 28.1131 +by (Blast_tac 1);
 28.1132 +qed "posreal_complete";
 28.1133 +
 28.1134 +(*------------------------------------------------------------------
 28.1135 +
 28.1136 + ------------------------------------------------------------------*)
 28.1137 +
 28.1138 +Goal "!!(A::real). A < B ==> A + C < B + C";
 28.1139 +by (dtac (real_less_iffdef RS iffD2) 1);
 28.1140 +by (rtac (real_less_iffdef RS iffD1) 1);
 28.1141 +by (REPEAT(Step_tac 1));
 28.1142 +by (full_simp_tac (simpset() addsimps real_add_ac) 1);
 28.1143 +qed "real_add_less_mono1";
 28.1144 +
 28.1145 +Goal "!!(A::real). A < B ==> C + A < C + B";
 28.1146 +by (auto_tac (claset() addIs [real_add_less_mono1],
 28.1147 +    simpset() addsimps [real_add_commute]));
 28.1148 +qed "real_add_less_mono2";
 28.1149 +
 28.1150 +Goal "!!(A::real). A + C < B + C ==> A < B";
 28.1151 +by (dres_inst_tac [("C","%~C")] real_add_less_mono1 1);
 28.1152 +by (asm_full_simp_tac (simpset() addsimps [real_add_assoc,
 28.1153 +    real_add_minus,real_add_zero_right]) 1);
 28.1154 +qed "real_less_add_right_cancel";
 28.1155 +
 28.1156 +Goal "!!(A::real). C + A < C + B ==> A < B";
 28.1157 +by (dres_inst_tac [("C","%~C")] real_add_less_mono2 1);
 28.1158 +by (asm_full_simp_tac (simpset() addsimps [real_add_assoc RS sym,
 28.1159 +    real_add_minus_left,real_add_zero_left]) 1);
 28.1160 +qed "real_less_add_left_cancel";
 28.1161 +
 28.1162 +Goal "!!x. [| 0r < x; 0r < y |] ==> 0r < x + y";
 28.1163 +by (REPEAT(dtac (real_gt_zero_preal_Ex RS iffD1) 1));
 28.1164 +by (rtac (real_gt_zero_preal_Ex RS iffD2) 1);
 28.1165 +by (Step_tac 1);
 28.1166 +by (res_inst_tac [("x","y + ya")] exI 1);
 28.1167 +by (full_simp_tac (simpset() addsimps [real_preal_add]) 1);
 28.1168 +qed "real_add_order";
 28.1169 +
 28.1170 +Goal "!!(x::real). [| 0r <= x; 0r <= y |] ==> 0r <= x + y";
 28.1171 +by (REPEAT(dtac real_le_imp_less_or_eq 1));
 28.1172 +by (auto_tac (claset() addIs [real_add_order,
 28.1173 +    real_less_imp_le],simpset() addsimps [real_add_zero_left,
 28.1174 +    real_add_zero_right,real_le_refl]));
 28.1175 +qed "real_le_add_order";
 28.1176 +
 28.1177 +Goal 
 28.1178 +      "!!x. [| R1 < S1; R2 < S2 |] ==> R1 + R2 < S1 + (S2::real)";
 28.1179 +by (dtac (real_less_iffdef RS iffD2) 1);
 28.1180 +by (dtac (real_less_iffdef RS iffD2) 1);
 28.1181 +by (rtac (real_less_iffdef RS iffD1) 1);
 28.1182 +by Auto_tac;
 28.1183 +by (res_inst_tac [("x","T + Ta")] exI 1);
 28.1184 +by (auto_tac (claset(),simpset() addsimps [real_add_order] @ real_add_ac));
 28.1185 +qed "real_add_less_mono";
 28.1186 +
 28.1187 +Goal "!!(x::real). [| 0r <= x; 0r <= y |] ==> 0r <= x + y";
 28.1188 +by (REPEAT(dtac real_le_imp_less_or_eq 1));
 28.1189 +by (auto_tac (claset() addIs [real_add_order,
 28.1190 +    real_less_imp_le],simpset() addsimps [real_add_zero_left,
 28.1191 +    real_add_zero_right,real_le_refl]));
 28.1192 +qed "real_le_add_order";
 28.1193 +
 28.1194 +Goal "!!(q1::real). q1 <= q2  ==> x + q1 <= x + q2";
 28.1195 +by (dtac real_le_imp_less_or_eq 1);
 28.1196 +by (Step_tac 1);
 28.1197 +by (auto_tac (claset() addSIs [real_le_refl,
 28.1198 +    real_less_imp_le,real_add_less_mono1],
 28.1199 +    simpset() addsimps [real_add_commute]));
 28.1200 +qed "real_add_left_le_mono1";
 28.1201 +
 28.1202 +Goal "!!(q1::real). q1 <= q2  ==> q1 + x <= q2 + x";
 28.1203 +by (auto_tac (claset() addDs [real_add_left_le_mono1],
 28.1204 +    simpset() addsimps [real_add_commute]));
 28.1205 +qed "real_add_le_mono1";
 28.1206 +
 28.1207 +Goal "!!k l::real. [|i<=j;  k<=l |] ==> i + k <= j + l";
 28.1208 +by (etac (real_add_le_mono1 RS real_le_trans) 1);
 28.1209 +by (simp_tac (simpset() addsimps [real_add_commute]) 1);
 28.1210 +(*j moves to the end because it is free while k, l are bound*)
 28.1211 +by (etac real_add_le_mono1 1);
 28.1212 +qed "real_add_le_mono";
 28.1213 +
 28.1214 +Goal "EX (x::real). x < y";
 28.1215 +by (rtac (real_add_zero_right RS subst) 1);
 28.1216 +by (res_inst_tac [("x","y + %~1r")] exI 1);
 28.1217 +by (auto_tac (claset() addSIs [real_add_less_mono2],
 28.1218 +    simpset() addsimps [real_minus_zero_less_iff2,
 28.1219 +    real_zero_less_one]));
 28.1220 +qed "real_less_Ex";
 28.1221 +(*---------------------------------------------------------------------------------
 28.1222 +             An embedding of the naturals in the reals
 28.1223 + ---------------------------------------------------------------------------------*)
 28.1224 +
 28.1225 +Goalw [real_nat_def] "%%#0 = 1r";
 28.1226 +by (full_simp_tac (simpset() addsimps [pnat_one_iff RS sym,real_preal_def]) 1);
 28.1227 +by (fold_tac [real_one_def]);
 28.1228 +by (rtac refl 1);
 28.1229 +qed "real_nat_one";
 28.1230 +
 28.1231 +Goalw [real_nat_def] "%%#1 = 1r + 1r";
 28.1232 +by (full_simp_tac (simpset() addsimps [real_preal_def,real_one_def,
 28.1233 +    pnat_two_eq,real_add,prat_pnat_add RS sym,preal_prat_add RS sym
 28.1234 +    ] @ pnat_add_ac) 1);
 28.1235 +qed "real_nat_two";
 28.1236 +
 28.1237 +Goalw [real_nat_def]
 28.1238 +          "%%#n1 + %%#n2 = %%#(n1 + n2) + 1r";
 28.1239 +by (full_simp_tac (simpset() addsimps [real_nat_one RS sym,
 28.1240 +    real_nat_def,real_preal_add RS sym,preal_prat_add RS sym,
 28.1241 +    prat_pnat_add RS sym,pnat_nat_add]) 1);
 28.1242 +qed "real_nat_add";
 28.1243 +
 28.1244 +Goal "%%#(n + 1) = %%#n + 1r";
 28.1245 +by (res_inst_tac [("x1","1r")] (real_add_right_cancel RS iffD1) 1);
 28.1246 +by (rtac (real_nat_add RS subst) 1);
 28.1247 +by (full_simp_tac (simpset() addsimps [real_nat_two,real_add_assoc]) 1);
 28.1248 +qed "real_nat_add_one";
 28.1249 +
 28.1250 +Goal "Suc n = n + 1";
 28.1251 +by Auto_tac;
 28.1252 +qed "lemma";
 28.1253 +
 28.1254 +Goal "%%#Suc n = %%#n + 1r";
 28.1255 +by (stac lemma 1);
 28.1256 +by (rtac real_nat_add_one 1);
 28.1257 +qed "real_nat_Suc";
 28.1258 +
 28.1259 +Goal "inj(real_nat)";
 28.1260 +by (rtac injI 1);
 28.1261 +by (rewtac real_nat_def);
 28.1262 +by (dtac (inj_real_preal RS injD) 1);
 28.1263 +by (dtac (inj_preal_prat RS injD) 1);
 28.1264 +by (dtac (inj_prat_pnat RS injD) 1);
 28.1265 +by (etac (inj_pnat_nat RS injD) 1);
 28.1266 +qed "inj_real_nat";
 28.1267 +
 28.1268 +Goalw [real_nat_def] "0r < %%#n";
 28.1269 +by (rtac (real_gt_zero_preal_Ex RS iffD2) 1);
 28.1270 +by (Blast_tac 1);
 28.1271 +qed "real_nat_less_zero";
 28.1272 +
 28.1273 +Goal "!!n. 1r <= %%#n";
 28.1274 +by (simp_tac (simpset() addsimps [real_nat_one RS sym]) 1);
 28.1275 +by (nat_ind_tac "n" 1);
 28.1276 +by (auto_tac (claset(),simpset () 
 28.1277 +    addsimps [real_nat_Suc,real_le_refl,real_nat_one]));
 28.1278 +by (res_inst_tac [("t","1r")] (real_add_zero_left RS subst) 1);
 28.1279 +by (rtac real_add_le_mono 1);
 28.1280 +by (auto_tac (claset(),simpset () 
 28.1281 +    addsimps [real_le_refl,real_nat_less_zero,
 28.1282 +    real_less_imp_le,real_add_zero_left]));
 28.1283 +qed "real_nat_less_one";
 28.1284 +
 28.1285 +Goal "rinv(%%#n) ~= 0r";
 28.1286 +by (rtac ((real_nat_less_zero RS 
 28.1287 +    real_not_refl2 RS not_sym) RS rinv_not_zero) 1);
 28.1288 +qed "real_nat_rinv_not_zero";
 28.1289 +
 28.1290 +Goal "!!x. rinv(%%#x) = rinv(%%#y) ==> x = y";
 28.1291 +by (rtac (inj_real_nat RS injD) 1);
 28.1292 +by (res_inst_tac [("n2","x")] 
 28.1293 +    (real_nat_rinv_not_zero RS real_mult_left_cancel RS iffD1) 1);
 28.1294 +by (full_simp_tac (simpset() addsimps [(real_nat_less_zero RS 
 28.1295 +    real_not_refl2 RS not_sym) RS real_mult_inv_left]) 1);
 28.1296 +by (asm_full_simp_tac (simpset() addsimps [(real_nat_less_zero RS 
 28.1297 +    real_not_refl2 RS not_sym)]) 1);
 28.1298 +qed "real_nat_rinv_inj";
 28.1299 +
 28.1300 +Goal "!!x. 0r < x ==> 0r < rinv x";
 28.1301 +by (EVERY1[rtac ccontr, dtac real_leI]);
 28.1302 +by (forward_tac [real_minus_zero_less_iff2 RS iffD2] 1);
 28.1303 +by (forward_tac [real_not_refl2 RS not_sym] 1);
 28.1304 +by (dtac (real_not_refl2 RS not_sym RS rinv_not_zero) 1);
 28.1305 +by (EVERY1[dtac real_le_imp_less_or_eq, Step_tac]); 
 28.1306 +by (dtac real_mult_less_zero1 1 THEN assume_tac 1);
 28.1307 +by (auto_tac (claset() addIs [real_zero_less_one RS real_less_asym],
 28.1308 +    simpset() addsimps [real_minus_mult_eq1 RS sym]));
 28.1309 +qed "real_rinv_gt_zero";
 28.1310 +
 28.1311 +Goal "!!x. x < 0r ==> rinv x < 0r";
 28.1312 +by (forward_tac [real_not_refl2] 1);
 28.1313 +by (dtac (real_minus_zero_less_iff RS iffD2) 1);
 28.1314 +by (rtac (real_minus_zero_less_iff RS iffD1) 1);
 28.1315 +by (dtac (real_minus_rinv RS sym) 1);
 28.1316 +by (auto_tac (claset() addIs [real_rinv_gt_zero],
 28.1317 +    simpset()));
 28.1318 +qed "real_rinv_less_zero";
 28.1319 +
 28.1320 +Goal "x+x=x*(1r+1r)";
 28.1321 +by (simp_tac (simpset() addsimps [real_add_mult_distrib2]) 1);
 28.1322 +qed "real_add_self";
 28.1323 +
 28.1324 +Goal "x < x + 1r";
 28.1325 +by (rtac (real_less_sum_gt_0_iff RS iffD1) 1);
 28.1326 +by (full_simp_tac (simpset() addsimps [real_zero_less_one,
 28.1327 +    real_add_assoc,real_add_minus,real_add_zero_right,
 28.1328 +    real_add_left_commute]) 1);
 28.1329 +qed "real_self_less_add_one";
 28.1330 +
 28.1331 +Goal "1r < 1r + 1r";
 28.1332 +by (rtac real_self_less_add_one 1);
 28.1333 +qed "real_one_less_two";
 28.1334 +
 28.1335 +Goal "0r < 1r + 1r";
 28.1336 +by (rtac ([real_zero_less_one,
 28.1337 +          real_one_less_two] MRS real_less_trans) 1);
 28.1338 +qed "real_zero_less_two";
 28.1339 +
 28.1340 +Goal "1r + 1r ~= 0r";
 28.1341 +by (rtac (real_zero_less_two RS real_not_refl2 RS not_sym) 1);
 28.1342 +qed "real_two_not_zero";
 28.1343 +
 28.1344 +Addsimps [real_two_not_zero];
 28.1345 +
 28.1346 +Goal "x*rinv(1r + 1r) + x*rinv(1r + 1r) = x";
 28.1347 +by (stac real_add_self 1);
 28.1348 +by (full_simp_tac (simpset() addsimps [real_mult_assoc]) 1);
 28.1349 +qed "real_sum_of_halves";
 28.1350 +
 28.1351 +Goal "!!(x::real). [| 0r<z; x<y |] ==> x*z<y*z";       
 28.1352 +by (rotate_tac 1 1);
 28.1353 +by (dtac real_less_sum_gt_zero 1);
 28.1354 +by (rtac real_sum_gt_zero_less 1);
 28.1355 +by (dtac real_mult_order 1 THEN assume_tac 1);
 28.1356 +by (asm_full_simp_tac (simpset() addsimps [real_add_mult_distrib2,
 28.1357 +    real_minus_mult_eq2 RS sym, real_mult_commute ]) 1);
 28.1358 +qed "real_mult_less_mono1";
 28.1359 +
 28.1360 +Goal "!!(y::real). [| 0r<z; x<y |] ==> z*x<z*y";       
 28.1361 +by (asm_simp_tac (simpset() addsimps [real_mult_commute,real_mult_less_mono1]) 1);
 28.1362 +qed "real_mult_less_mono2";
 28.1363 +
 28.1364 +Goal "!!(x::real). [| 0r<z; x*z<y*z |] ==> x<y";
 28.1365 +by (forw_inst_tac [("x","x*z")] (real_rinv_gt_zero 
 28.1366 +                       RS real_mult_less_mono1) 1);
 28.1367 +by (auto_tac (claset(),simpset() addsimps 
 28.1368 +     [real_mult_assoc,real_not_refl2 RS not_sym]));
 28.1369 +qed "real_mult_less_cancel1";
 28.1370 +
 28.1371 +Goal "!!(x::real). [| 0r<z; z*x<z*y |] ==> x<y";
 28.1372 +by (etac real_mult_less_cancel1 1);
 28.1373 +by (asm_full_simp_tac (simpset() addsimps [real_mult_commute]) 1);
 28.1374 +qed "real_mult_less_cancel2";
 28.1375 +
 28.1376 +Goal "!!z. 0r < z ==> (x*z < y*z) = (x < y)";
 28.1377 +by (blast_tac (claset() addIs [real_mult_less_mono1,
 28.1378 +    real_mult_less_cancel1]) 1);
 28.1379 +qed "real_mult_less_iff1";
 28.1380 +
 28.1381 +Goal "!!z. 0r < z ==> (z*x < z*y) = (x < y)";
 28.1382 +by (blast_tac (claset() addIs [real_mult_less_mono2,
 28.1383 +    real_mult_less_cancel2]) 1);
 28.1384 +qed "real_mult_less_iff2";
 28.1385 +
 28.1386 +Addsimps [real_mult_less_iff1,real_mult_less_iff2];
 28.1387 +
 28.1388 +Goal "!!(x::real). [| 0r<=z; x<y |] ==> x*z<=y*z";
 28.1389 +by (EVERY1 [rtac real_less_or_eq_imp_le, dtac real_le_imp_less_or_eq]);
 28.1390 +by (auto_tac (claset() addIs [real_mult_less_mono1],simpset()));
 28.1391 +qed "real_mult_le_less_mono1";
 28.1392 +
 28.1393 +Goal "!!(x::real). [| 0r<=z; x<y |] ==> z*x<=z*y";
 28.1394 +by (asm_simp_tac (simpset() addsimps [real_mult_commute,real_mult_le_less_mono1]) 1);
 28.1395 +qed "real_mult_le_less_mono2";
 28.1396 +
 28.1397 +Goal "!!x y (z::real). [| 0r<=z; x<=y |] ==> z*x<=z*y";
 28.1398 +by (dres_inst_tac [("x","x")] real_le_imp_less_or_eq 1);
 28.1399 +by (auto_tac (claset() addIs [real_mult_le_less_mono2,real_le_refl],simpset()));
 28.1400 +qed "real_mult_le_le_mono1";
 28.1401 +
 28.1402 +Goal "!!(x::real). x < y ==> x < (x + y)*rinv(1r + 1r)";
 28.1403 +by (dres_inst_tac [("C","x")] real_add_less_mono2 1);
 28.1404 +by (dtac (real_add_self RS subst) 1);
 28.1405 +by (dtac (real_zero_less_two RS real_rinv_gt_zero RS 
 28.1406 +          real_mult_less_mono1) 1);
 28.1407 +by (asm_full_simp_tac (simpset() addsimps [real_mult_assoc]) 1);
 28.1408 +qed "real_less_half_sum";
 28.1409 +
 28.1410 +Goal "!!(x::real). x < y ==> (x + y)*rinv(1r + 1r) < y";
 28.1411 +by (dres_inst_tac [("C","y")] real_add_less_mono1 1);
 28.1412 +by (dtac (real_add_self RS subst) 1);
 28.1413 +by (dtac (real_zero_less_two RS real_rinv_gt_zero RS 
 28.1414 +          real_mult_less_mono1) 1);
 28.1415 +by (asm_full_simp_tac (simpset() addsimps [real_mult_assoc]) 1);
 28.1416 +qed "real_gt_half_sum";
 28.1417 +
 28.1418 +Goal "!!(x::real). x < y ==> EX r. x < r & r < y";
 28.1419 +by (blast_tac (claset() addSIs [real_less_half_sum,real_gt_half_sum]) 1);
 28.1420 +qed "real_dense";
 28.1421 +
 28.1422 +Goal "(EX n. rinv(%%#n) < r) = (EX n. 1r < r * %%#n)";
 28.1423 +by (Step_tac 1);
 28.1424 +by (dres_inst_tac [("n1","n")] (real_nat_less_zero 
 28.1425 +                       RS real_mult_less_mono1) 1);
 28.1426 +by (dres_inst_tac [("n2","n")] (real_nat_less_zero RS 
 28.1427 +        real_rinv_gt_zero RS real_mult_less_mono1) 2);
 28.1428 +by (auto_tac (claset(),simpset() addsimps [(real_nat_less_zero RS 
 28.1429 +    real_not_refl2 RS not_sym),real_mult_assoc]));
 28.1430 +qed "real_nat_rinv_Ex_iff";
 28.1431 +
 28.1432 +Goalw [real_nat_def] "(%%#n < %%#m) = (n < m)";
 28.1433 +by Auto_tac;
 28.1434 +qed "real_nat_less_iff";
 28.1435 +
 28.1436 +Addsimps [real_nat_less_iff];
 28.1437 +
 28.1438 +Goal "!!u. 0r < u  ==> (u < rinv (%%#n)) = (%%#n < rinv(u))";
 28.1439 +by (Step_tac 1);
 28.1440 +by (res_inst_tac [("n2","n")] (real_nat_less_zero RS 
 28.1441 +    real_rinv_gt_zero RS real_mult_less_cancel1) 1);
 28.1442 +by (res_inst_tac [("x1","u")] ( real_rinv_gt_zero
 28.1443 +   RS real_mult_less_cancel1) 2);
 28.1444 +by (auto_tac (claset(),simpset() addsimps [real_nat_less_zero, 
 28.1445 +    real_not_refl2 RS not_sym]));
 28.1446 +by (res_inst_tac [("z","u")] real_mult_less_cancel2 1);
 28.1447 +by (res_inst_tac [("n1","n")] (real_nat_less_zero RS 
 28.1448 +    real_mult_less_cancel2) 3);
 28.1449 +by (auto_tac (claset(),simpset() addsimps [real_nat_less_zero, 
 28.1450 +    real_not_refl2 RS not_sym,real_mult_assoc RS sym]));
 28.1451 +qed "real_nat_less_rinv_iff";
 28.1452 +
 28.1453 +Goal "!!x. 0r < u ==> (u = rinv(%%#n)) = (%%#n = rinv u)";
 28.1454 +by (auto_tac (claset(),simpset() addsimps [real_rinv_rinv,
 28.1455 +    real_nat_less_zero,real_not_refl2 RS not_sym]));
 28.1456 +qed "real_nat_rinv_eq_iff";
 28.1457 +
 28.1458 +(*
 28.1459 +(*------------------------------------------------------------------
 28.1460 +     lemmas about upper bounds and least upper bound
 28.1461 + ------------------------------------------------------------------*)
 28.1462 +Goalw [real_ub_def] 
 28.1463 +          "!!S. [| real_ub u S; x : S |] ==> x <= u";
 28.1464 +by Auto_tac;
 28.1465 +qed "real_ubD";
 28.1466 +
 28.1467 +*)
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/src/HOL/Real/Real.thy	Thu Jun 25 13:57:34 1998 +0200
    29.3 @@ -0,0 +1,61 @@
    29.4 +(*  Title       : Real.thy
    29.5 +    Author      : Jacques D. Fleuriot
    29.6 +    Copyright   : 1998  University of Cambridge
    29.7 +    Description : The reals
    29.8 +*) 
    29.9 +
   29.10 +Real = PReal +
   29.11 +
   29.12 +constdefs
   29.13 +    realrel   ::  "((preal * preal) * (preal * preal)) set"
   29.14 +    "realrel  ==  {p. ? x1 y1 x2 y2. p=((x1::preal,y1),(x2,y2)) & x1+y2 = x2+y1}" 
   29.15 +
   29.16 +typedef real = "{x::(preal*preal).True}/realrel"          (Equiv.quotient_def)
   29.17 +
   29.18 +
   29.19 +instance
   29.20 +   real  :: {ord,plus,times}
   29.21 +
   29.22 +consts 
   29.23 +
   29.24 +  "0r"       :: real               ("0r")   
   29.25 +  "1r"       :: real               ("1r")  
   29.26 +
   29.27 +defs
   29.28 +
   29.29 +  real_zero_def      "0r == Abs_real(realrel^^{(@#($#1p),@#($#1p))})"
   29.30 +  real_one_def       "1r == Abs_real(realrel^^{(@#($#1p) + @#($#1p),@#($#1p))})"
   29.31 +
   29.32 +constdefs
   29.33 +
   29.34 +  real_preal :: preal => real              ("%#_" [80] 80)
   29.35 +  "%# m     == Abs_real(realrel^^{(m+@#($#1p),@#($#1p))})"
   29.36 +
   29.37 +  real_minus :: real => real               ("%~ _" [80] 80) 
   29.38 +  "%~ R     ==  Abs_real(UN p:Rep_real(R). split (%x y. realrel^^{(y,x)}) p)"
   29.39 +
   29.40 +  rinv       :: real => real
   29.41 +  "rinv(R)   == (@S. R ~= 0r & S*R = 1r)"
   29.42 +
   29.43 +  real_nat :: nat => real                  ("%%# _" [80] 80) 
   29.44 +  "%%# n      == %#(@#($#(*# n)))"
   29.45 +
   29.46 +defs
   29.47 +
   29.48 +  real_add_def  
   29.49 +  "P + Q == Abs_real(UN p1:Rep_real(P). UN p2:Rep_real(Q).
   29.50 +                split(%x1 y1. split(%x2 y2. realrel^^{(x1+x2, y1+y2)}) p2) p1)"
   29.51 +  
   29.52 +  real_mult_def  
   29.53 +  "P * Q == Abs_real(UN p1:Rep_real(P). UN p2:Rep_real(Q).
   29.54 +                split(%x1 y1. split(%x2 y2. realrel^^{(x1*x2+y1*y2,x1*y2+x2*y1)}) p2) p1)"
   29.55 +
   29.56 +  real_less_def
   29.57 +  "P < (Q::real) == EX x1 y1 x2 y2. x1 + y2 < x2 + y1 & 
   29.58 +                                   (x1,y1::preal):Rep_real(P) &
   29.59 +                                   (x2,y2):Rep_real(Q)" 
   29.60 +
   29.61 +  real_le_def
   29.62 +  "P <= (Q::real) == ~(Q < P)"
   29.63 +
   29.64 +end
    30.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.2 +++ b/src/HOL/Real/RealAbs.ML	Thu Jun 25 13:57:34 1998 +0200
    30.3 @@ -0,0 +1,239 @@
    30.4 +(*  Title       : RealAbs.ML
    30.5 +    Author      : Jacques D. Fleuriot
    30.6 +    Copyright   : 1998  University of Cambridge
    30.7 +    Description : Absolute value function for the reals
    30.8 +*) 
    30.9 +
   30.10 +open RealAbs;
   30.11 +
   30.12 +(*----------------------------------------------------------------------------
   30.13 +       Properties of the absolute value function over the reals
   30.14 +       (adapted version of previously proved theorems about abs)
   30.15 + ----------------------------------------------------------------------------*)
   30.16 +Goalw [rabs_def] "rabs r = (if 0r<=r then r else %~r)";
   30.17 +by (Step_tac 1);
   30.18 +qed "rabs_iff";
   30.19 +
   30.20 +Goalw [rabs_def] "rabs 0r = 0r";
   30.21 +by (rtac (real_le_refl RS if_P) 1);
   30.22 +qed "rabs_zero";
   30.23 +
   30.24 +Addsimps [rabs_zero];
   30.25 +
   30.26 +Goalw [rabs_def] "rabs 0r = %~0r";
   30.27 +by (stac real_minus_zero 1);
   30.28 +by (rtac if_cancel 1);
   30.29 +qed "rabs_minus_zero";
   30.30 +
   30.31 +val [prem] = goalw thy [rabs_def] "0r<=x ==> rabs x = x";
   30.32 +by (rtac (prem RS if_P) 1);
   30.33 +qed "rabs_eqI1";
   30.34 +
   30.35 +val [prem] = goalw thy [rabs_def] "0r<x ==> rabs x = x";
   30.36 +by (simp_tac (simpset() addsimps [(prem RS real_less_imp_le),rabs_eqI1]) 1);
   30.37 +qed "rabs_eqI2";
   30.38 +
   30.39 +val [prem] = goalw thy [rabs_def,real_le_def] "x<0r ==> rabs x = %~x";
   30.40 +by (simp_tac (simpset() addsimps [prem,if_not_P]) 1);
   30.41 +qed "rabs_minus_eqI2";
   30.42 +
   30.43 +Goal "!!x. x<=0r ==> rabs x = %~x";
   30.44 +by (dtac real_le_imp_less_or_eq 1);
   30.45 +by (fast_tac (HOL_cs addIs [rabs_minus_zero,rabs_minus_eqI2]) 1);
   30.46 +qed "rabs_minus_eqI1";
   30.47 +
   30.48 +Goalw [rabs_def,real_le_def] "0r<= rabs x";
   30.49 +by (full_simp_tac (simpset()  setloop (split_tac [expand_if])) 1);
   30.50 +by (blast_tac (claset() addDs [real_minus_zero_less_iff RS iffD2,
   30.51 +    real_less_asym]) 1);
   30.52 +qed "rabs_ge_zero";
   30.53 +
   30.54 +Goal "rabs(rabs x)=rabs x";
   30.55 +by (res_inst_tac [("r1","rabs x")] (rabs_iff RS ssubst) 1);
   30.56 +by (blast_tac (claset() addIs [if_P,rabs_ge_zero]) 1);
   30.57 +qed "rabs_idempotent";
   30.58 +
   30.59 +Goalw [rabs_def] "(x=0r) = (rabs x = 0r)";
   30.60 +by (full_simp_tac (simpset() setloop (split_tac [expand_if])) 1);
   30.61 +qed "rabs_zero_iff";
   30.62 +
   30.63 +Goal  "(x ~= 0r) = (rabs x ~= 0r)";
   30.64 +by (full_simp_tac (simpset() addsimps [rabs_zero_iff RS sym] 
   30.65 +    setloop (split_tac [expand_if])) 1);
   30.66 +qed "rabs_not_zero_iff";
   30.67 +
   30.68 +Goalw [rabs_def] "x<=rabs x";
   30.69 +by (full_simp_tac (simpset() addsimps [real_le_refl] setloop (split_tac [expand_if])) 1);
   30.70 +by (auto_tac (claset() addDs [not_real_leE RS real_less_imp_le],
   30.71 +    simpset() addsimps [real_le_zero_iff]));
   30.72 +qed "rabs_ge_self";
   30.73 +
   30.74 +Goalw [rabs_def] "%~x<=rabs x";
   30.75 +by (full_simp_tac (simpset() addsimps [real_le_refl,
   30.76 +    real_ge_zero_iff] setloop (split_tac [expand_if])) 1);
   30.77 +qed "rabs_ge_minus_self";
   30.78 +
   30.79 +(* case splits nightmare *)
   30.80 +Goalw [rabs_def] "rabs(x*y) = (rabs x)*(rabs y)";
   30.81 +by (auto_tac (claset(),simpset() addsimps [real_minus_mult_eq1,
   30.82 +   real_minus_mult_commute,real_minus_mult_eq2] setloop (split_tac [expand_if])));
   30.83 +by (blast_tac (claset() addDs [real_le_mult_order]) 1);
   30.84 +by (auto_tac (claset() addSDs [not_real_leE],simpset()));
   30.85 +by (EVERY1[dtac real_mult_le_zero, assume_tac, dtac real_le_anti_sym]);
   30.86 +by (EVERY[dtac real_mult_le_zero 3, assume_tac 3, dtac real_le_anti_sym 3]);
   30.87 +by (dtac real_mult_less_zero1 5 THEN assume_tac 5);
   30.88 +by (auto_tac (claset() addDs [real_less_asym,sym],
   30.89 +    simpset() addsimps [real_minus_mult_eq2 RS sym] @real_mult_ac));
   30.90 +qed "rabs_mult";
   30.91 +
   30.92 +Goalw [rabs_def] "!!x. x~= 0r ==> rabs(rinv(x)) = rinv(rabs(x))";
   30.93 +by (auto_tac (claset(),simpset() addsimps [real_minus_rinv] 
   30.94 +    setloop (split_tac [expand_if])));
   30.95 +by (ALLGOALS(dtac not_real_leE));
   30.96 +by (etac real_less_asym 1);
   30.97 +by (blast_tac (claset() addDs [real_le_imp_less_or_eq,
   30.98 +          real_rinv_gt_zero]) 1);
   30.99 +by (dtac (rinv_not_zero RS not_sym) 1);
  30.100 +by (rtac (real_rinv_less_zero RSN (2,real_less_asym)) 1);
  30.101 +by (assume_tac 2);
  30.102 +by (blast_tac (claset() addSDs [real_le_imp_less_or_eq]) 1);
  30.103 +qed "rabs_rinv";
  30.104 +
  30.105 +val [prem] = goal thy "y ~= 0r ==> rabs(x*rinv(y)) = rabs(x)*rinv(rabs(y))";
  30.106 +by (res_inst_tac [("c1","rabs y")] (real_mult_left_cancel RS subst) 1);
  30.107 +by (simp_tac (simpset() addsimps [(rabs_not_zero_iff RS sym), prem]) 1);
  30.108 +by (simp_tac (simpset() addsimps [(rabs_mult RS sym) ,real_mult_inv_right, 
  30.109 +    prem,rabs_not_zero_iff RS sym] @ real_mult_ac) 1);
  30.110 +qed "rabs_mult_rinv";
  30.111 +
  30.112 +Goal "rabs(x+y) <= rabs x + rabs y";
  30.113 +by (EVERY1 [res_inst_tac [("Q1","0r<=x+y")] (expand_if RS ssubst), rtac conjI]);
  30.114 +by (asm_simp_tac (simpset() addsimps [rabs_eqI1,real_add_le_mono,rabs_ge_self]) 1);
  30.115 +by (asm_simp_tac (simpset() addsimps [not_real_leE,rabs_minus_eqI2,real_add_le_mono,
  30.116 +                                     rabs_ge_minus_self,real_minus_add_eq]) 1);
  30.117 +qed "rabs_triangle_ineq";
  30.118 +
  30.119 +Goal "rabs(w + x + y + z) <= rabs(w) + rabs(x) + rabs(y) + rabs(z)";
  30.120 +by (full_simp_tac (simpset() addsimps [real_add_assoc]) 1);
  30.121 +by (blast_tac (claset() addSIs [(rabs_triangle_ineq RS real_le_trans),
  30.122 +                real_add_left_le_mono1,real_le_refl]) 1);
  30.123 +qed "rabs_triangle_ineq_four";
  30.124 +
  30.125 +Goalw [rabs_def] "rabs(%~x)=rabs(x)";
  30.126 +by (auto_tac (claset() addSDs [not_real_leE,real_less_asym] addIs [real_le_anti_sym],
  30.127 +   simpset() addsimps [real_ge_zero_iff] setloop (split_tac [expand_if])));
  30.128 +qed "rabs_minus_cancel";
  30.129 +
  30.130 +Goal "rabs(x + %~y) <= rabs x + rabs y";
  30.131 +by (res_inst_tac [("x1","y")] (rabs_minus_cancel RS subst) 1);
  30.132 +by (rtac rabs_triangle_ineq 1);
  30.133 +qed "rabs_triangle_minus_ineq";
  30.134 +
  30.135 +Goal "rabs (x + y + (%~l + %~m)) <= rabs(x + %~l) + rabs(y + %~m)";
  30.136 +by (full_simp_tac (simpset() addsimps [real_add_assoc]) 1);
  30.137 +by (res_inst_tac [("x1","y")] (real_add_left_commute RS ssubst) 1);
  30.138 +by (rtac (real_add_assoc RS subst) 1);
  30.139 +by (rtac rabs_triangle_ineq 1);
  30.140 +qed "rabs_sum_triangle_ineq";
  30.141 +
  30.142 +Goal "[| rabs x < r; rabs y < s |] ==> rabs(x+y) < r+s";
  30.143 +by (rtac real_le_less_trans 1);
  30.144 +by (rtac rabs_triangle_ineq 1);
  30.145 +by (REPEAT (ares_tac [real_add_less_mono] 1));
  30.146 +qed "rabs_add_less";
  30.147 +
  30.148 +Goal "!!x y. [| rabs x < r; rabs y < s |] ==> rabs(x+ %~y) < r+s";
  30.149 +by (rotate_tac 1 1);
  30.150 +by (dtac (rabs_minus_cancel RS ssubst) 1);
  30.151 +by (asm_simp_tac (simpset() addsimps [rabs_add_less]) 1);
  30.152 +qed "rabs_add_minus_less";
  30.153 +
  30.154 +(* lemmas manipulating terms *)
  30.155 +Goal "(0r*x<r)=(0r<r)";
  30.156 +by (Simp_tac 1);
  30.157 +qed "real_mult_0_less";
  30.158 +
  30.159 +Goal "[| 0r<y; x<r; y*r<t*s |] ==> y*x<t*s";
  30.160 +(*why PROOF FAILED for this*)
  30.161 +by (best_tac (claset() addIs [real_mult_less_mono2, real_less_trans]) 1);
  30.162 +qed "real_mult_less_trans";
  30.163 +
  30.164 +Goal "!!(x::real) y.[| 0r<=y; x<r; y*r<t*s; 0r<t*s|] ==> y*x<t*s";
  30.165 +by (dtac real_le_imp_less_or_eq 1);
  30.166 +by (fast_tac (HOL_cs addEs [(real_mult_0_less RS iffD2),real_mult_less_trans]) 1);
  30.167 +qed "real_mult_le_less_trans";
  30.168 +
  30.169 +(* proofs lifted from previous older version *)
  30.170 +Goal "[| rabs x<r; rabs y<s |] ==> rabs(x*y)<r*s";
  30.171 +by (simp_tac (simpset() addsimps [rabs_mult]) 1);
  30.172 +by (rtac real_mult_le_less_trans 1);
  30.173 +by (rtac rabs_ge_zero 1);
  30.174 +by (assume_tac 1);
  30.175 +by (blast_tac (HOL_cs addIs [rabs_ge_zero, real_mult_less_mono1, 
  30.176 +			     real_le_less_trans]) 1);
  30.177 +by (blast_tac (HOL_cs addIs [rabs_ge_zero, real_mult_order, 
  30.178 +			     real_le_less_trans]) 1);
  30.179 +qed "rabs_mult_less";
  30.180 +
  30.181 +Goal "!!x. [| rabs x < r; rabs y < s |] \
  30.182 +\          ==> rabs(x)*rabs(y)<r*s";
  30.183 +by (auto_tac (claset() addIs [rabs_mult_less],
  30.184 +              simpset() addsimps [rabs_mult RS sym]));
  30.185 +qed "rabs_mult_less2";
  30.186 +
  30.187 +Goal "!! x y r. 1r < rabs x ==> rabs y <= rabs(x*y)";
  30.188 +by (cut_inst_tac [("x1","y")] (rabs_ge_zero RS real_le_imp_less_or_eq) 1);
  30.189 +by (EVERY1[etac disjE,rtac real_less_imp_le]);
  30.190 +by (dres_inst_tac [("W","1r")]  real_less_sum_gt_zero 1);
  30.191 +by (forw_inst_tac [("y","rabs x + %~1r")] real_mult_order 1);
  30.192 +by (assume_tac 1);
  30.193 +by (rtac real_sum_gt_zero_less 1);
  30.194 +by (asm_full_simp_tac (simpset() addsimps [real_add_mult_distrib2,
  30.195 +    rabs_mult, real_mult_commute,real_minus_mult_eq1 RS sym]) 1);
  30.196 +by (dtac sym 1);
  30.197 +by (asm_full_simp_tac (simpset() addsimps [real_le_refl,rabs_mult]) 1);
  30.198 +qed "rabs_mult_le";
  30.199 +
  30.200 +Goal "!!x. [| 1r < rabs x; r < rabs y|] ==> r < rabs(x*y)";
  30.201 +by (fast_tac (HOL_cs addIs [rabs_mult_le, real_less_le_trans]) 1);
  30.202 +qed "rabs_mult_gt";
  30.203 +
  30.204 +Goal "!!r. rabs(x)<r ==> 0r<r";
  30.205 +by (blast_tac (claset() addSIs [real_le_less_trans,rabs_ge_zero]) 1);
  30.206 +qed "rabs_less_gt_zero";
  30.207 +
  30.208 +Goalw [rabs_def] "rabs 1r = 1r";
  30.209 +by (auto_tac (claset() addSDs [not_real_leE RS real_less_asym],
  30.210 +   simpset() addsimps [real_zero_less_one] setloop (split_tac [expand_if])));
  30.211 +qed "rabs_one";
  30.212 +
  30.213 +Goal "[| 0r < x ; x < r |] ==> rabs x < r";
  30.214 +by (asm_simp_tac (simpset() addsimps [rabs_eqI2]) 1);
  30.215 +qed "rabs_lessI";
  30.216 +
  30.217 +Goal "rabs x =x | rabs x = %~x";
  30.218 +by (cut_inst_tac [("R1.0","0r"),("R2.0","x")] real_linear 1);
  30.219 +by (fast_tac (claset() addIs [rabs_eqI2,rabs_minus_eqI2,
  30.220 +                            rabs_zero,rabs_minus_zero]) 1);
  30.221 +qed "rabs_disj";
  30.222 +
  30.223 +Goal "!!x. rabs x = y ==> x = y | %~x = y";
  30.224 +by (dtac sym 1);
  30.225 +by (hyp_subst_tac 1);
  30.226 +by (res_inst_tac [("x1","x")] (rabs_disj RS disjE) 1);
  30.227 +by (REPEAT(Asm_simp_tac 1));
  30.228 +qed "rabs_eq_disj";
  30.229 +
  30.230 +Goal "(rabs x < r) = (%~r<x & x<r)";
  30.231 +by (Step_tac 1);
  30.232 +by (rtac (real_less_swap_iff RS iffD2) 1);
  30.233 +by (asm_simp_tac (simpset() addsimps [(rabs_ge_minus_self 
  30.234 +    RS real_le_less_trans)]) 1);
  30.235 +by (asm_simp_tac (simpset() addsimps [(rabs_ge_self 
  30.236 +    RS real_le_less_trans)]) 1);
  30.237 +by (EVERY1 [dtac (real_less_swap_iff RS iffD1), rotate_tac 1, 
  30.238 +            dtac (real_minus_minus RS subst), 
  30.239 +            cut_inst_tac [("x","x")] rabs_disj, dtac disjE ]);
  30.240 +by (assume_tac 3 THEN Auto_tac);
  30.241 +qed "rabs_interval_iff";
  30.242 +
    31.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.2 +++ b/src/HOL/Real/RealAbs.thy	Thu Jun 25 13:57:34 1998 +0200
    31.3 @@ -0,0 +1,13 @@
    31.4 +(*  Title       : RealAbs.thy
    31.5 +    Author      : Jacques D. Fleuriot
    31.6 +    Copyright   : 1998  University of Cambridge
    31.7 +    Description : Absolute value function for the reals
    31.8 +*) 
    31.9 +
   31.10 +RealAbs = Real +
   31.11 +
   31.12 +constdefs
   31.13 +   rabs   :: real => real
   31.14 +   "rabs r      == if 0r<=r then r else %~r" 
   31.15 +
   31.16 +end
   31.17 \ No newline at end of file
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/HOL/ex/Group.ML	Thu Jun 25 13:57:34 1998 +0200
    32.3 @@ -0,0 +1,222 @@
    32.4 +(*  Title:      HOL/Integ/Group.ML
    32.5 +    ID:         $Id$
    32.6 +    Author:     Tobias Nipkow
    32.7 +    Copyright   1997 TU Muenchen
    32.8 +*)
    32.9 +
   32.10 +(*** Groups ***)
   32.11 +
   32.12 +(* Derives the well-known convergent set of equations for groups
   32.13 +   based on the unary inverse zero-x.
   32.14 +*)
   32.15 +
   32.16 +Goal "!!x::'a::add_group. (zero-x)+(x+y) = y";
   32.17 +by (rtac trans 1);
   32.18 +by (rtac (plus_assoc RS sym) 1);
   32.19 +by (stac left_inv 1);
   32.20 +by (rtac zeroL 1);
   32.21 +qed "left_inv2";
   32.22 +
   32.23 +Goal "!!x::'a::add_group. (zero-(zero-x)) = x";
   32.24 +by (rtac trans 1);
   32.25 +by (res_inst_tac [("x","zero-x")] left_inv2 2);
   32.26 +by (stac left_inv 1);
   32.27 +by (rtac (zeroR RS sym) 1);
   32.28 +qed "inv_inv";
   32.29 +
   32.30 +Goal "zero-zero = (zero::'a::add_group)";
   32.31 +by (rtac trans 1);
   32.32 +by (rtac (zeroR RS sym) 1);
   32.33 +by (rtac trans 1);
   32.34 +by (res_inst_tac [("x","zero")] left_inv2 2);
   32.35 +by (simp_tac (simpset() addsimps [zeroR]) 1);
   32.36 +qed "inv_zero";
   32.37 +
   32.38 +Goal "!!x::'a::add_group. x+(zero-x) = zero";
   32.39 +by (rtac trans 1);
   32.40 +by (res_inst_tac [("x","zero-x")] left_inv 2);
   32.41 +by (stac inv_inv 1);
   32.42 +by (rtac refl 1);
   32.43 +qed "right_inv";
   32.44 +
   32.45 +Goal "!!x::'a::add_group. x+((zero-x)+y) = y";
   32.46 +by (rtac trans 1);
   32.47 +by (res_inst_tac [("x","zero-x")] left_inv2 2);
   32.48 +by (stac inv_inv 1);
   32.49 +by (rtac refl 1);
   32.50 +qed "right_inv2";
   32.51 +
   32.52 +val plus_cong = read_instantiate [("f1","op +")] (arg_cong RS cong);
   32.53 +
   32.54 +Goal "!!x::'a::add_group. zero-(x+y) = (zero-y)+(zero-x)";
   32.55 +by (rtac trans 1);
   32.56 + by (rtac zeroR 2);
   32.57 +by (rtac trans 1);
   32.58 + by (rtac plus_cong 2);
   32.59 +  by (rtac refl 2);
   32.60 + by (res_inst_tac [("x","x+y")] right_inv 2);
   32.61 +by (rtac trans 1);
   32.62 + by (rtac plus_assoc 2);
   32.63 +by (rtac trans 1);
   32.64 + by (rtac plus_cong 2);
   32.65 +  by (simp_tac (simpset() addsimps
   32.66 +        [plus_assoc,left_inv,left_inv2,right_inv,right_inv2]) 2);
   32.67 + by (rtac refl 2);
   32.68 +by (rtac (zeroL RS sym) 1);
   32.69 +qed "inv_plus";
   32.70 +
   32.71 +(*** convergent TRS for groups with unary inverse zero-x ***)
   32.72 +val group1_simps =
   32.73 +  [zeroL,zeroR,plus_assoc,left_inv,left_inv2,right_inv,right_inv2,inv_inv,
   32.74 +   inv_zero,inv_plus];
   32.75 +
   32.76 +val group1_tac =
   32.77 +  let val ss = HOL_basic_ss addsimps group1_simps
   32.78 +  in simp_tac ss end;
   32.79 +
   32.80 +(* I believe there is no convergent TRS for groups with binary `-',
   32.81 +   unless you have an extra unary `-' and simply define x-y = x+(-y).
   32.82 +   This does not work with only a binary `-' because x-y = x+(zero-y) does
   32.83 +   not terminate. Hence we have a special tactic for converting all
   32.84 +   occurrences of x-y into x+(zero-y):
   32.85 +*)
   32.86 +
   32.87 +local
   32.88 +fun find(Const("op -",Type("fun",[T,_]))$s$t) = [(T,s,t)] @ find s @ find t
   32.89 +  | find(s$t) = find s @ find t
   32.90 +  | find _ = [];
   32.91 +
   32.92 +fun subst_tac sg (tacf,(T,s,t)) = 
   32.93 +  let val typinst = [(("'a",0),ctyp_of sg T)];
   32.94 +      val terminst = [(cterm_of sg (Var(("x",0),T)),cterm_of sg s),
   32.95 +                      (cterm_of sg (Var(("y",0),T)),cterm_of sg t)];
   32.96 +  in tacf THEN' rtac ((instantiate(typinst,terminst) minus_inv) RS ssubst) end;
   32.97 +
   32.98 +in
   32.99 +val mk_group1_tac = SUBGOAL(fn (t,i) => fn st =>
  32.100 +      let val sg = #sign(rep_thm st)
  32.101 +      in foldl (subst_tac sg) (K all_tac,find t) i st
  32.102 +      end)
  32.103 +end;
  32.104 +
  32.105 +(* The following two equations are not used in any of the decision procedures,
  32.106 +   but are still very useful. They also demonstrate mk_group1_tac.
  32.107 +*)
  32.108 +Goal "x-x = (zero::'a::add_group)";
  32.109 +by (mk_group1_tac 1);
  32.110 +by (group1_tac 1);
  32.111 +qed "minus_self_zero";
  32.112 +
  32.113 +Goal "x-zero = (x::'a::add_group)";
  32.114 +by (mk_group1_tac 1);
  32.115 +by (group1_tac 1);
  32.116 +qed "minus_zero";
  32.117 +
  32.118 +(*** Abelian Groups ***)
  32.119 +
  32.120 +Goal "x+(y+z)=y+(x+z::'a::add_agroup)";
  32.121 +by (rtac trans 1);
  32.122 +by (rtac plus_commute 1);
  32.123 +by (rtac trans 1);
  32.124 +by (rtac plus_assoc 1);
  32.125 +by (simp_tac (simpset() addsimps [plus_commute]) 1);
  32.126 +qed "plus_commuteL";
  32.127 +
  32.128 +(* Convergent TRS for Abelian groups with unary inverse zero-x.
  32.129 +   Requires ordered rewriting
  32.130 +*)
  32.131 +
  32.132 +val agroup1_simps = plus_commute::plus_commuteL::group1_simps;
  32.133 +
  32.134 +val agroup1_tac =
  32.135 +  let val ss = HOL_basic_ss addsimps agroup1_simps
  32.136 +  in simp_tac ss end;
  32.137 +
  32.138 +(* Again, I do not believe there is a convergent TRS for Abelian Groups with
  32.139 +   binary `-'. However, we can still decide the word problem using additional
  32.140 +   rules for 
  32.141 +   1. floating `-' to the top:
  32.142 +      "x + (y - z) = (x + y) - (z::'a::add_group)"
  32.143 +      "(x - y) + z = (x + z) - (y::'a::add_agroup)"
  32.144 +      "(x - y) - z = x - (y + (z::'a::add_agroup))"
  32.145 +      "x - (y - z) = (x + z) - (y::'a::add_agroup)"
  32.146 +   2. and for moving `-' over to the other side:
  32.147 +      (x-y = z) = (x = z+y) and (x = y-z) = (x+z = y)
  32.148 +*)
  32.149 +Goal "x + (y - z) = (x + y) - (z::'a::add_group)";
  32.150 +by (mk_group1_tac 1);
  32.151 +by (group1_tac 1);
  32.152 +qed "plus_minusR";
  32.153 +
  32.154 +Goal "(x - y) + z = (x + z) - (y::'a::add_agroup)";
  32.155 +by (mk_group1_tac 1);
  32.156 +by (agroup1_tac 1);
  32.157 +qed "plus_minusL";
  32.158 +
  32.159 +Goal "(x - y) - z = x - (y + (z::'a::add_agroup))";
  32.160 +by (mk_group1_tac 1);
  32.161 +by (agroup1_tac 1);
  32.162 +qed "minus_minusL";
  32.163 +
  32.164 +Goal "x - (y - z) = (x + z) - (y::'a::add_agroup)";
  32.165 +by (mk_group1_tac 1);
  32.166 +by (agroup1_tac 1);
  32.167 +qed "minus_minusR";
  32.168 +
  32.169 +Goal "!!x::'a::add_group. (x-y = z) = (x = z+y)";
  32.170 +by (stac minus_inv 1);
  32.171 +by (fast_tac (claset() addss (HOL_basic_ss addsimps group1_simps)) 1);
  32.172 +qed "minusL_iff";
  32.173 +
  32.174 +Goal "!!x::'a::add_group. (x = y-z) = (x+z = y)";
  32.175 +by (stac minus_inv 1);
  32.176 +by (fast_tac (claset() addss (HOL_basic_ss addsimps group1_simps)) 1);
  32.177 +qed "minusR_iff";
  32.178 +
  32.179 +val agroup2_simps =
  32.180 +  [zeroL,zeroR,plus_assoc,plus_commute,plus_commuteL,
  32.181 +   plus_minusR,plus_minusL,minus_minusL,minus_minusR,minusL_iff,minusR_iff];
  32.182 +
  32.183 +(* This two-phase ordered rewriting tactic works, but agroup_simps are
  32.184 +   simpler. However, agroup_simps is not confluent for arbitrary terms,
  32.185 +   it merely decides equality.
  32.186 +(* Phase 1 *)
  32.187 +
  32.188 +Goal "!!x::'a::add_agroup. (x+(zero-y))+z = (x+z)+(zero-y)";
  32.189 +by (Simp_tac 1);
  32.190 +val lemma = result();
  32.191 +bind_thm("plus_minusL",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
  32.192 +
  32.193 +Goal "!!x::'a::add_agroup. x+(zero-(y+z)) = (x+(zero-y))+(zero-z)";
  32.194 +by (Simp_tac 1);
  32.195 +val lemma = result();
  32.196 +bind_thm("minus_plusR",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
  32.197 +
  32.198 +Goal "!!x::'a::add_agroup. x+(zero-(y+(zero-z))) = (x+z)+(zero-y)";
  32.199 +by (Simp_tac 1);
  32.200 +val lemma = result();
  32.201 +bind_thm("minus_minusR",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
  32.202 +
  32.203 +Goal "!!x::'a::add_agroup. x+(y+(zero-z)) = (x+y)+(zero-z)";
  32.204 +by (Simp_tac 1);
  32.205 +val lemma = result();
  32.206 +bind_thm("plus_minusR",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
  32.207 +
  32.208 +(* Phase 2 *)
  32.209 +
  32.210 +Goal "!!x::'a::add_agroup. (x+y)+(zero-z) = x+(y+(zero-z))";
  32.211 +by (Simp_tac 1);
  32.212 +val lemma = result();
  32.213 +bind_thm("minus_plusL2",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
  32.214 +
  32.215 +Goal "!!x::'a::add_agroup. (x+y)+(zero-x) = y";
  32.216 +by (rtac (plus_assoc RS trans) 1);
  32.217 +by (rtac trans 1);
  32.218 + by (rtac plus_cong 1);
  32.219 +  by (rtac refl 1);
  32.220 + by (rtac right_inv2 2);
  32.221 +by (rtac plus_commute 1);
  32.222 +val lemma = result();
  32.223 +bind_thm("minus_plusL3",rewrite_rule[minus_inv RS sym RS eq_reflection]lemma);
  32.224 +
  32.225 +*)
    33.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.2 +++ b/src/HOL/ex/Group.thy	Thu Jun 25 13:57:34 1998 +0200
    33.3 @@ -0,0 +1,44 @@
    33.4 +(*  Title:      HOL/Integ/Group.thy
    33.5 +    ID:         $Id$
    33.6 +    Author:     Tobias Nipkow
    33.7 +    Copyright   1996 TU Muenchen
    33.8 +
    33.9 +A little bit of group theory leading up to rings. Hence groups are additive.
   33.10 +*)
   33.11 +
   33.12 +Group = Set +
   33.13 +
   33.14 +(* 0 already used in Nat *)
   33.15 +axclass  zero < term
   33.16 +consts   zero :: "'a::zero"
   33.17 +
   33.18 +(* additive semigroups *)
   33.19 +
   33.20 +axclass  add_semigroup < plus
   33.21 +  plus_assoc   "(x + y) + z = x + (y + z)"
   33.22 +
   33.23 +
   33.24 +(* additive monoids *)
   33.25 +
   33.26 +axclass  add_monoid < add_semigroup, zero
   33.27 +  zeroL    "zero + x = x"
   33.28 +  zeroR    "x + zero = x"
   33.29 +
   33.30 +(* additive groups *)
   33.31 +(*
   33.32 +The inverse is the binary `-'. Groups with unary and binary inverse are
   33.33 +interdefinable: x-y := x+(zero-y) and -x := zero-x. The law left_inv is
   33.34 +simply the translation of (-x)+x = zero. This characterizes groups already,
   33.35 +provided we only allow (zero-x). Law minus_inv `defines' the general x-y in
   33.36 +terms of the specific zero-y.
   33.37 +*)
   33.38 +axclass  add_group < add_monoid, minus
   33.39 +  left_inv  "(zero-x)+x = zero"
   33.40 +  minus_inv "x-y = x + (zero-y)"
   33.41 +
   33.42 +(* additive abelian groups *)
   33.43 +
   33.44 +axclass  add_agroup < add_group
   33.45 +  plus_commute  "x + y = y + x"
   33.46 +
   33.47 +end
    34.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.2 +++ b/src/HOL/ex/IntRing.ML	Thu Jun 25 13:57:34 1998 +0200
    34.3 @@ -0,0 +1,18 @@
    34.4 +(*  Title:      HOL/Integ/IntRing.ML
    34.5 +    ID:         $Id$
    34.6 +    Author:     Tobias Nipkow and Markus Wenzel
    34.7 +    Copyright   1996 TU Muenchen
    34.8 +
    34.9 +The instantiation of Lagrange's lemma for int.
   34.10 +*)
   34.11 +
   34.12 +open IntRing;
   34.13 +
   34.14 +Goal "!!i1::int. \
   34.15 +\  (sq i1 + sq i2 + sq i3 + sq i4) * (sq j1 + sq j2 + sq j3 + sq j4) = \
   34.16 +\  sq(i1*j1 - i2*j2 - i3*j3 - i4*j4)  + \
   34.17 +\  sq(i1*j2 + i2*j1 + i3*j4 - i4*j3)  + \
   34.18 +\  sq(i1*j3 - i2*j4 + i3*j1 + i4*j2)  + \
   34.19 +\  sq(i1*j4 + i2*j3 - i3*j2 + i4*j1)";
   34.20 +by (rtac Lagrange_lemma 1);
   34.21 +qed "Lagrange_lemma_int";
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/HOL/ex/IntRing.thy	Thu Jun 25 13:57:34 1998 +0200
    35.3 @@ -0,0 +1,19 @@
    35.4 +(*  Title:      HOL/Integ/IntRing.thy
    35.5 +    ID:         $Id$
    35.6 +    Author:     Tobias Nipkow and Markus Wenzel
    35.7 +    Copyright   1996 TU Muenchen
    35.8 +
    35.9 +The integers form a commutative ring.
   35.10 +With an application of Lagrange's lemma.
   35.11 +*)
   35.12 +
   35.13 +IntRing = IntRingDefs + Lagrange +
   35.14 +
   35.15 +instance int :: add_semigroup (zadd_assoc)
   35.16 +instance int :: add_monoid (zero_int_def,zadd_0,zadd_0_right)
   35.17 +instance int :: add_group (left_inv_int,minus_inv_int)
   35.18 +instance int :: add_agroup (zadd_commute)
   35.19 +instance int :: ring (zmult_assoc,zadd_zmult_distrib2,zadd_zmult_distrib)
   35.20 +instance int :: cring (zmult_commute)
   35.21 +
   35.22 +end
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/HOL/ex/IntRingDefs.ML	Thu Jun 25 13:57:34 1998 +0200
    36.3 @@ -0,0 +1,16 @@
    36.4 +(*  Title:      HOL/Integ/IntRingDefs.thy
    36.5 +    ID:         $Id$
    36.6 +    Author:     Tobias Nipkow and Markus Wenzel
    36.7 +    Copyright   1996 TU Muenchen
    36.8 +
    36.9 +*)
   36.10 +
   36.11 +open IntRingDefs;
   36.12 +
   36.13 +Goalw [zero_int_def,zdiff_def] "(zero-x)+(x::int) = zero";
   36.14 +by (Simp_tac 1);
   36.15 +qed "left_inv_int";
   36.16 +
   36.17 +Goalw [zero_int_def,zdiff_def] "x-y = (x::int) + (zero-y)";
   36.18 +by (Simp_tac 1);
   36.19 +qed "minus_inv_int";
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/HOL/ex/IntRingDefs.thy	Thu Jun 25 13:57:34 1998 +0200
    37.3 @@ -0,0 +1,15 @@
    37.4 +(*  Title:      HOL/Integ/IntRingDefs.thy
    37.5 +    ID:         $Id$
    37.6 +    Author:     Tobias Nipkow and Markus Wenzel
    37.7 +    Copyright   1996 TU Muenchen
    37.8 +
    37.9 +Provides the basic defs and thms for showing that int is a commutative ring.
   37.10 +Most of it has been defined and shown already.
   37.11 +*)
   37.12 +
   37.13 +IntRingDefs = Integ + Ring +
   37.14 +
   37.15 +instance int :: zero
   37.16 +defs zero_int_def "zero::int == $# 0"
   37.17 +
   37.18 +end
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/HOL/ex/Lagrange.ML	Thu Jun 25 13:57:34 1998 +0200
    38.3 @@ -0,0 +1,37 @@
    38.4 +(*  Title:      HOL/Integ/Lagrange.ML
    38.5 +    ID:         $Id$
    38.6 +    Author:     Tobias Nipkow
    38.7 +    Copyright   1996 TU Muenchen
    38.8 +
    38.9 +
   38.10 +The following lemma essentially shows that all composite natural numbers are
   38.11 +sums of fours squares, provided all prime numbers are. However, this is an
   38.12 +abstract thm about commutative rings and has a priori nothing to do with nat.
   38.13 +*)
   38.14 +
   38.15 +Goalw [Lagrange.sq_def] "!!x1::'a::cring. \
   38.16 +\  (sq x1 + sq x2 + sq x3 + sq x4) * (sq y1 + sq y2 + sq y3 + sq y4) = \
   38.17 +\  sq(x1*y1 - x2*y2 - x3*y3 - x4*y4)  + \
   38.18 +\  sq(x1*y2 + x2*y1 + x3*y4 - x4*y3)  + \
   38.19 +\  sq(x1*y3 - x2*y4 + x3*y1 + x4*y2)  + \
   38.20 +\  sq(x1*y4 + x2*y3 - x3*y2 + x4*y1)";
   38.21 +(*Takes up to three minutes...*)
   38.22 +by (cring_tac 1);
   38.23 +qed "Lagrange_lemma";
   38.24 +
   38.25 +(* A challenge by John Harrison.
   38.26 +   Takes forever because of the naive bottom-up strategy of the rewriter.
   38.27 +
   38.28 +Goalw [Lagrange.sq_def] "!!p1::'a::cring.\
   38.29 +\ (sq p1 + sq q1 + sq r1 + sq s1 + sq t1 + sq u1 + sq v1 + sq w1) * \
   38.30 +\ (sq p2 + sq q2 + sq r2 + sq s2 + sq t2 + sq u2 + sq v2 + sq w2) \
   38.31 +\  = sq (p1*p2 - q1*q2 - r1*r2 - s1*s2 - t1*t2 - u1*u2 - v1*v2 - w1*w2) + \
   38.32 +\    sq (p1*q2 + q1*p2 + r1*s2 - s1*r2 + t1*u2 - u1*t2 - v1*w2 + w1*v2) +\
   38.33 +\    sq (p1*r2 - q1*s2 + r1*p2 + s1*q2 + t1*v2 + u1*w2 - v1*t2 - w1*u2) +\
   38.34 +\    sq (p1*s2 + q1*r2 - r1*q2 + s1*p2 + t1*w2 - u1*v2 + v1*u2 - w1*t2) +\
   38.35 +\    sq (p1*t2 - q1*u2 - r1*v2 - s1*w2 + t1*p2 + u1*q2 + v1*r2 + w1*s2) +\
   38.36 +\    sq (p1*u2 + q1*t2 - r1*w2 + s1*v2 - t1*q2 + u1*p2 - v1*s2 + w1*r2) +\
   38.37 +\    sq (p1*v2 + q1*w2 + r1*t2 - s1*u2 - t1*r2 + u1*s2 + v1*p2 - w1*q2) +\
   38.38 +\    sq (p1*w2 - q1*v2 + r1*u2 + s1*t2 - t1*s2 - u1*r2 + v1*q2 + w1*p2)";
   38.39 +
   38.40 +*)
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/HOL/ex/Lagrange.thy	Thu Jun 25 13:57:34 1998 +0200
    39.3 @@ -0,0 +1,18 @@
    39.4 +(*  Title:      HOL/Integ/Lagrange.thy
    39.5 +    ID:         $Id$
    39.6 +    Author:     Tobias Nipkow
    39.7 +    Copyright   1996 TU Muenchen
    39.8 +
    39.9 +
   39.10 +This theory only contains a single thm, which is a lemma in Lagrange's proof
   39.11 +that every natural number is the sum of 4 squares.  It's sole purpose is to
   39.12 +demonstrate ordered rewriting for commutative rings.
   39.13 +
   39.14 +The enterprising reader might consider proving all of Lagrange's thm.
   39.15 +*)
   39.16 +Lagrange = Ring +
   39.17 +
   39.18 +constdefs sq :: 'a::times => 'a
   39.19 +         "sq x == x*x"
   39.20 +
   39.21 +end
    40.1 --- a/src/HOL/ex/Primrec.ML	Wed Jun 24 13:59:45 1998 +0200
    40.2 +++ b/src/HOL/ex/Primrec.ML	Thu Jun 25 13:57:34 1998 +0200
    40.3 @@ -128,7 +128,7 @@
    40.4  val lemma = result();
    40.5  
    40.6  Goal "!!i j k. i<j ==> ack(i,k) < ack(j,k)";
    40.7 -by (etac less_natE 1);
    40.8 +by (dtac less_eq_Suc_add 1);
    40.9  by (blast_tac (claset() addSIs [lemma]) 1);
   40.10  qed "ack_less_mono1";
   40.11  
    41.1 --- a/src/HOL/ex/ROOT.ML	Wed Jun 24 13:59:45 1998 +0200
    41.2 +++ b/src/HOL/ex/ROOT.ML	Thu Jun 25 13:57:34 1998 +0200
    41.3 @@ -28,6 +28,8 @@
    41.4  time_use_thy "Qsort";
    41.5  time_use_thy "Puzzle";
    41.6  
    41.7 +time_use_thy "IntRing";
    41.8 +
    41.9  time_use     "set.ML";
   41.10  time_use_thy "MT";
   41.11  
    42.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.2 +++ b/src/HOL/ex/Ring.ML	Thu Jun 25 13:57:34 1998 +0200
    42.3 @@ -0,0 +1,139 @@
    42.4 +(*  Title:      HOL/Integ/Ring.ML
    42.5 +    ID:         $Id$
    42.6 +    Author:     Tobias Nipkow
    42.7 +    Copyright   1996 TU Muenchen
    42.8 +
    42.9 +Derives a few equational consequences about rings
   42.10 +and defines cring_simpl, a simplification tactic for commutative rings.
   42.11 +*)
   42.12 +
   42.13 +Goal "!!x::'a::cring. x*(y*z)=y*(x*z)";
   42.14 +by (rtac trans 1);
   42.15 +by (rtac times_commute 1);
   42.16 +by (rtac trans 1);
   42.17 +by (rtac times_assoc 1);
   42.18 +by (simp_tac (HOL_basic_ss addsimps [times_commute]) 1);
   42.19 +qed "times_commuteL";
   42.20 +
   42.21 +val times_cong = read_instantiate [("f1","op *")] (arg_cong RS cong);
   42.22 +
   42.23 +Goal "!!x::'a::ring. zero*x = zero";
   42.24 +by (rtac trans 1);
   42.25 + by (rtac right_inv 2);
   42.26 +by (rtac trans 1);
   42.27 + by (rtac plus_cong 2);
   42.28 +  by (rtac refl 3);
   42.29 + by (rtac trans 2);
   42.30 +  by (rtac times_cong 3);
   42.31 +   by (rtac zeroL 3);
   42.32 +  by (rtac refl 3);
   42.33 + by (rtac (distribR RS sym) 2);
   42.34 +by (rtac trans 1);
   42.35 + by (rtac (plus_assoc RS sym) 2);
   42.36 +by (rtac trans 1);
   42.37 + by (rtac plus_cong 2);
   42.38 +  by (rtac refl 2);
   42.39 + by (rtac (right_inv RS sym) 2);
   42.40 +by (rtac (zeroR RS sym) 1);
   42.41 +qed "mult_zeroL";
   42.42 +
   42.43 +Goal "!!x::'a::ring. x*zero = zero";
   42.44 +by (rtac trans 1);
   42.45 + by (rtac right_inv 2);
   42.46 +by (rtac trans 1);
   42.47 + by (rtac plus_cong 2);
   42.48 +  by (rtac refl 3);
   42.49 + by (rtac trans 2);
   42.50 +  by (rtac times_cong 3);
   42.51 +   by (rtac zeroL 4);
   42.52 +  by (rtac refl 3);
   42.53 + by (rtac (distribL RS sym) 2);
   42.54 +by (rtac trans 1);
   42.55 + by (rtac (plus_assoc RS sym) 2);
   42.56 +by (rtac trans 1);
   42.57 + by (rtac plus_cong 2);
   42.58 +  by (rtac refl 2);
   42.59 + by (rtac (right_inv RS sym) 2);
   42.60 +by (rtac (zeroR RS sym) 1);
   42.61 +qed "mult_zeroR";
   42.62 +
   42.63 +Goal "!!x::'a::ring. (zero-x)*y = zero-(x*y)";
   42.64 +by (rtac trans 1);
   42.65 + by (rtac zeroL 2);
   42.66 +by (rtac trans 1);
   42.67 + by (rtac plus_cong 2);
   42.68 +  by (rtac refl 3);
   42.69 + by (rtac mult_zeroL 2);
   42.70 +by (rtac trans 1);
   42.71 + by (rtac plus_cong 2);
   42.72 +  by (rtac refl 3);
   42.73 + by (rtac times_cong 2);
   42.74 +  by (rtac left_inv 2);
   42.75 + by (rtac refl 2);
   42.76 +by (rtac trans 1);
   42.77 + by (rtac plus_cong 2);
   42.78 +  by (rtac refl 3);
   42.79 + by (rtac (distribR RS sym) 2);
   42.80 +by (rtac trans 1);
   42.81 + by (rtac (plus_assoc RS sym) 2);
   42.82 +by (rtac trans 1);
   42.83 + by (rtac plus_cong 2);
   42.84 +  by (rtac refl 2);
   42.85 + by (rtac (right_inv RS sym) 2);
   42.86 +by (rtac (zeroR RS sym) 1);
   42.87 +qed "mult_invL";
   42.88 +
   42.89 +Goal "!!x::'a::ring. x*(zero-y) = zero-(x*y)";
   42.90 +by (rtac trans 1);
   42.91 + by (rtac zeroL 2);
   42.92 +by (rtac trans 1);
   42.93 + by (rtac plus_cong 2);
   42.94 +  by (rtac refl 3);
   42.95 + by (rtac mult_zeroR 2);
   42.96 +by (rtac trans 1);
   42.97 + by (rtac plus_cong 2);
   42.98 +  by (rtac refl 3);
   42.99 + by (rtac times_cong 2);
  42.100 +  by (rtac refl 2);
  42.101 + by (rtac left_inv 2);
  42.102 +by (rtac trans 1);
  42.103 + by (rtac plus_cong 2);
  42.104 +  by (rtac refl 3);
  42.105 + by (rtac (distribL RS sym) 2);
  42.106 +by (rtac trans 1);
  42.107 + by (rtac (plus_assoc RS sym) 2);
  42.108 +by (rtac trans 1);
  42.109 + by (rtac plus_cong 2);
  42.110 +  by (rtac refl 2);
  42.111 + by (rtac (right_inv RS sym) 2);
  42.112 +by (rtac (zeroR RS sym) 1);
  42.113 +qed "mult_invR";
  42.114 +
  42.115 +Goal "x*(y-z) = (x*y - x*z::'a::ring)";
  42.116 +by (mk_group1_tac 1);
  42.117 +by (simp_tac (HOL_basic_ss addsimps [distribL,mult_invR]) 1);
  42.118 +qed "minus_distribL";
  42.119 +
  42.120 +Goal "(x-y)*z = (x*z - y*z::'a::ring)";
  42.121 +by (mk_group1_tac 1);
  42.122 +by (simp_tac (HOL_basic_ss addsimps [distribR,mult_invL]) 1);
  42.123 +qed "minus_distribR";
  42.124 +
  42.125 +val cring_simps = [times_assoc,times_commute,times_commuteL,
  42.126 +                   distribL,distribR,minus_distribL,minus_distribR]
  42.127 +                  @ agroup2_simps;
  42.128 +
  42.129 +val cring_tac =
  42.130 +  let val ss = HOL_basic_ss addsimps cring_simps
  42.131 +  in simp_tac ss end;
  42.132 +
  42.133 +
  42.134 +(*** The order [minus_plusL3,minus_plusL2] is important because minus_plusL3
  42.135 +     MUST be tried first
  42.136 +val cring_simp =
  42.137 +  let val phase1 = simpset() addsimps
  42.138 +                   [plus_minusL,minus_plusR,minus_minusR,plus_minusR]
  42.139 +      val phase2 = HOL_ss addsimps [minus_plusL3,minus_plusL2,
  42.140 +                                    zeroL,zeroR,mult_zeroL,mult_zeroR]
  42.141 +  in simp_tac phase1 THEN' simp_tac phase2 end;
  42.142 +***)
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/HOL/ex/Ring.thy	Thu Jun 25 13:57:34 1998 +0200
    43.3 @@ -0,0 +1,24 @@
    43.4 +(*  Title:      HOL/Integ/Ring.thy
    43.5 +    ID:         $Id$
    43.6 +    Author:     Tobias Nipkow
    43.7 +    Copyright   1996 TU Muenchen
    43.8 +
    43.9 +Bits of rings.
   43.10 +Main output: a simplification tactic for commutative rings.
   43.11 +*)
   43.12 +
   43.13 +Ring = Group +
   43.14 +
   43.15 +(* Ring *)
   43.16 +
   43.17 +axclass  ring < add_agroup, times
   43.18 +  times_assoc "(x*y)*z = x*(y*z)"
   43.19 +  distribL    "x*(y+z) = x*y + x*z"
   43.20 +  distribR    "(x+y)*z = x*z + y*z"
   43.21 +
   43.22 +(* Commutative ring *)
   43.23 +
   43.24 +axclass cring < ring
   43.25 +  times_commute "x*y = y*x"
   43.26 +
   43.27 +end