replacing HOL/Real/PRat, PNat by the rational number development
authorpaulson
Tue Jan 27 15:39:51 2004 +0100 (2004-01-27)
changeset 143653d4df8c166ae
parent 14364 fc62df0bf353
child 14366 dd4e0f2c071a
replacing HOL/Real/PRat, PNat by the rational number development
of Markus Wenzel
src/HOL/Complex/CLim.ML
src/HOL/Complex/NSCA.ML
src/HOL/HOL.thy
src/HOL/Hyperreal/HRealAbs.ML
src/HOL/Hyperreal/HRealAbs.thy
src/HOL/Hyperreal/HyperDef.thy
src/HOL/Hyperreal/IntFloor.ML
src/HOL/Hyperreal/Integration.ML
src/HOL/Hyperreal/Lim.ML
src/HOL/Hyperreal/Log.ML
src/HOL/Hyperreal/MacLaurin.ML
src/HOL/Hyperreal/NSA.ML
src/HOL/Hyperreal/NthRoot.thy
src/HOL/Hyperreal/Poly.ML
src/HOL/Hyperreal/SEQ.ML
src/HOL/Hyperreal/Series.ML
src/HOL/Hyperreal/Transcendental.ML
src/HOL/Integ/Bin.thy
src/HOL/Integ/Equiv.thy
src/HOL/Integ/Int.thy
src/HOL/Integ/IntArith.thy
src/HOL/Integ/NatBin.thy
src/HOL/Integ/nat_simprocs.ML
src/HOL/IsaMakefile
src/HOL/Library/Library.thy
src/HOL/Library/Rational_Numbers.thy
src/HOL/MicroJava/BV/Kildall.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.thy
src/HOL/Real/RComplete.ML
src/HOL/Real/RComplete.thy
src/HOL/Real/RatArith.thy
src/HOL/Real/Rational.thy
src/HOL/Real/RealArith.thy
src/HOL/Real/RealBin.ML
src/HOL/Real/RealBin.thy
src/HOL/Real/RealDef.thy
src/HOL/Real/RealInt.thy
src/HOL/Real/rat_arith.ML
src/HOL/Real/real_arith.ML
src/HOL/Ring_and_Field.thy
     1.1 --- a/src/HOL/Complex/CLim.ML	Tue Jan 27 09:44:14 2004 +0100
     1.2 +++ b/src/HOL/Complex/CLim.ML	Tue Jan 27 15:39:51 2004 +0100
     1.3 @@ -83,7 +83,7 @@
     1.4      CInfinitesimal_hcmod_iff,hcomplex_of_complex_def,
     1.5      Infinitesimal_FreeUltrafilterNat_iff,hcmod]));
     1.6  by (EVERY1[rtac ccontr, Asm_full_simp_tac]);
     1.7 -by (fold_tac [real_le_def]);
     1.8 +by (asm_full_simp_tac (simpset() addsimps [linorder_not_less]) 1);
     1.9  by (dtac lemma_skolemize_CLIM2 1);
    1.10  by (Step_tac 1);
    1.11  by (dres_inst_tac [("x","X")] spec 1);
    1.12 @@ -159,7 +159,7 @@
    1.13      CInfinitesimal_hcmod_iff,hcmod,Infinitesimal_approx_minus RS sym,
    1.14      Infinitesimal_FreeUltrafilterNat_iff]));
    1.15  by (EVERY1[rtac ccontr, Asm_full_simp_tac]);
    1.16 -by (fold_tac [real_le_def]);
    1.17 +by (asm_full_simp_tac (simpset() addsimps [linorder_not_less]) 1);
    1.18  by (dtac lemma_skolemize_CRLIM2 1);
    1.19  by (Step_tac 1);
    1.20  by (dres_inst_tac [("x","X")] spec 1);
     2.1 --- a/src/HOL/Complex/NSCA.ML	Tue Jan 27 09:44:14 2004 +0100
     2.2 +++ b/src/HOL/Complex/NSCA.ML	Tue Jan 27 15:39:51 2004 +0100
     2.3 @@ -863,17 +863,18 @@
     2.4  
     2.5  Goal "Abs_hcomplex(hcomplexrel ``{%n. X n}) : CFinite \
     2.6  \     ==> Abs_hypreal(hyprel `` {%n. Re(X n)}) : HFinite";
     2.7 -by (auto_tac (claset(),simpset() addsimps [CFinite_hcmod_iff,
     2.8 -    hcmod,HFinite_FreeUltrafilterNat_iff]));
     2.9 +by (auto_tac (claset(),
    2.10 + simpset() addsimps [CFinite_hcmod_iff,hcmod,HFinite_FreeUltrafilterNat_iff]));
    2.11  by (rtac bexI 1 THEN rtac lemma_hyprel_refl 2);
    2.12  by (res_inst_tac [("x","u")] exI 1 THEN Auto_tac);
    2.13  by (Ultra_tac 1);
    2.14  by (dtac sym 1 THEN res_inst_tac [("z","X x")] eq_Abs_complex 1);
    2.15 -by (auto_tac (claset(),simpset() addsimps [complex_mod,numeral_2_eq_2] delsimps [realpow_Suc]));
    2.16 +by (auto_tac (claset(),
    2.17 +    simpset() addsimps [complex_mod,numeral_2_eq_2] delsimps [realpow_Suc]));
    2.18  by (rtac ccontr 1 THEN dtac (linorder_not_less RS iffD1) 1);
    2.19  by (dtac order_less_le_trans 1 THEN assume_tac 1);
    2.20  by (dtac (real_sqrt_ge_abs1 RSN (2,order_less_le_trans)) 1);
    2.21 -by (auto_tac (claset(),simpset() addsimps [numeral_2_eq_2 RS sym]));
    2.22 +by (auto_tac ((claset(),simpset() addsimps [numeral_2_eq_2 RS sym]) addIffs [order_less_irrefl]));
    2.23  qed "CFinite_HFinite_Re";
    2.24  
    2.25  Goal "Abs_hcomplex(hcomplexrel ``{%n. X n}) : CFinite \
    2.26 @@ -888,7 +889,7 @@
    2.27  by (rtac ccontr 1 THEN dtac (linorder_not_less RS iffD1) 1);
    2.28  by (dtac order_less_le_trans 1 THEN assume_tac 1);
    2.29  by (dtac (real_sqrt_ge_abs2 RSN (2,order_less_le_trans)) 1);
    2.30 -by Auto_tac;
    2.31 +by (auto_tac (clasimpset() addIffs [order_less_irrefl]));
    2.32  qed "CFinite_HFinite_Im";
    2.33  
    2.34  Goal "[| Abs_hypreal(hyprel `` {%n. Re(X n)}) : HFinite; \
     3.1 --- a/src/HOL/HOL.thy	Tue Jan 27 09:44:14 2004 +0100
     3.2 +++ b/src/HOL/HOL.thy	Tue Jan 27 15:39:51 2004 +0100
     3.3 @@ -804,10 +804,13 @@
     3.4    apply (insert linorder_linear, blast)
     3.5    done
     3.6  
     3.7 +lemma linorder_le_cases [case_names le ge]:
     3.8 +    "((x::'a::linorder) \<le> y ==> P) ==> (y \<le> x ==> P) ==> P"
     3.9 +  by (insert linorder_linear, blast)
    3.10 +
    3.11  lemma linorder_cases [case_names less equal greater]:
    3.12      "((x::'a::linorder) < y ==> P) ==> (x = y ==> P) ==> (y < x ==> P) ==> P"
    3.13 -  apply (insert linorder_less_linear, blast)
    3.14 -  done
    3.15 +  by (insert linorder_less_linear, blast)
    3.16  
    3.17  lemma linorder_not_less: "!!x::'a::linorder. (~ x < y) = (y <= x)"
    3.18    apply (simp add: order_less_le)
     4.1 --- a/src/HOL/Hyperreal/HRealAbs.ML	Tue Jan 27 09:44:14 2004 +0100
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,138 +0,0 @@
     4.4 -(*  Title       : HRealAbs.ML
     4.5 -    Author      : Jacques D. Fleuriot
     4.6 -    Copyright   : 1998  University of Cambridge
     4.7 -    Description : Absolute value function for the hyperreals
     4.8 -                  Similar to RealAbs.thy
     4.9 -*) 
    4.10 -
    4.11 -(*------------------------------------------------------------
    4.12 -  absolute value on hyperreals as pointwise operation on 
    4.13 -  equivalence class representative
    4.14 - ------------------------------------------------------------*)
    4.15 -
    4.16 -Goalw [hrabs_def]
    4.17 -     "abs (number_of v :: hypreal) = \
    4.18 -\       (if neg (number_of v) then number_of (bin_minus v) \
    4.19 -\        else number_of v)";
    4.20 -by (Simp_tac 1); 
    4.21 -qed "hrabs_number_of";
    4.22 -Addsimps [hrabs_number_of];
    4.23 -
    4.24 -(*------------------------------------------------------------
    4.25 -   Properties of the absolute value function over the reals
    4.26 -   (adapted version of previously proved theorems about abs)
    4.27 - ------------------------------------------------------------*)
    4.28 -
    4.29 -Goal "(0::hypreal)<=x ==> abs x = x";
    4.30 -by (asm_simp_tac (simpset() addsimps [hrabs_def]) 1); 
    4.31 -qed "hrabs_eqI1";
    4.32 -
    4.33 -Goal "(0::hypreal)<x ==> abs x = x";
    4.34 -by (asm_simp_tac (simpset() addsimps [order_less_imp_le, hrabs_eqI1]) 1);
    4.35 -qed "hrabs_eqI2";
    4.36 -
    4.37 -Goal "x<(0::hypreal) ==> abs x = -x";
    4.38 -by (asm_simp_tac (simpset() addsimps [hypreal_le_def, hrabs_def]) 1); 
    4.39 -qed "hrabs_minus_eqI2";
    4.40 -
    4.41 -Goal "x<=(0::hypreal) ==> abs x = -x";
    4.42 -by (auto_tac (claset() addDs [order_antisym], simpset() addsimps [hrabs_def]));qed "hrabs_minus_eqI1";
    4.43 -
    4.44 -Addsimps [abs_mult];
    4.45 -
    4.46 -Goalw [hrabs_def] "[| abs x < r; abs y < s |] ==> abs(x+y) < r + (s::hypreal)";
    4.47 -by (asm_full_simp_tac (simpset() addsplits [split_if_asm]) 1); 
    4.48 -qed "hrabs_add_less";
    4.49 -
    4.50 -Goal "abs x < r ==> (0::hypreal) < r";
    4.51 -by (blast_tac (claset() addSIs [order_le_less_trans, abs_ge_zero]) 1);
    4.52 -qed "hrabs_less_gt_zero";
    4.53 -
    4.54 -Goal "abs x = (x::hypreal) | abs x = -x";
    4.55 -by (simp_tac (simpset() addsimps [hrabs_def]) 1); 
    4.56 -qed "hrabs_disj";
    4.57 -
    4.58 -Goal "abs x = (y::hypreal) ==> x = y | -x = y";
    4.59 -by (asm_full_simp_tac (simpset() addsimps [hrabs_def] 
    4.60 -                                 addsplits [split_if_asm]) 1); 
    4.61 -qed "hrabs_eq_disj";
    4.62 -
    4.63 -(* Needed in Geom.ML *)
    4.64 -Goal "(y::hypreal) + - x + (y + - z) = abs (x + - z) ==> y = z | x = y";
    4.65 -by (asm_full_simp_tac (simpset() addsimps [hrabs_def] 
    4.66 -                                 addsplits [split_if_asm]) 1); 
    4.67 -qed "hrabs_add_lemma_disj";
    4.68 -
    4.69 -(* Needed in Geom.ML?? *)
    4.70 -Goal "(x::hypreal) + - y + (z + - y) = abs (x + - z) ==> y = z | x = y";
    4.71 -by (asm_full_simp_tac (simpset() addsimps [hrabs_def] 
    4.72 -                                 addsplits [split_if_asm]) 1); 
    4.73 -qed "hrabs_add_lemma_disj2";
    4.74 -
    4.75 - 
    4.76 -(*----------------------------------------------------------
    4.77 -    Relating hrabs to abs through embedding of IR into IR*
    4.78 - ----------------------------------------------------------*)
    4.79 -Goalw [hypreal_of_real_def] 
    4.80 -    "abs (hypreal_of_real r) = hypreal_of_real (abs r)";
    4.81 -by (auto_tac (claset(), simpset() addsimps [hypreal_hrabs]));
    4.82 -qed "hypreal_of_real_hrabs";
    4.83 -
    4.84 -
    4.85 -(*----------------------------------------------------------------------------
    4.86 -             Embedding of the naturals in the hyperreals
    4.87 - ----------------------------------------------------------------------------*)
    4.88 -
    4.89 -Goal "hypreal_of_nat (m + n) = hypreal_of_nat m + hypreal_of_nat n";
    4.90 -by (simp_tac (simpset() addsimps [hypreal_of_nat_def]) 1);
    4.91 -qed "hypreal_of_nat_add";
    4.92 -Addsimps [hypreal_of_nat_add];
    4.93 -
    4.94 -Goal "hypreal_of_nat (m * n) = hypreal_of_nat m * hypreal_of_nat n";
    4.95 -by (simp_tac (simpset() addsimps [hypreal_of_nat_def]) 1);
    4.96 -qed "hypreal_of_nat_mult";
    4.97 -Addsimps [hypreal_of_nat_mult];
    4.98 -
    4.99 -Goalw [hypreal_of_nat_def] 
   4.100 -      "(n < m) = (hypreal_of_nat n < hypreal_of_nat m)";
   4.101 -by (auto_tac (claset() addIs [hypreal_add_less_mono1], simpset()));
   4.102 -qed "hypreal_of_nat_less_iff";
   4.103 -Addsimps [hypreal_of_nat_less_iff RS sym];
   4.104 -
   4.105 -(*------------------------------------------------------------*)
   4.106 -(* naturals embedded in hyperreals                            *)
   4.107 -(* is a hyperreal c.f. NS extension                           *)
   4.108 -(*------------------------------------------------------------*)
   4.109 -
   4.110 -Goalw [hypreal_of_nat_def, hypreal_of_real_def, real_of_nat_def] 
   4.111 -     "hypreal_of_nat  m = Abs_hypreal(hyprel``{%n. real m})";
   4.112 -by Auto_tac;
   4.113 -qed "hypreal_of_nat_iff";
   4.114 -
   4.115 -Goal "inj hypreal_of_nat";
   4.116 -by (simp_tac (simpset() addsimps [inj_on_def, hypreal_of_nat_def]) 1);
   4.117 -qed "inj_hypreal_of_nat";
   4.118 -
   4.119 -Goalw [hypreal_of_nat_def] 
   4.120 -     "hypreal_of_nat (Suc n) = hypreal_of_nat n + (1::hypreal)";
   4.121 -by (simp_tac (simpset() addsimps [real_of_nat_Suc]) 1);
   4.122 -qed "hypreal_of_nat_Suc";
   4.123 -
   4.124 -(*"neg" is used in rewrite rules for binary comparisons*)
   4.125 -Goal "hypreal_of_nat (number_of v :: nat) = \
   4.126 -\        (if neg (number_of v) then 0 \
   4.127 -\         else (number_of v :: hypreal))";
   4.128 -by (simp_tac (simpset() addsimps [hypreal_of_nat_def]) 1);
   4.129 -qed "hypreal_of_nat_number_of";
   4.130 -Addsimps [hypreal_of_nat_number_of];
   4.131 -
   4.132 -Goal "hypreal_of_nat 0 = 0";
   4.133 -by (simp_tac (simpset() delsimps [numeral_0_eq_0]
   4.134 -                        addsimps [numeral_0_eq_0 RS sym]) 1);
   4.135 -qed "hypreal_of_nat_zero";
   4.136 -Addsimps [hypreal_of_nat_zero];
   4.137 -
   4.138 -Goal "hypreal_of_nat 1 = 1";
   4.139 -by (simp_tac (simpset() addsimps [hypreal_of_nat_Suc]) 1); 
   4.140 -qed "hypreal_of_nat_one";
   4.141 -Addsimps [hypreal_of_nat_one];
     5.1 --- a/src/HOL/Hyperreal/HRealAbs.thy	Tue Jan 27 09:44:14 2004 +0100
     5.2 +++ b/src/HOL/Hyperreal/HRealAbs.thy	Tue Jan 27 15:39:51 2004 +0100
     5.3 @@ -4,11 +4,146 @@
     5.4      Description : Absolute value function for the hyperreals
     5.5  *) 
     5.6  
     5.7 -HRealAbs = HyperArith + RealArith + 
     5.8 +theory HRealAbs = HyperArith:
     5.9  
    5.10  constdefs
    5.11 -  
    5.12 -  hypreal_of_nat :: nat => hypreal                   
    5.13 +
    5.14 +  hypreal_of_nat :: "nat => hypreal"
    5.15    "hypreal_of_nat (n::nat) == hypreal_of_real (real n)"
    5.16  
    5.17 -end
    5.18 \ No newline at end of file
    5.19 +
    5.20 +lemma hrabs_number_of [simp]:
    5.21 +     "abs (number_of v :: hypreal) =
    5.22 +        (if neg (number_of v) then number_of (bin_minus v)
    5.23 +         else number_of v)"
    5.24 +by (simp add: hrabs_def)
    5.25 +
    5.26 +
    5.27 +(*------------------------------------------------------------
    5.28 +   Properties of the absolute value function over the reals
    5.29 +   (adapted version of previously proved theorems about abs)
    5.30 + ------------------------------------------------------------*)
    5.31 +
    5.32 +lemma hrabs_eqI1: "(0::hypreal)<=x ==> abs x = x"
    5.33 +by (simp add: hrabs_def)
    5.34 +
    5.35 +lemma hrabs_eqI2: "(0::hypreal)<x ==> abs x = x"
    5.36 +by (simp add: order_less_imp_le hrabs_eqI1)
    5.37 +
    5.38 +lemma hrabs_minus_eqI2: "x<(0::hypreal) ==> abs x = -x"
    5.39 +by (simp add: hypreal_le_def hrabs_def)
    5.40 +
    5.41 +lemma hrabs_minus_eqI1: "x<=(0::hypreal) ==> abs x = -x"
    5.42 +by (auto dest: order_antisym simp add: hrabs_def)
    5.43 +
    5.44 +declare abs_mult [simp]
    5.45 +
    5.46 +lemma hrabs_add_less: "[| abs x < r; abs y < s |] ==> abs(x+y) < r + (s::hypreal)"
    5.47 +apply (unfold hrabs_def)
    5.48 +apply (simp split add: split_if_asm)
    5.49 +done
    5.50 +
    5.51 +lemma hrabs_less_gt_zero: "abs x < r ==> (0::hypreal) < r"
    5.52 +by (blast intro!: order_le_less_trans abs_ge_zero)
    5.53 +
    5.54 +lemma hrabs_disj: "abs x = (x::hypreal) | abs x = -x"
    5.55 +by (simp add: hrabs_def)
    5.56 +
    5.57 +lemma hrabs_eq_disj: "abs x = (y::hypreal) ==> x = y | -x = y"
    5.58 +by (simp add: hrabs_def split add: split_if_asm)
    5.59 +
    5.60 +(* Needed in Geom.ML *)
    5.61 +lemma hrabs_add_lemma_disj: "(y::hypreal) + - x + (y + - z) = abs (x + - z) ==> y = z | x = y"
    5.62 +by (simp add: hrabs_def split add: split_if_asm)
    5.63 +
    5.64 +(* Needed in Geom.ML?? *)
    5.65 +lemma hrabs_add_lemma_disj2: "(x::hypreal) + - y + (z + - y) = abs (x + - z) ==> y = z | x = y"
    5.66 +by (simp add: hrabs_def split add: split_if_asm)
    5.67 +
    5.68 +
    5.69 +(*----------------------------------------------------------
    5.70 +    Relating hrabs to abs through embedding of IR into IR*
    5.71 + ----------------------------------------------------------*)
    5.72 +lemma hypreal_of_real_hrabs:
    5.73 +    "abs (hypreal_of_real r) = hypreal_of_real (abs r)"
    5.74 +apply (unfold hypreal_of_real_def)
    5.75 +apply (auto simp add: hypreal_hrabs)
    5.76 +done
    5.77 +
    5.78 +
    5.79 +(*----------------------------------------------------------------------------
    5.80 +             Embedding of the naturals in the hyperreals
    5.81 + ----------------------------------------------------------------------------*)
    5.82 +
    5.83 +lemma hypreal_of_nat_add [simp]:
    5.84 +     "hypreal_of_nat (m + n) = hypreal_of_nat m + hypreal_of_nat n"
    5.85 +by (simp add: hypreal_of_nat_def)
    5.86 +
    5.87 +lemma hypreal_of_nat_mult: "hypreal_of_nat (m * n) = hypreal_of_nat m * hypreal_of_nat n"
    5.88 +by (simp add: hypreal_of_nat_def)
    5.89 +declare hypreal_of_nat_mult [simp]
    5.90 +
    5.91 +lemma hypreal_of_nat_less_iff:
    5.92 +      "(n < m) = (hypreal_of_nat n < hypreal_of_nat m)"
    5.93 +apply (simp add: hypreal_of_nat_def)
    5.94 +done
    5.95 +declare hypreal_of_nat_less_iff [symmetric, simp]
    5.96 +
    5.97 +(*------------------------------------------------------------*)
    5.98 +(* naturals embedded in hyperreals                            *)
    5.99 +(* is a hyperreal c.f. NS extension                           *)
   5.100 +(*------------------------------------------------------------*)
   5.101 +
   5.102 +lemma hypreal_of_nat_iff:
   5.103 +     "hypreal_of_nat  m = Abs_hypreal(hyprel``{%n. real m})"
   5.104 +by (simp add: hypreal_of_nat_def hypreal_of_real_def real_of_nat_def)
   5.105 +
   5.106 +lemma inj_hypreal_of_nat: "inj hypreal_of_nat"
   5.107 +by (simp add: inj_on_def hypreal_of_nat_def)
   5.108 +
   5.109 +lemma hypreal_of_nat_Suc:
   5.110 +     "hypreal_of_nat (Suc n) = hypreal_of_nat n + (1::hypreal)"
   5.111 +by (simp add: hypreal_of_nat_def real_of_nat_Suc)
   5.112 +
   5.113 +(*"neg" is used in rewrite rules for binary comparisons*)
   5.114 +lemma hypreal_of_nat_number_of [simp]:
   5.115 +     "hypreal_of_nat (number_of v :: nat) =
   5.116 +         (if neg (number_of v) then 0
   5.117 +          else (number_of v :: hypreal))"
   5.118 +by (simp add: hypreal_of_nat_def)
   5.119 +
   5.120 +lemma hypreal_of_nat_zero [simp]: "hypreal_of_nat 0 = 0"
   5.121 +by (simp del: numeral_0_eq_0 add: numeral_0_eq_0 [symmetric])
   5.122 +
   5.123 +lemma hypreal_of_nat_one [simp]: "hypreal_of_nat 1 = 1"
   5.124 +by (simp add: hypreal_of_nat_Suc)
   5.125 +
   5.126 +
   5.127 +ML
   5.128 +{*
   5.129 +val hypreal_of_nat_def = thm"hypreal_of_nat_def";
   5.130 +
   5.131 +val hrabs_number_of = thm "hrabs_number_of";
   5.132 +val hrabs_eqI1 = thm "hrabs_eqI1";
   5.133 +val hrabs_eqI2 = thm "hrabs_eqI2";
   5.134 +val hrabs_minus_eqI2 = thm "hrabs_minus_eqI2";
   5.135 +val hrabs_minus_eqI1 = thm "hrabs_minus_eqI1";
   5.136 +val hrabs_add_less = thm "hrabs_add_less";
   5.137 +val hrabs_less_gt_zero = thm "hrabs_less_gt_zero";
   5.138 +val hrabs_disj = thm "hrabs_disj";
   5.139 +val hrabs_eq_disj = thm "hrabs_eq_disj";
   5.140 +val hrabs_add_lemma_disj = thm "hrabs_add_lemma_disj";
   5.141 +val hrabs_add_lemma_disj2 = thm "hrabs_add_lemma_disj2";
   5.142 +val hypreal_of_real_hrabs = thm "hypreal_of_real_hrabs";
   5.143 +val hypreal_of_nat_add = thm "hypreal_of_nat_add";
   5.144 +val hypreal_of_nat_mult = thm "hypreal_of_nat_mult";
   5.145 +val hypreal_of_nat_less_iff = thm "hypreal_of_nat_less_iff";
   5.146 +val hypreal_of_nat_iff = thm "hypreal_of_nat_iff";
   5.147 +val inj_hypreal_of_nat = thm "inj_hypreal_of_nat";
   5.148 +val hypreal_of_nat_Suc = thm "hypreal_of_nat_Suc";
   5.149 +val hypreal_of_nat_number_of = thm "hypreal_of_nat_number_of";
   5.150 +val hypreal_of_nat_zero = thm "hypreal_of_nat_zero";
   5.151 +val hypreal_of_nat_one = thm "hypreal_of_nat_one";
   5.152 +*}
   5.153 +
   5.154 +end
     6.1 --- a/src/HOL/Hyperreal/HyperDef.thy	Tue Jan 27 09:44:14 2004 +0100
     6.2 +++ b/src/HOL/Hyperreal/HyperDef.thy	Tue Jan 27 15:39:51 2004 +0100
     6.3 @@ -82,7 +82,7 @@
     6.4                                 Y \<in> Rep_hypreal(Q) &
     6.5                                 {n::nat. X n < Y n} \<in> FreeUltrafilterNat"
     6.6    hypreal_le_def:
     6.7 -  "P <= (Q::hypreal) == ~(Q < P)"
     6.8 +  "P \<le> (Q::hypreal) == ~(Q < P)"
     6.9  
    6.10    hrabs_def:  "abs (r::hypreal) == (if 0 \<le> r then r else -r)"
    6.11  
    6.12 @@ -149,7 +149,7 @@
    6.13  done
    6.14  
    6.15  lemma FreeUltrafilterNat_subset:
    6.16 -     "[| X: FreeUltrafilterNat;  X <= Y |]  
    6.17 +     "[| X: FreeUltrafilterNat;  X \<subseteq> Y |]  
    6.18        ==> Y \<in> FreeUltrafilterNat"
    6.19  apply (cut_tac FreeUltrafilterNat_mem)
    6.20  apply (blast dest: FreeUltrafilter_Ultrafilter Ultrafilter_Filter mem_FiltersetD2)
    6.21 @@ -227,21 +227,20 @@
    6.22  
    6.23  text{*Proving that @{term hyprel} is an equivalence relation*}
    6.24  
    6.25 -lemma hyprel_iff: "((X,Y): hyprel) = ({n. X n = Y n}: FreeUltrafilterNat)"
    6.26 +lemma hyprel_iff: "((X,Y) \<in> hyprel) = ({n. X n = Y n}: FreeUltrafilterNat)"
    6.27  by (unfold hyprel_def, fast)
    6.28  
    6.29 -lemma hyprel_refl: "(x,x): hyprel"
    6.30 +lemma hyprel_refl: "(x,x) \<in> hyprel"
    6.31  apply (unfold hyprel_def)
    6.32  apply (auto simp add: FreeUltrafilterNat_Nat_set)
    6.33  done
    6.34  
    6.35 -lemma hyprel_sym [rule_format (no_asm)]: "(x,y): hyprel --> (y,x):hyprel"
    6.36 +lemma hyprel_sym [rule_format (no_asm)]: "(x,y) \<in> hyprel --> (y,x) \<in> hyprel"
    6.37  by (simp add: hyprel_def eq_commute)
    6.38  
    6.39  lemma hyprel_trans: 
    6.40 -      "[|(x,y): hyprel; (y,z):hyprel|] ==> (x,z):hyprel"
    6.41 -apply (unfold hyprel_def, auto, ultra)
    6.42 -done
    6.43 +      "[|(x,y) \<in> hyprel; (y,z) \<in> hyprel|] ==> (x,z) \<in> hyprel"
    6.44 +by (unfold hyprel_def, auto, ultra)
    6.45  
    6.46  lemma equiv_hyprel: "equiv UNIV hyprel"
    6.47  apply (simp add: equiv_def refl_def sym_def trans_def hyprel_refl)
    6.48 @@ -536,7 +535,7 @@
    6.49  
    6.50  subsection{*Trichotomy: the hyperreals are Linearly Ordered*}
    6.51  
    6.52 -lemma lemma_hyprel_0_mem: "\<exists>x. x: hyprel `` {%n. 0}"
    6.53 +lemma lemma_hyprel_0_mem: "\<exists>x. x \<in> hyprel `` {%n. 0}"
    6.54  apply (unfold hyprel_def)
    6.55  apply (rule_tac x = "%n. 0" in exI, safe)
    6.56  apply (auto intro!: FreeUltrafilterNat_Nat_set)
    6.57 @@ -588,64 +587,57 @@
    6.58  lemma hypreal_neq_iff: "((w::hypreal) \<noteq> z) = (w<z | z<w)"
    6.59  by (cut_tac hypreal_linear, blast)
    6.60  
    6.61 -lemma hypreal_linear_less2: "!!(x::hypreal). [| x < y ==> P;  x = y ==> P;  
    6.62 -           y < x ==> P |] ==> P"
    6.63 -apply (cut_tac x = x and y = y in hypreal_linear, auto)
    6.64 -done
    6.65 -
    6.66  
    6.67  subsection{*Properties of The @{text "\<le>"} Relation*}
    6.68  
    6.69  lemma hypreal_le: 
    6.70 -      "(Abs_hypreal(hyprel``{%n. X n}) <=  
    6.71 -            Abs_hypreal(hyprel``{%n. Y n})) =  
    6.72 -       ({n. X n <= Y n} \<in> FreeUltrafilterNat)"
    6.73 -apply (unfold hypreal_le_def real_le_def)
    6.74 -apply (auto simp add: hypreal_less)
    6.75 +      "(Abs_hypreal(hyprel``{%n. X n}) \<le> Abs_hypreal(hyprel``{%n. Y n})) =  
    6.76 +       ({n. X n \<le> Y n} \<in> FreeUltrafilterNat)"
    6.77 +apply (auto simp add: hypreal_less hypreal_le_def linorder_not_less[symmetric])
    6.78  apply (ultra+)
    6.79  done
    6.80  
    6.81 -lemma hypreal_le_imp_less_or_eq: "!!(x::hypreal). x <= y ==> x < y | x = y"
    6.82 +lemma hypreal_le_imp_less_or_eq: "!!(x::hypreal). x \<le> y ==> x < y | x = y"
    6.83  apply (unfold hypreal_le_def)
    6.84  apply (cut_tac hypreal_linear)
    6.85  apply (fast elim: hypreal_less_irrefl hypreal_less_asym)
    6.86  done
    6.87  
    6.88 -lemma hypreal_less_or_eq_imp_le: "z<w | z=w ==> z <=(w::hypreal)"
    6.89 +lemma hypreal_less_or_eq_imp_le: "z<w | z=w ==> z \<le>(w::hypreal)"
    6.90  apply (unfold hypreal_le_def)
    6.91  apply (cut_tac hypreal_linear)
    6.92  apply (fast elim: hypreal_less_irrefl hypreal_less_asym)
    6.93  done
    6.94  
    6.95 -lemma hypreal_le_eq_less_or_eq: "(x <= (y::hypreal)) = (x < y | x=y)"
    6.96 +lemma hypreal_le_eq_less_or_eq: "(x \<le> (y::hypreal)) = (x < y | x=y)"
    6.97  by (blast intro!: hypreal_less_or_eq_imp_le dest: hypreal_le_imp_less_or_eq) 
    6.98  
    6.99  lemmas hypreal_le_less = hypreal_le_eq_less_or_eq
   6.100  
   6.101 -lemma hypreal_le_refl: "w <= (w::hypreal)"
   6.102 +lemma hypreal_le_refl: "w \<le> (w::hypreal)"
   6.103  by (simp add: hypreal_le_eq_less_or_eq)
   6.104  
   6.105  (* Axiom 'linorder_linear' of class 'linorder': *)
   6.106 -lemma hypreal_le_linear: "(z::hypreal) <= w | w <= z"
   6.107 +lemma hypreal_le_linear: "(z::hypreal) \<le> w | w \<le> z"
   6.108  apply (simp add: hypreal_le_less)
   6.109  apply (cut_tac hypreal_linear, blast)
   6.110  done
   6.111  
   6.112 -lemma hypreal_le_trans: "[| i <= j; j <= k |] ==> i <= (k::hypreal)"
   6.113 +lemma hypreal_le_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::hypreal)"
   6.114  apply (drule hypreal_le_imp_less_or_eq) 
   6.115  apply (drule hypreal_le_imp_less_or_eq) 
   6.116  apply (rule hypreal_less_or_eq_imp_le) 
   6.117  apply (blast intro: hypreal_less_trans) 
   6.118  done
   6.119  
   6.120 -lemma hypreal_le_anti_sym: "[| z <= w; w <= z |] ==> z = (w::hypreal)"
   6.121 +lemma hypreal_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::hypreal)"
   6.122  apply (drule hypreal_le_imp_less_or_eq) 
   6.123  apply (drule hypreal_le_imp_less_or_eq) 
   6.124  apply (fast elim: hypreal_less_irrefl hypreal_less_asym)
   6.125  done
   6.126  
   6.127  (* Axiom 'order_less_le' of class 'order': *)
   6.128 -lemma hypreal_less_le: "((w::hypreal) < z) = (w <= z & w \<noteq> z)"
   6.129 +lemma hypreal_less_le: "((w::hypreal) < z) = (w \<le> z & w \<noteq> z)"
   6.130  apply (simp add: hypreal_le_def hypreal_neq_iff)
   6.131  apply (blast intro: hypreal_less_asym)
   6.132  done
   6.133 @@ -794,9 +786,8 @@
   6.134  done
   6.135  
   6.136  lemma hypreal_of_real_le_iff [simp]: 
   6.137 -     "(hypreal_of_real z1 <= hypreal_of_real z2) = (z1 <= z2)"
   6.138 -apply (unfold hypreal_le_def real_le_def, auto)
   6.139 -done
   6.140 +     "(hypreal_of_real z1 \<le> hypreal_of_real z2) = (z1 \<le> z2)"
   6.141 +by (force simp add: hypreal_less hypreal_le_def linorder_not_less[symmetric])
   6.142  
   6.143  lemma hypreal_of_real_eq_iff [simp]:
   6.144       "(hypreal_of_real z1 = hypreal_of_real z2) = (z1 = z2)"
   6.145 @@ -952,8 +943,6 @@
   6.146  val hypreal_eq_minus_iff3 = thm "hypreal_eq_minus_iff3";
   6.147  val hypreal_not_eq_minus_iff = thm "hypreal_not_eq_minus_iff";
   6.148  val hypreal_linear = thm "hypreal_linear";
   6.149 -val hypreal_neq_iff = thm "hypreal_neq_iff";
   6.150 -val hypreal_linear_less2 = thm "hypreal_linear_less2";
   6.151  val hypreal_le = thm "hypreal_le";
   6.152  val hypreal_le_imp_less_or_eq = thm "hypreal_le_imp_less_or_eq";
   6.153  val hypreal_le_eq_less_or_eq = thm "hypreal_le_eq_less_or_eq";
     7.1 --- a/src/HOL/Hyperreal/IntFloor.ML	Tue Jan 27 09:44:14 2004 +0100
     7.2 +++ b/src/HOL/Hyperreal/IntFloor.ML	Tue Jan 27 15:39:51 2004 +0100
     7.3 @@ -20,15 +20,13 @@
     7.4  qed "number_of_less_real_of_int_iff2";
     7.5  Addsimps [number_of_less_real_of_int_iff2];
     7.6  
     7.7 -Goalw [real_le_def,zle_def] 
     7.8 -   "((number_of n) <= real (m::int)) = (number_of n <= m)";
     7.9 -by Auto_tac;
    7.10 +Goal "((number_of n) <= real (m::int)) = (number_of n <= m)";
    7.11 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
    7.12  qed "number_of_le_real_of_int_iff";
    7.13  Addsimps [number_of_le_real_of_int_iff];
    7.14  
    7.15 -Goalw [real_le_def,zle_def] 
    7.16 -   "(real (m::int) <= (number_of n)) = (m <= number_of n)";
    7.17 -by Auto_tac;
    7.18 +Goal "(real (m::int) <= (number_of n)) = (m <= number_of n)";
    7.19 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
    7.20  qed "number_of_le_real_of_int_iff2";
    7.21  Addsimps [number_of_le_real_of_int_iff2];
    7.22  
     8.1 --- a/src/HOL/Hyperreal/Integration.ML	Tue Jan 27 09:44:14 2004 +0100
     8.2 +++ b/src/HOL/Hyperreal/Integration.ML	Tue Jan 27 15:39:51 2004 +0100
     8.3 @@ -20,7 +20,7 @@
     8.4  
     8.5  Goalw [partition_def] 
     8.6     "a <= b ==> partition(a,b)(%n. if n = 0 then a else b)";
     8.7 -by (auto_tac (claset(),simpset() addsimps [real_le_less]));
     8.8 +by (auto_tac (claset(),simpset() addsimps [order_le_less]));
     8.9  qed "partition_single";
    8.10  Addsimps [partition_single];
    8.11  
    8.12 @@ -79,7 +79,7 @@
    8.13  by (ALLGOALS(dtac (ARITH_PROVE "Suc m <= n ==> m < n")));
    8.14  by (ALLGOALS(dtac less_le_trans));
    8.15  by (assume_tac 1 THEN assume_tac 2);
    8.16 -by (ALLGOALS(blast_tac (claset() addIs [real_less_trans])));
    8.17 +by (ALLGOALS(blast_tac (claset() addIs [order_less_trans])));
    8.18  qed_spec_mp "lemma_partition_lt_gen";
    8.19  
    8.20  Goal "m < n ==> EX d. n = m + Suc d";
    8.21 @@ -97,7 +97,7 @@
    8.22  by (Blast_tac 1);
    8.23  by (blast_tac (claset() addSDs [leI] addDs 
    8.24      [(ARITH_PROVE "m <= n ==> m <= Suc n"),
    8.25 -    le_less_trans,real_less_trans]) 1);
    8.26 +    le_less_trans,order_less_trans]) 1);
    8.27  qed_spec_mp "partition_lt";
    8.28  
    8.29  Goal "partition(a,b) D ==> a <= b";
    8.30 @@ -587,7 +587,7 @@
    8.31  by (auto_tac (claset() addSIs [Least_equality RS sym,partition_rhs],simpset()));
    8.32  by (rtac ccontr 1);
    8.33  by (dtac partition_ub_lt 1);
    8.34 -by Auto_tac;
    8.35 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
    8.36  qed "partition_psize_Least";
    8.37  
    8.38  Goal "partition (a, c) D ==> ~ (EX n. c < D(n))";
     9.1 --- a/src/HOL/Hyperreal/Lim.ML	Tue Jan 27 09:44:14 2004 +0100
     9.2 +++ b/src/HOL/Hyperreal/Lim.ML	Tue Jan 27 15:39:51 2004 +0100
     9.3 @@ -32,8 +32,7 @@
     9.4  by (REPEAT(dres_inst_tac [("x","r/2")] spec 1));
     9.5  by (Asm_full_simp_tac 1);
     9.6  by (Clarify_tac 1);
     9.7 -by (res_inst_tac [("R1.0","s"),("R2.0","sa")] 
     9.8 -    real_linear_less2 1);
     9.9 +by (res_inst_tac [("x","s"),("y","sa")] linorder_cases 1);
    9.10  by (res_inst_tac [("x","s")] exI 1);
    9.11  by (res_inst_tac [("x","sa")] exI 2);
    9.12  by (res_inst_tac [("x","sa")] exI 3);
    9.13 @@ -75,7 +74,7 @@
    9.14     Limit not zero
    9.15   --------------------------*)
    9.16  Goalw [LIM_def] "k \\<noteq> 0 ==> ~ ((%x. k) -- x --> 0)";
    9.17 -by (res_inst_tac [("R1.0","k"),("R2.0","0")] real_linear_less2 1);
    9.18 +by (res_inst_tac [("x","k"),("y","0")] linorder_cases 1);
    9.19  by (auto_tac (claset(), simpset() addsimps [real_abs_def]));
    9.20  by (res_inst_tac [("x","-k")] exI 1);
    9.21  by (res_inst_tac [("x","k")] exI 2);
    9.22 @@ -116,8 +115,8 @@
    9.23  by (cut_facts_tac [real_zero_less_one] 1);
    9.24  by (asm_full_simp_tac (simpset() addsimps [abs_mult]) 1);
    9.25  by (Clarify_tac 1);
    9.26 -by (res_inst_tac [("R1.0","s"),("R2.0","sa")] 
    9.27 -    real_linear_less2 1);
    9.28 +by (res_inst_tac [("x","s"),("y","sa")] 
    9.29 +    linorder_cases 1);
    9.30  by (res_inst_tac [("x","s")] exI 1);
    9.31  by (res_inst_tac [("x","sa")] exI 2);
    9.32  by (res_inst_tac [("x","sa")] exI 3);
    9.33 @@ -216,7 +215,7 @@
    9.34  by (asm_full_simp_tac
    9.35      (simpset() addsimps [Infinitesimal_FreeUltrafilterNat_iff]) 1);
    9.36  by (EVERY1[Step_tac, rtac ccontr, Asm_full_simp_tac]);
    9.37 -by (fold_tac [real_le_def]);
    9.38 +by (asm_full_simp_tac (simpset() addsimps [linorder_not_less]) 1);
    9.39  by (dtac lemma_skolemize_LIM2 1);
    9.40  by Safe_tac;
    9.41  by (dres_inst_tac [("x","Abs_hypreal(hyprel``{X})")] spec 1);
    9.42 @@ -722,7 +721,7 @@
    9.43  by (asm_full_simp_tac (simpset() addsimps 
    9.44                         [Infinitesimal_FreeUltrafilterNat_iff]) 1);
    9.45  by (EVERY1[Step_tac, rtac ccontr, Asm_full_simp_tac]);
    9.46 -by (fold_tac [real_le_def]);
    9.47 +by (asm_full_simp_tac (simpset() addsimps [linorder_not_less]) 1);
    9.48  by (dtac lemma_skolemize_LIM2u 1);
    9.49  by Safe_tac;
    9.50  by (dres_inst_tac [("x","Abs_hypreal(hyprel``{X})")] spec 1);
    9.51 @@ -1904,7 +1903,7 @@
    9.52  Goal "[| DERIV f x :> l; \
    9.53  \        \\<exists>d. 0 < d & (\\<forall>y. abs(x - y) < d --> f(y) \\<le> f(x)) |] \
    9.54  \     ==> l = 0";
    9.55 -by (res_inst_tac [("R1.0","l"),("R2.0","0")] real_linear_less2 1);
    9.56 +by (res_inst_tac [("x","l"),("y","0")] linorder_cases 1);
    9.57  by Safe_tac;
    9.58  by (dtac DERIV_left_dec 1);
    9.59  by (dtac DERIV_left_inc 3);
    9.60 @@ -2113,13 +2112,13 @@
    9.61  qed "DERIV_isconst2";
    9.62  
    9.63  Goal "\\<forall>x. DERIV f x :> 0 ==> f(x) = f(y)";
    9.64 -by (res_inst_tac [("R1.0","x"),("R2.0","y")] real_linear_less2 1);
    9.65 +by (res_inst_tac [("x","x"),("y","y")] linorder_cases 1);
    9.66  by (rtac sym 1);
    9.67  by (auto_tac (claset() addIs [DERIV_isCont,DERIV_isconst_end],simpset()));
    9.68  qed "DERIV_isconst_all";
    9.69  
    9.70  Goal "[|a \\<noteq> b; \\<forall>x. DERIV f x :> k |] ==> (f(b) - f(a)) = (b - a) * k";
    9.71 -by (res_inst_tac [("R1.0","a"),("R2.0","b")] real_linear_less2 1);
    9.72 +by (res_inst_tac [("x","a"),("y","b")] linorder_cases 1);
    9.73  by Auto_tac;
    9.74  by (ALLGOALS(dres_inst_tac [("f","f")] MVT));
    9.75  by (auto_tac (claset() addDs [DERIV_isCont,DERIV_unique],simpset() addsimps 
    9.76 @@ -2148,7 +2147,7 @@
    9.77  (* Gallileo's "trick": average velocity = av. of end velocities *)
    9.78  Goal "[|a \\<noteq> (b::real); \\<forall>x. DERIV v x :> k|] \
    9.79  \     ==> v((a + b)/2) = (v a + v b)/2";
    9.80 -by (res_inst_tac [("R1.0","a"),("R2.0","b")] real_linear_less2 1);
    9.81 +by (res_inst_tac [("x","a"),("y","b")] linorder_cases 1);
    9.82  by Safe_tac;
    9.83  by (ftac DERIV_const_ratio_const2 1 THEN assume_tac 1);
    9.84  by (ftac DERIV_const_ratio_const2 2 THEN assume_tac 2);
    10.1 --- a/src/HOL/Hyperreal/Log.ML	Tue Jan 27 09:44:14 2004 +0100
    10.2 +++ b/src/HOL/Hyperreal/Log.ML	Tue Jan 27 15:39:51 2004 +0100
    10.3 @@ -81,8 +81,8 @@
    10.4  qed "powr_less_cancel_iff";
    10.5  Addsimps [powr_less_cancel_iff];
    10.6  
    10.7 -Goalw [real_le_def] "1 < x ==> (x powr a <= x powr b) = (a <= b)";
    10.8 -by (Auto_tac);
    10.9 +Goal "1 < x ==> (x powr a <= x powr b) = (a <= b)";
   10.10 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
   10.11  qed "powr_le_cancel_iff";
   10.12  Addsimps [powr_le_cancel_iff];
   10.13  
   10.14 @@ -156,7 +156,7 @@
   10.15  Addsimps [log_less_cancel_iff];
   10.16  
   10.17  Goal "[| 1 < a; 0 < x; 0 < y |] ==> (log a x <= log a y) = (x <= y)";
   10.18 -by (auto_tac (claset(),simpset() addsimps [real_le_def]));
   10.19 +by (auto_tac (claset(),simpset() addsimps [linorder_not_less RS sym]));
   10.20  qed "log_le_cancel_iff";
   10.21  Addsimps [log_le_cancel_iff];
   10.22  
    11.1 --- a/src/HOL/Hyperreal/MacLaurin.ML	Tue Jan 27 09:44:14 2004 +0100
    11.2 +++ b/src/HOL/Hyperreal/MacLaurin.ML	Tue Jan 27 15:39:51 2004 +0100
    11.3 @@ -63,8 +63,8 @@
    11.4  by (asm_simp_tac (HOL_ss addsimps 
    11.5      [CLAIM "(a::real) * (b * (c * d)) = (d * a) * (b * c)"]
    11.6       delsimps [realpow_Suc]) 2);
    11.7 -by (stac real_mult_inv_left 2);
    11.8 -by (stac real_mult_inv_left 3);
    11.9 +by (stac left_inverse 2);
   11.10 +by (stac left_inverse 3);
   11.11  by (rtac (real_not_refl2 RS not_sym) 2);
   11.12  by (etac zero_less_power 2);
   11.13  by (rtac real_of_nat_fact_not_zero 2);
   11.14 @@ -345,7 +345,7 @@
   11.15  \     |] ==> EX t. 0 < abs t & abs t < abs x & \
   11.16  \              f x = sumr 0 n (%m. (diff m 0 / real (fact m)) * x ^ m) + \
   11.17  \                    (diff n t / real (fact n)) * x ^ n";
   11.18 -by (res_inst_tac [("R1.0","x"),("R2.0","0")] real_linear_less2 1);
   11.19 +by (res_inst_tac [("x","x"),("y","0")] linorder_cases 1);
   11.20  by (Blast_tac 2);
   11.21  by (dtac Maclaurin_minus 1);
   11.22  by (dtac Maclaurin 5);
    12.1 --- a/src/HOL/Hyperreal/NSA.ML	Tue Jan 27 09:44:14 2004 +0100
    12.2 +++ b/src/HOL/Hyperreal/NSA.ML	Tue Jan 27 15:39:51 2004 +0100
    12.3 @@ -1088,7 +1088,7 @@
    12.4  Goal "(x::hypreal): Reals ==> isLub Reals {s. s: Reals & s < x} x";
    12.5  by (auto_tac (claset() addSIs [isLubI2,lemma_SReal_ub,setgeI], simpset()));
    12.6  by (ftac isUbD2a 1);
    12.7 -by (res_inst_tac [("x","x"),("y","y")] hypreal_linear_less2 1);
    12.8 +by (res_inst_tac [("x","x"),("y","y")] linorder_cases 1);
    12.9  by (auto_tac (claset() addSIs [order_less_imp_le], simpset()));
   12.10  by (EVERY1[dtac SReal_dense, assume_tac, assume_tac, Step_tac]);
   12.11  by (dres_inst_tac [("y","r")] isUbD 1);
   12.12 @@ -1980,7 +1980,7 @@
   12.13  qed "lemma_Int_HI";
   12.14  
   12.15  Goal "{n. u < abs (X n)} Int {n. abs (X n) < (u::real)} = {}";
   12.16 -by (auto_tac (claset() addIs [real_less_asym], simpset()));
   12.17 +by (auto_tac (claset() addIs [order_less_asym], simpset()));
   12.18  qed "lemma_Int_HIa";
   12.19  
   12.20  Goal "EX X: Rep_hypreal x. ALL u. \
    13.1 --- a/src/HOL/Hyperreal/NthRoot.thy	Tue Jan 27 09:44:14 2004 +0100
    13.2 +++ b/src/HOL/Hyperreal/NthRoot.thy	Tue Jan 27 15:39:51 2004 +0100
    13.3 @@ -45,7 +45,8 @@
    13.4  apply (assumption+)
    13.5  apply (drule real_le_trans , assumption)
    13.6  apply (drule_tac y = "y ^ n" in order_less_le_trans)
    13.7 -apply (assumption , erule real_less_irrefl)
    13.8 +apply (assumption)
    13.9 +apply (simp); 
   13.10  apply (drule_tac n = "n" in zero_less_one [THEN realpow_less])
   13.11  apply auto
   13.12  done
   13.13 @@ -53,8 +54,8 @@
   13.14  lemma nth_realpow_isLub_ex:
   13.15       "[| (0::real) < a; 0 < n |]  
   13.16        ==> \<exists>u. isLub (UNIV::real set) {x. x ^ n <= a & 0 < x} u"
   13.17 -apply (blast intro: lemma_nth_realpow_isUb_ex lemma_nth_realpow_non_empty reals_complete)
   13.18 -done
   13.19 +by (blast intro: lemma_nth_realpow_isUb_ex lemma_nth_realpow_non_empty reals_complete)
   13.20 +
   13.21   
   13.22  subsection{*First Half -- Lemmas First*}
   13.23  
   13.24 @@ -62,7 +63,7 @@
   13.25       "isLub (UNIV::real set) {x. x ^ n <= a & (0::real) < x} u  
   13.26             ==> u + inverse(real (Suc k)) ~: {x. x ^ n <= a & 0 < x}"
   13.27  apply (safe , drule isLubD2 , blast)
   13.28 -apply (simp add: real_le_def)
   13.29 +apply (simp add: linorder_not_less [symmetric])
   13.30  done
   13.31  
   13.32  lemma lemma_nth_realpow_isLub_gt_zero:
   13.33 @@ -78,8 +79,8 @@
   13.34           0 < a; 0 < n |] ==> ALL k. a <= (u + inverse(real (Suc k))) ^ n"
   13.35  apply (safe)
   13.36  apply (frule lemma_nth_realpow_seq , safe)
   13.37 -apply (auto elim: real_less_asym simp add: real_le_def)
   13.38 -apply (simp add: real_le_def [symmetric])
   13.39 +apply (auto elim: order_less_asym simp add: linorder_not_less [symmetric])
   13.40 +apply (simp add: linorder_not_less)
   13.41  apply (rule order_less_trans [of _ 0])
   13.42  apply (auto intro: lemma_nth_realpow_isLub_gt_zero)
   13.43  done
   13.44 @@ -103,14 +104,14 @@
   13.45  apply (drule isLub_le_isUb)
   13.46  apply assumption
   13.47  apply (drule order_less_le_trans)
   13.48 -apply (auto simp add: real_less_not_refl)
   13.49 +apply (auto)
   13.50  done
   13.51  
   13.52  lemma not_isUb_less_ex:
   13.53       "~ isUb (UNIV::real set) S u ==> \<exists>x \<in> S. u < x"
   13.54  apply (rule ccontr , erule swap)
   13.55  apply (rule setleI [THEN isUbI])
   13.56 -apply (auto simp add: real_le_def)
   13.57 +apply (auto simp add: linorder_not_less [symmetric])
   13.58  done
   13.59  
   13.60  lemma real_mult_less_self: "0 < r ==> r * (1 + -inverse(real (Suc n))) < r"
   13.61 @@ -174,7 +175,7 @@
   13.62  apply auto
   13.63  apply (drule_tac x = "r" in realpow_less)
   13.64  apply (drule_tac [4] x = "y" in realpow_less)
   13.65 -apply (auto simp add: real_less_not_refl)
   13.66 +apply (auto)
   13.67  done
   13.68  
   13.69  ML
    14.1 --- a/src/HOL/Hyperreal/Poly.ML	Tue Jan 27 09:44:14 2004 +0100
    14.2 +++ b/src/HOL/Hyperreal/Poly.ML	Tue Jan 27 15:39:51 2004 +0100
    14.3 @@ -226,7 +226,7 @@
    14.4  \     ==> EX x. a < x & x < b & (poly p x = 0)";
    14.5  by (cut_inst_tac [("f","%x. poly p x"),("a","a"),("b","b"),("y","0")] 
    14.6      IVT_objl 1);
    14.7 -by (auto_tac (claset(),simpset() addsimps [real_le_less]));
    14.8 +by (auto_tac (claset(),simpset() addsimps [order_le_less]));
    14.9  qed "poly_IVT_pos";
   14.10  
   14.11  Goal "[| a < b; 0 < poly p a; poly p b < 0 |] \
    15.1 --- a/src/HOL/Hyperreal/SEQ.ML	Tue Jan 27 09:44:14 2004 +0100
    15.2 +++ b/src/HOL/Hyperreal/SEQ.ML	Tue Jan 27 15:39:51 2004 +0100
    15.3 @@ -146,7 +146,7 @@
    15.4  by (dtac choice 1 THEN Step_tac 1);
    15.5  by (dres_inst_tac [("x","Abs_hypnat(hypnatrel``{f})")] bspec 1);
    15.6  by (dtac (approx_minus_iff RS iffD1) 2);
    15.7 -by (fold_tac [real_le_def]);
    15.8 +by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [linorder_not_less])));
    15.9  by (blast_tac (claset() addIs [HNatInfinite_NSLIMSEQ]) 1);
   15.10  by (blast_tac (claset() addIs [lemmaLIM3]) 1);
   15.11  qed "NSLIMSEQ_LIMSEQ";
   15.12 @@ -528,7 +528,7 @@
   15.13  Goalw [Bseq_def,NSBseq_def] 
   15.14        "NSBseq X ==> Bseq X";
   15.15  by (rtac ccontr 1);
   15.16 -by (auto_tac (claset(), simpset() addsimps [real_le_def]));
   15.17 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
   15.18  by (dtac lemmaNSBseq2 1 THEN Step_tac 1);
   15.19  by (forw_inst_tac [("X","X"),("f","f")] real_seq_to_hypreal_HInfinite 1);
   15.20  by (dtac (HNatInfinite_skolem_f RSN (2,bspec)) 1 THEN assume_tac 1);
   15.21 @@ -658,7 +658,7 @@
   15.22  \              |] ==> EX m. U + -T < X m & X m < U";
   15.23  by (dtac lemma_converg2 1 THEN assume_tac 1);
   15.24  by (rtac ccontr 1 THEN Asm_full_simp_tac 1);
   15.25 -by (fold_tac [real_le_def]);
   15.26 +by (asm_full_simp_tac (simpset() addsimps [linorder_not_less]) 1);
   15.27  by (dtac lemma_converg3 1);
   15.28  by (dtac isLub_le_isUb 1 THEN assume_tac 1);
   15.29  by (auto_tac (claset() addDs [order_less_le_trans],
    16.1 --- a/src/HOL/Hyperreal/Series.ML	Tue Jan 27 09:44:14 2004 +0100
    16.2 +++ b/src/HOL/Hyperreal/Series.ML	Tue Jan 27 15:39:51 2004 +0100
    16.3 @@ -382,7 +382,7 @@
    16.4  by (subgoal_tac "0 <= sumr 0 (Suc (Suc 0) * Suc no + n) f + - suminf f" 1);
    16.5  by (dtac (abs_eqI1) 1 );
    16.6  by (Asm_full_simp_tac 1);
    16.7 -by (auto_tac (claset(),simpset() addsimps [real_le_def]));
    16.8 +by (auto_tac (claset(),simpset() addsimps [linorder_not_less RS sym]));
    16.9  qed "sumr_pos_lt_pair";
   16.10  
   16.11  (*-----------------------------------------------------------------
    17.1 --- a/src/HOL/Hyperreal/Transcendental.ML	Tue Jan 27 09:44:14 2004 +0100
    17.2 +++ b/src/HOL/Hyperreal/Transcendental.ML	Tue Jan 27 15:39:51 2004 +0100
    17.3 @@ -34,10 +34,10 @@
    17.4  by (rtac some_equality 1);
    17.5  by (forw_inst_tac [("n","n")] zero_less_power 2);
    17.6  by (auto_tac (claset(),simpset() addsimps [zero_less_mult_iff]));
    17.7 -by (res_inst_tac [("R1.0","u"),("R2.0","x")] real_linear_less2 1);
    17.8 +by (res_inst_tac [("x","u"),("y","x")] linorder_cases 1);
    17.9  by (dres_inst_tac [("n1","n"),("x","u")] (zero_less_Suc RSN  (3, realpow_less)) 1);
   17.10  by (dres_inst_tac [("n1","n"),("x","x")] (zero_less_Suc RSN (3, realpow_less)) 4);
   17.11 -by (auto_tac (claset(),simpset() addsimps [real_less_not_refl])); 
   17.12 +by (auto_tac (claset(),simpset() addsimps [order_less_irrefl])); 
   17.13  qed "real_root_pos";
   17.14  
   17.15  Goal "0 <= x ==> root(Suc n) (x ^ (Suc n)) = x";
   17.16 @@ -62,10 +62,10 @@
   17.17  by (rtac some_equality 1);
   17.18  by Auto_tac;
   17.19  by (rtac ccontr 1);
   17.20 -by (res_inst_tac [("R1.0","u"),("R2.0","1")] real_linear_less2 1);
   17.21 +by (res_inst_tac [("x","u"),("y","1")] linorder_cases 1);
   17.22  by (dres_inst_tac [("n","n")] realpow_Suc_less_one 1);
   17.23  by (dres_inst_tac [("n","n")] power_gt1_lemma 4);
   17.24 -by (auto_tac (claset(),simpset() addsimps [real_less_not_refl]));
   17.25 +by (auto_tac (claset(),simpset() addsimps [order_less_irrefl]));
   17.26  qed "real_root_one";
   17.27  Addsimps [real_root_one];
   17.28  
   17.29 @@ -160,14 +160,14 @@
   17.30  by (rtac someI2 1 THEN Step_tac 1 THEN Blast_tac 2);
   17.31  by (Asm_full_simp_tac 1 THEN Asm_full_simp_tac 1);
   17.32  by (res_inst_tac [("a","xa * x")] someI2 1);
   17.33 -by (auto_tac (claset() addEs [real_less_asym],
   17.34 +by (auto_tac (claset() addEs [order_less_asym],
   17.35      simpset() addsimps mult_ac@[power_mult_distrib RS sym,realpow_two_disj,
   17.36      zero_less_power, real_mult_order] delsimps [realpow_Suc]));
   17.37  qed "real_sqrt_mult_distrib";
   17.38  
   17.39  Goal "[|0<=x; 0<=y |] ==> sqrt(x*y) =  sqrt(x) * sqrt(y)";
   17.40  by (auto_tac (claset() addIs [ real_sqrt_mult_distrib],
   17.41 -    simpset() addsimps [real_le_less]));
   17.42 +    simpset() addsimps [order_le_less]));
   17.43  qed "real_sqrt_mult_distrib2";
   17.44  
   17.45  Goal "(r * r = 0) = (r = (0::real))";
   17.46 @@ -184,7 +184,7 @@
   17.47  
   17.48  Goal "0 <= x ==> 0 <= sqrt(x)";
   17.49  by (auto_tac (claset() addIs [real_sqrt_gt_zero],
   17.50 -    simpset() addsimps [real_le_less]));
   17.51 +    simpset() addsimps [order_le_less]));
   17.52  qed "real_sqrt_ge_zero";
   17.53  
   17.54  Goal "0 <= sqrt (x ^ 2 + y ^ 2)";
   17.55 @@ -226,7 +226,7 @@
   17.56  
   17.57  Goal "0 < x ==> sqrt x ~= 0";
   17.58  by (ftac real_sqrt_pow2_gt_zero 1);
   17.59 -by (auto_tac (claset(),simpset() addsimps [numeral_2_eq_2, real_less_not_refl]));
   17.60 +by (auto_tac (claset(),simpset() addsimps [numeral_2_eq_2, order_less_irrefl]));
   17.61  qed "real_sqrt_not_eq_zero";
   17.62  
   17.63  Goal "0 < x ==> inverse (sqrt(x)) ^ 2 = inverse x";
   17.64 @@ -621,7 +621,7 @@
   17.65  by (rtac real_le_trans 2 THEN assume_tac 3 THEN Auto_tac);
   17.66  by (res_inst_tac [("x","e")] exI 1 THEN Auto_tac);
   17.67  by (res_inst_tac [("y","K * abs x")] order_le_less_trans 1);
   17.68 -by (res_inst_tac [("R2.0","K * e")] real_less_trans 2);
   17.69 +by (res_inst_tac [("y","K * e")] order_less_trans 2);
   17.70  by (res_inst_tac [("z","inverse K")] (CLAIM_SIMP 
   17.71      "[|(0::real) <z; z*x<z*y |] ==> x<y" [mult_less_cancel_left]) 3);
   17.72  by (asm_full_simp_tac (simpset() addsimps [mult_assoc RS sym]) 4);
   17.73 @@ -1032,7 +1032,7 @@
   17.74  
   17.75  Goal "0 < exp x";
   17.76  by (simp_tac (simpset() addsimps 
   17.77 -    [CLAIM_SIMP "(x < y) = (x <= y & y ~= (x::real))" [real_le_less]]) 1);
   17.78 +    [CLAIM_SIMP "(x < y) = (x <= y & y ~= (x::real))" [order_le_less]]) 1);
   17.79  qed "exp_gt_zero";
   17.80  Addsimps [exp_gt_zero];
   17.81  
   17.82 @@ -1073,8 +1073,8 @@
   17.83  qed "exp_less_cancel_iff";
   17.84  AddIffs [exp_less_cancel_iff];
   17.85  
   17.86 -Goalw [real_le_def] "(exp(x) <= exp(y)) = (x <= y)";
   17.87 -by (Auto_tac);
   17.88 +Goal "(exp(x) <= exp(y)) = (x <= y)";
   17.89 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
   17.90  qed "exp_le_cancel_iff";
   17.91  AddIffs [exp_le_cancel_iff];
   17.92  
   17.93 @@ -1094,7 +1094,7 @@
   17.94  qed "lemma_exp_total";
   17.95  
   17.96  Goal "0 < y ==> EX x. exp x = y";
   17.97 -by (res_inst_tac [("R1.0","1"),("R2.0","y")] real_linear_less2 1);
   17.98 +by (res_inst_tac [("x","1"),("y","y")] linorder_cases 1);
   17.99  by (dtac (order_less_imp_le RS lemma_exp_total) 1);
  17.100  by (res_inst_tac [("x","0")] exI 2);
  17.101  by (ftac real_inverse_gt_one 3);
  17.102 @@ -1156,7 +1156,8 @@
  17.103  qed "ln_less_cancel_iff";
  17.104  Addsimps [ln_less_cancel_iff];
  17.105  
  17.106 -Goalw [real_le_def] "[| 0 < x; 0 < y|] ==> (ln x <= ln y) = (x <= y)";
  17.107 +Goal "[| 0 < x; 0 < y|] ==> (ln x <= ln y) = (x <= y)";
  17.108 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
  17.109  by (Auto_tac);
  17.110  qed "ln_le_cancel_iff";
  17.111  Addsimps [ln_le_cancel_iff];
  17.112 @@ -1348,8 +1349,8 @@
  17.113  by (arith_tac 1);
  17.114  qed "real_gt_one_ge_zero_add_less";
  17.115  
  17.116 -Goalw [real_le_def] "abs(sin x) <= 1";
  17.117 -by (rtac notI 1);
  17.118 +Goal "abs(sin x) <= 1";
  17.119 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
  17.120  by (dres_inst_tac [("n","Suc 0")] power_gt1 1); 
  17.121  by (auto_tac (claset(),simpset() delsimps [realpow_Suc]));
  17.122  by (dres_inst_tac [("r1","cos x")] (realpow_two_le RSN 
  17.123 @@ -1376,8 +1377,8 @@
  17.124  qed "sin_le_one";
  17.125  Addsimps [sin_le_one];
  17.126  
  17.127 -Goalw [real_le_def] "abs(cos x) <= 1";
  17.128 -by (rtac notI 1);
  17.129 +Goal "abs(cos x) <= 1";
  17.130 +by (auto_tac (claset(), simpset() addsimps [linorder_not_less RS sym]));
  17.131  by (dres_inst_tac [("n","Suc 0")] power_gt1 1); 
  17.132  by (auto_tac (claset(),simpset() delsimps [realpow_Suc]));
  17.133  by (dres_inst_tac [("r1","sin x")] (realpow_two_le RSN 
  17.134 @@ -1599,7 +1600,7 @@
  17.135  by (asm_simp_tac (simpset() addsimps [mult_less_cancel_left]) 1); 
  17.136  by (rtac real_mult_less_mono 1); (*mult_strict_mono would be stronger*)
  17.137  by (ALLGOALS(Asm_simp_tac));
  17.138 -by (TRYALL(rtac real_less_trans));
  17.139 +by (TRYALL(rtac order_less_trans));
  17.140  by (auto_tac (claset(),simpset() addsimps [real_of_nat_Suc] delsimps [fact_Suc]));
  17.141  qed "sin_gt_zero";
  17.142  
  17.143 @@ -1626,9 +1627,9 @@
  17.144  by (dtac sums_minus 1);
  17.145  by (rtac (CLAIM "- x < -y ==> (y::real) < x") 1);
  17.146  by (ftac sums_unique 1 THEN Auto_tac);
  17.147 -by (res_inst_tac [("R2.0",
  17.148 +by (res_inst_tac [("y",
  17.149      "sumr 0 (Suc (Suc (Suc 0))) (%n. -((- 1) ^ n /(real (fact(2 * n))) \
  17.150 -\               * 2 ^ (2 * n)))")] real_less_trans 1);
  17.151 +\               * 2 ^ (2 * n)))")] order_less_trans 1);
  17.152  by (simp_tac (simpset() addsimps [fact_num_eq_if,realpow_num_eq_if] 
  17.153      delsimps [fact_Suc,realpow_Suc]) 1);
  17.154  by (simp_tac (simpset() addsimps [real_mult_assoc] 
  17.155 @@ -1832,7 +1833,7 @@
  17.156  Goal "[| 0 < x; x < pi/2 |] ==> 0 < sin x";
  17.157  by (rtac sin_gt_zero 1);
  17.158  by (assume_tac 1); 
  17.159 -by (rtac real_less_trans 1 THEN assume_tac 1);
  17.160 +by (rtac order_less_trans 1 THEN assume_tac 1);
  17.161  by (rtac pi_half_less_two 1); 
  17.162  qed "sin_gt_zero2";
  17.163  
  17.164 @@ -1866,7 +1867,7 @@
  17.165  qed "cos_gt_zero";
  17.166  
  17.167  Goal "[| -(pi/2) < x; x < pi/2 |] ==> 0 < cos x";
  17.168 -by (res_inst_tac [("R1.0","x"),("R2.0","0")] real_linear_less2 1);
  17.169 +by (res_inst_tac [("x","x"),("y","0")] linorder_cases 1);
  17.170  by (rtac (cos_minus RS subst) 1);
  17.171  by (rtac cos_gt_zero 1);
  17.172  by (rtac (CLAIM "-y < x ==> -x < (y::real)") 2);
  17.173 @@ -1874,7 +1875,7 @@
  17.174  qed "cos_gt_zero_pi";
  17.175   
  17.176  Goal "[| -(pi/2) <= x; x <= pi/2 |] ==> 0 <= cos x";
  17.177 -by (auto_tac (claset(),HOL_ss addsimps [real_le_less,
  17.178 +by (auto_tac (claset(),HOL_ss addsimps [order_le_less,
  17.179      cos_gt_zero_pi]));
  17.180  by Auto_tac;
  17.181  qed "cos_ge_zero";
  17.182 @@ -1888,7 +1889,7 @@
  17.183  qed "sin_gt_zero_pi";
  17.184  
  17.185  Goal "[| 0 <= x; x <= pi |] ==> 0 <= sin x";
  17.186 -by (auto_tac (claset(),simpset() addsimps [real_le_less,
  17.187 +by (auto_tac (claset(),simpset() addsimps [order_le_less,
  17.188      sin_gt_zero_pi]));
  17.189  qed "sin_ge_zero";
  17.190  
  17.191 @@ -2354,7 +2355,7 @@
  17.192  by (cut_inst_tac [("y","x")] arctan_ubound 2);
  17.193  by (cut_inst_tac [("y","x")] arctan_lbound 4);
  17.194  by (auto_tac (claset(),
  17.195 -     simpset() addsimps [real_of_nat_Suc, left_distrib,real_le_def, mult_less_0_iff] 
  17.196 +     simpset() addsimps [real_of_nat_Suc, left_distrib,linorder_not_less RS sym, mult_less_0_iff] 
  17.197       delsimps [arctan]));
  17.198  qed "cos_arctan_not_zero";
  17.199  Addsimps [cos_arctan_not_zero];
  17.200 @@ -2544,7 +2545,7 @@
  17.201  
  17.202  Goal "[| 0 <= x; 0 <= y |] ==> (root(Suc n) x <= root(Suc n) y) = (x <= y)";
  17.203  by (auto_tac (claset() addIs [real_root_le_mono],simpset()));
  17.204 -by (simp_tac (simpset() addsimps [real_le_def]) 1);
  17.205 +by (simp_tac (simpset() addsimps [linorder_not_less RS sym]) 1);
  17.206  by Auto_tac;
  17.207  by (dres_inst_tac [("x","y"),("n","n")] real_root_less_mono 1);
  17.208  by Auto_tac;
  17.209 @@ -2808,11 +2809,11 @@
  17.210  by (rotate_tac 2 2);
  17.211  by (dtac (real_mult_assoc RS subst) 2);
  17.212  by (rotate_tac 2 2);
  17.213 -by (ftac (real_mult_inv_left RS subst) 2);
  17.214 +by (ftac (left_inverse RS subst) 2);
  17.215  by (assume_tac 2);
  17.216  by (thin_tac "(1 - z) * (x + y) = x /(x + y) * (x + y)" 2);
  17.217  by (thin_tac "1 - z = x /(x + y)" 2);
  17.218 -by (auto_tac (claset(),simpset() addsimps [real_mult_assoc]));
  17.219 +by (auto_tac (claset(),simpset() addsimps [mult_assoc]));
  17.220  by (auto_tac (claset(),simpset() addsimps [right_distrib,
  17.221      left_diff_distrib]));
  17.222  qed "lemma_divide_rearrange";
    18.1 --- a/src/HOL/Integ/Bin.thy	Tue Jan 27 09:44:14 2004 +0100
    18.2 +++ b/src/HOL/Integ/Bin.thy	Tue Jan 27 15:39:51 2004 +0100
    18.3 @@ -314,17 +314,18 @@
    18.4  
    18.5  (** Less-than-or-equals (\<le>) **)
    18.6  
    18.7 -lemma le_number_of_eq_not_less: "(number_of x \<le> (number_of y::int)) =
    18.8 -      (~ number_of y < (number_of x::int))"
    18.9 -apply (rule linorder_not_less [symmetric])
   18.10 -done
   18.11 +text{*Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals*}
   18.12 +lemmas le_number_of_eq_not_less =
   18.13 +       linorder_not_less [of "number_of w" "number_of v", symmetric, standard]
   18.14 +
   18.15 +declare le_number_of_eq_not_less [simp]
   18.16 +
   18.17  
   18.18  (** Absolute value (abs) **)
   18.19  
   18.20  lemma zabs_number_of:
   18.21   "abs(number_of x::int) =
   18.22    (if number_of x < (0::int) then -number_of x else number_of x)"
   18.23 -
   18.24  apply (unfold zabs_def)
   18.25  apply (rule refl)
   18.26  done
   18.27 @@ -423,4 +424,11 @@
   18.28  (* Numeral0 -> 0 and Numeral1 -> 1 *)
   18.29  declare int_numeral_0_eq_0 [simp] int_numeral_1_eq_1 [simp]
   18.30  
   18.31 +
   18.32 +(*Simplification of  x-y < 0, etc.*)
   18.33 +declare less_iff_diff_less_0 [symmetric, simp]
   18.34 +declare eq_iff_diff_eq_0 [symmetric, simp]
   18.35 +declare le_iff_diff_le_0 [symmetric, simp]
   18.36 +
   18.37 +
   18.38  end
    19.1 --- a/src/HOL/Integ/Equiv.thy	Tue Jan 27 09:44:14 2004 +0100
    19.2 +++ b/src/HOL/Integ/Equiv.thy	Tue Jan 27 15:39:51 2004 +0100
    19.3 @@ -118,6 +118,21 @@
    19.4    apply blast
    19.5    done
    19.6  
    19.7 +lemma quotient_eqI:
    19.8 +  "[|equiv A r; X \<in> A//r; Y \<in> A//r; x \<in> X; y \<in> Y; (x,y) \<in> r|] ==> X = Y" 
    19.9 +  apply (clarify elim!: quotientE)
   19.10 +  apply (rule equiv_class_eq, assumption)
   19.11 +  apply (unfold equiv_def sym_def trans_def, blast)
   19.12 +  done
   19.13 +
   19.14 +lemma quotient_eq_iff:
   19.15 +  "[|equiv A r; X \<in> A//r; Y \<in> A//r; x \<in> X; y \<in> Y|] ==> (X = Y) = ((x,y) \<in> r)" 
   19.16 +  apply (rule iffI)  
   19.17 +   prefer 2 apply (blast del: equalityI intro: quotient_eqI) 
   19.18 +  apply (clarify elim!: quotientE)
   19.19 +  apply (unfold equiv_def sym_def trans_def, blast)
   19.20 +  done
   19.21 +
   19.22  
   19.23  subsection {* Defining unary operations upon equivalence classes *}
   19.24  
    20.1 --- a/src/HOL/Integ/Int.thy	Tue Jan 27 09:44:14 2004 +0100
    20.2 +++ b/src/HOL/Integ/Int.thy	Tue Jan 27 15:39:51 2004 +0100
    20.3 @@ -320,13 +320,17 @@
    20.4  by (auto simp add: neg_eq_less_0 zless_iff_Suc_zadd 
    20.5                     diff_eq_eq [symmetric] zdiff_def)
    20.6  
    20.7 -lemma int_cases: 
    20.8 +lemma int_cases [cases type: int, case_names nonneg neg]: 
    20.9       "[|!! n. z = int n ==> P;  !! n. z =  - (int (Suc n)) ==> P |] ==> P"
   20.10  apply (case_tac "neg z")
   20.11  apply (fast dest!: negD)
   20.12  apply (drule not_neg_nat [symmetric], auto) 
   20.13  done
   20.14  
   20.15 +lemma int_induct [induct type: int, case_names nonneg neg]: 
   20.16 +     "[|!! n. P (int n);  !!n. P (- (int (Suc n))) |] ==> P z"
   20.17 +  by (cases z) auto
   20.18 +
   20.19  
   20.20  (*Legacy ML bindings, but no longer the structure Int.*)
   20.21  ML
    21.1 --- a/src/HOL/Integ/IntArith.thy	Tue Jan 27 09:44:14 2004 +0100
    21.2 +++ b/src/HOL/Integ/IntArith.thy	Tue Jan 27 15:39:51 2004 +0100
    21.3 @@ -43,6 +43,9 @@
    21.4  lemma zadd_left_cancel0 [simp]: "(z = z + w) = (w = (0::int))"
    21.5  by arith
    21.6  
    21.7 +lemma int_one_le_iff_zero_less: "((1::int) \<le> z) = (0 < z)"
    21.8 +by arith
    21.9 +
   21.10  
   21.11  subsection{*The Functions @{term nat} and @{term int}*}
   21.12  
    22.1 --- a/src/HOL/Integ/NatBin.thy	Tue Jan 27 09:44:14 2004 +0100
    22.2 +++ b/src/HOL/Integ/NatBin.thy	Tue Jan 27 15:39:51 2004 +0100
    22.3 @@ -269,17 +269,6 @@
    22.4  declare less_nat_number_of [simp]
    22.5  
    22.6  
    22.7 -(** Less-than-or-equals (<=) **)
    22.8 -
    22.9 -lemma le_nat_number_of_eq_not_less:
   22.10 -     "(number_of x <= (number_of y::nat)) =  
   22.11 -      (~ number_of y < (number_of x::nat))"
   22.12 -apply (rule linorder_not_less [symmetric])
   22.13 -done
   22.14 -
   22.15 -declare le_nat_number_of_eq_not_less [simp]
   22.16 -
   22.17 -
   22.18  (*Maps #n to n for n = 0, 1, 2*)
   22.19  lemmas numerals = numeral_0_eq_0 numeral_1_eq_1 numeral_2_eq_2
   22.20  
   22.21 @@ -732,7 +721,6 @@
   22.22  val eq_nat_nat_iff = thm"eq_nat_nat_iff";
   22.23  val eq_nat_number_of = thm"eq_nat_number_of";
   22.24  val less_nat_number_of = thm"less_nat_number_of";
   22.25 -val le_nat_number_of_eq_not_less = thm"le_nat_number_of_eq_not_less";
   22.26  val power2_eq_square = thm "power2_eq_square";
   22.27  val zero_le_power2 = thm "zero_le_power2";
   22.28  val zero_less_power2 = thm "zero_less_power2";
    23.1 --- a/src/HOL/Integ/nat_simprocs.ML	Tue Jan 27 09:44:14 2004 +0100
    23.2 +++ b/src/HOL/Integ/nat_simprocs.ML	Tue Jan 27 15:39:51 2004 +0100
    23.3 @@ -67,7 +67,7 @@
    23.4  
    23.5  val bin_simps = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym,
    23.6                   add_nat_number_of, nat_number_of_add_left,
    23.7 -                 diff_nat_number_of, le_nat_number_of_eq_not_less,
    23.8 +                 diff_nat_number_of, le_number_of_eq_not_less,
    23.9                   less_nat_number_of, mult_nat_number_of,
   23.10                   thm "Let_number_of", nat_number_of] @
   23.11                  bin_arith_simps @ bin_rel_simps;
   23.12 @@ -506,7 +506,7 @@
   23.13  val add_rules =
   23.14    [thm "Let_number_of", thm "Let_0", thm "Let_1", nat_0, nat_1,
   23.15     add_nat_number_of, diff_nat_number_of, mult_nat_number_of,
   23.16 -   eq_nat_number_of, less_nat_number_of, le_nat_number_of_eq_not_less,
   23.17 +   eq_nat_number_of, less_nat_number_of, le_number_of_eq_not_less,
   23.18     le_Suc_number_of,le_number_of_Suc,
   23.19     less_Suc_number_of,less_number_of_Suc,
   23.20     Suc_eq_number_of,eq_number_of_Suc,
    24.1 --- a/src/HOL/IsaMakefile	Tue Jan 27 09:44:14 2004 +0100
    24.2 +++ b/src/HOL/IsaMakefile	Tue Jan 27 15:39:51 2004 +0100
    24.3 @@ -139,16 +139,14 @@
    24.4  $(OUT)/HOL-Complex: $(OUT)/HOL Complex/ROOT.ML\
    24.5    Library/Zorn.thy\
    24.6    Real/Complex_Numbers.thy \
    24.7 -  Real/Lubs.ML Real/Lubs.thy Real/PNat.ML Real/PNat.thy \
    24.8 -  Real/PRat.ML Real/PRat.thy \
    24.9 -  Real/PReal.thy Real/RComplete.ML Real/RComplete.thy \
   24.10 +  Real/Lubs.ML Real/Lubs.thy Real/rat_arith.ML Real/RatArith.thy\
   24.11 +  Real/Rational.thy Real/PReal.thy Real/RComplete.thy \
   24.12    Real/ROOT.ML Real/Real.thy \
   24.13 -  Real/RealArith.thy Real/real_arith.ML Real/RealBin.ML \
   24.14 -  Real/RealBin.thy Real/RealDef.thy \
   24.15 -  Real/RealInt.thy Real/RealPow.thy Real/document/root.tex Real/real_arith.ML\
   24.16 +  Real/RealArith.thy Real/real_arith.ML Real/RealDef.thy \
   24.17 +  Real/RealPow.thy Real/document/root.tex Real/real_arith.ML\
   24.18    Hyperreal/EvenOdd.ML Hyperreal/EvenOdd.thy \
   24.19    Hyperreal/Fact.ML Hyperreal/Fact.thy\
   24.20 -  Hyperreal/Filter.ML Hyperreal/Filter.thy Hyperreal/HRealAbs.ML\
   24.21 +  Hyperreal/Filter.ML Hyperreal/Filter.thy\
   24.22    Hyperreal/HRealAbs.thy Hyperreal/HSeries.ML Hyperreal/HSeries.thy\
   24.23    Hyperreal/HyperArith.thy Hyperreal/HyperBin.ML Hyperreal/HyperBin.thy \
   24.24    Hyperreal/HyperDef.thy Hyperreal/HyperNat.ML Hyperreal/HyperNat.thy\
   24.25 @@ -197,8 +195,7 @@
   24.26    Library/Permutation.thy Library/Primes.thy Library/Quotient.thy \
   24.27    Library/Nat_Infinity.thy \
   24.28    Library/README.html Library/Continuity.thy \
   24.29 -  Library/Nested_Environment.thy Library/Rational_Numbers.thy \
   24.30 -  Library/Zorn.thy\
   24.31 +  Library/Nested_Environment.thy Library/Zorn.thy\
   24.32    Library/Library/ROOT.ML Library/Library/document/root.tex \
   24.33    Library/Library/document/root.bib Library/While_Combinator.thy
   24.34  	@cd Library; $(ISATOOL) usedir $(OUT)/HOL Library
    25.1 --- a/src/HOL/Library/Library.thy	Tue Jan 27 09:44:14 2004 +0100
    25.2 +++ b/src/HOL/Library/Library.thy	Tue Jan 27 15:39:51 2004 +0100
    25.3 @@ -2,7 +2,6 @@
    25.4  theory Library =
    25.5    Quotient +
    25.6    Nat_Infinity +
    25.7 -  Rational_Numbers +
    25.8    List_Prefix +
    25.9    Nested_Environment +
   25.10    Accessible_Part +
    26.1 --- a/src/HOL/Library/Rational_Numbers.thy	Tue Jan 27 09:44:14 2004 +0100
    26.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.3 @@ -1,672 +0,0 @@
    26.4 -(*  Title: HOL/Library/Rational_Numbers.thy
    26.5 -    ID:    $Id$
    26.6 -    Author: Markus Wenzel, TU Muenchen
    26.7 -    License: GPL (GNU GENERAL PUBLIC LICENSE)
    26.8 -*)
    26.9 -
   26.10 -header {*
   26.11 -  \title{Rational numbers}
   26.12 -  \author{Markus Wenzel}
   26.13 -*}
   26.14 -
   26.15 -theory Rational_Numbers = Quotient + Ring_and_Field:
   26.16 -
   26.17 -subsection {* Fractions *}
   26.18 -
   26.19 -subsubsection {* The type of fractions *}
   26.20 -
   26.21 -typedef fraction = "{(a, b) :: int \<times> int | a b. b \<noteq> 0}"
   26.22 -proof
   26.23 -  show "(0, 1) \<in> ?fraction" by simp
   26.24 -qed
   26.25 -
   26.26 -constdefs
   26.27 -  fract :: "int => int => fraction"
   26.28 -  "fract a b == Abs_fraction (a, b)"
   26.29 -  num :: "fraction => int"
   26.30 -  "num Q == fst (Rep_fraction Q)"
   26.31 -  den :: "fraction => int"
   26.32 -  "den Q == snd (Rep_fraction Q)"
   26.33 -
   26.34 -lemma fract_num [simp]: "b \<noteq> 0 ==> num (fract a b) = a"
   26.35 -  by (simp add: fract_def num_def fraction_def Abs_fraction_inverse)
   26.36 -
   26.37 -lemma fract_den [simp]: "b \<noteq> 0 ==> den (fract a b) = b"
   26.38 -  by (simp add: fract_def den_def fraction_def Abs_fraction_inverse)
   26.39 -
   26.40 -lemma fraction_cases [case_names fract, cases type: fraction]:
   26.41 -  "(!!a b. Q = fract a b ==> b \<noteq> 0 ==> C) ==> C"
   26.42 -proof -
   26.43 -  assume r: "!!a b. Q = fract a b ==> b \<noteq> 0 ==> C"
   26.44 -  obtain a b where "Q = fract a b" and "b \<noteq> 0"
   26.45 -    by (cases Q) (auto simp add: fract_def fraction_def)
   26.46 -  thus C by (rule r)
   26.47 -qed
   26.48 -
   26.49 -lemma fraction_induct [case_names fract, induct type: fraction]:
   26.50 -    "(!!a b. b \<noteq> 0 ==> P (fract a b)) ==> P Q"
   26.51 -  by (cases Q) simp
   26.52 -
   26.53 -
   26.54 -subsubsection {* Equivalence of fractions *}
   26.55 -
   26.56 -instance fraction :: eqv ..
   26.57 -
   26.58 -defs (overloaded)
   26.59 -  equiv_fraction_def: "Q \<sim> R == num Q * den R = num R * den Q"
   26.60 -
   26.61 -lemma equiv_fraction_iff [iff]:
   26.62 -    "b \<noteq> 0 ==> b' \<noteq> 0 ==> (fract a b \<sim> fract a' b') = (a * b' = a' * b)"
   26.63 -  by (simp add: equiv_fraction_def)
   26.64 -
   26.65 -instance fraction :: equiv
   26.66 -proof
   26.67 -  fix Q R S :: fraction
   26.68 -  {
   26.69 -    show "Q \<sim> Q"
   26.70 -    proof (induct Q)
   26.71 -      fix a b :: int
   26.72 -      assume "b \<noteq> 0" and "b \<noteq> 0"
   26.73 -      with refl show "fract a b \<sim> fract a b" ..
   26.74 -    qed
   26.75 -  next
   26.76 -    assume "Q \<sim> R" and "R \<sim> S"
   26.77 -    show "Q \<sim> S"
   26.78 -    proof (insert prems, induct Q, induct R, induct S)
   26.79 -      fix a b a' b' a'' b'' :: int
   26.80 -      assume b: "b \<noteq> 0" and b': "b' \<noteq> 0" and b'': "b'' \<noteq> 0"
   26.81 -      assume "fract a b \<sim> fract a' b'" hence eq1: "a * b' = a' * b" ..
   26.82 -      assume "fract a' b' \<sim> fract a'' b''" hence eq2: "a' * b'' = a'' * b'" ..
   26.83 -      have "a * b'' = a'' * b"
   26.84 -      proof cases
   26.85 -        assume "a' = 0"
   26.86 -        with b' eq1 eq2 have "a = 0 \<and> a'' = 0" by auto
   26.87 -        thus ?thesis by simp
   26.88 -      next
   26.89 -        assume a': "a' \<noteq> 0"
   26.90 -        from eq1 eq2 have "(a * b') * (a' * b'') = (a' * b) * (a'' * b')" by simp
   26.91 -        hence "(a * b'') * (a' * b') = (a'' * b) * (a' * b')" by (simp only: mult_ac)
   26.92 -        with a' b' show ?thesis by simp
   26.93 -      qed
   26.94 -      thus "fract a b \<sim> fract a'' b''" ..
   26.95 -    qed
   26.96 -  next
   26.97 -    show "Q \<sim> R ==> R \<sim> Q"
   26.98 -    proof (induct Q, induct R)
   26.99 -      fix a b a' b' :: int
  26.100 -      assume b: "b \<noteq> 0" and b': "b' \<noteq> 0"
  26.101 -      assume "fract a b \<sim> fract a' b'"
  26.102 -      hence "a * b' = a' * b" ..
  26.103 -      hence "a' * b = a * b'" ..
  26.104 -      thus "fract a' b' \<sim> fract a b" ..
  26.105 -    qed
  26.106 -  }
  26.107 -qed
  26.108 -
  26.109 -lemma eq_fraction_iff [iff]:
  26.110 -    "b \<noteq> 0 ==> b' \<noteq> 0 ==> (\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>) = (a * b' = a' * b)"
  26.111 -  by (simp add: equiv_fraction_iff quot_equality)
  26.112 -
  26.113 -
  26.114 -subsubsection {* Operations on fractions *}
  26.115 -
  26.116 -text {*
  26.117 - We define the basic arithmetic operations on fractions and
  26.118 - demonstrate their ``well-definedness'', i.e.\ congruence with respect
  26.119 - to equivalence of fractions.
  26.120 -*}
  26.121 -
  26.122 -instance fraction :: zero ..
  26.123 -instance fraction :: one ..
  26.124 -instance fraction :: plus ..
  26.125 -instance fraction :: minus ..
  26.126 -instance fraction :: times ..
  26.127 -instance fraction :: inverse ..
  26.128 -instance fraction :: ord ..
  26.129 -
  26.130 -defs (overloaded)
  26.131 -  zero_fraction_def: "0 == fract 0 1"
  26.132 -  one_fraction_def: "1 == fract 1 1"
  26.133 -  add_fraction_def: "Q + R ==
  26.134 -    fract (num Q * den R + num R * den Q) (den Q * den R)"
  26.135 -  minus_fraction_def: "-Q == fract (-(num Q)) (den Q)"
  26.136 -  mult_fraction_def: "Q * R == fract (num Q * num R) (den Q * den R)"
  26.137 -  inverse_fraction_def: "inverse Q == fract (den Q) (num Q)"
  26.138 -  le_fraction_def: "Q \<le> R ==
  26.139 -    (num Q * den R) * (den Q * den R) \<le> (num R * den Q) * (den Q * den R)"
  26.140 -
  26.141 -lemma is_zero_fraction_iff: "b \<noteq> 0 ==> (\<lfloor>fract a b\<rfloor> = \<lfloor>0\<rfloor>) = (a = 0)"
  26.142 -  by (simp add: zero_fraction_def eq_fraction_iff)
  26.143 -
  26.144 -theorem add_fraction_cong:
  26.145 -  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>
  26.146 -    ==> b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0
  26.147 -    ==> \<lfloor>fract a b + fract c d\<rfloor> = \<lfloor>fract a' b' + fract c' d'\<rfloor>"
  26.148 -proof -
  26.149 -  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"  "d \<noteq> 0"  "d' \<noteq> 0"
  26.150 -  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>" hence eq1: "a * b' = a' * b" ..
  26.151 -  assume "\<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>" hence eq2: "c * d' = c' * d" ..
  26.152 -  have "\<lfloor>fract (a * d + c * b) (b * d)\<rfloor> = \<lfloor>fract (a' * d' + c' * b') (b' * d')\<rfloor>"
  26.153 -  proof
  26.154 -    show "(a * d + c * b) * (b' * d') = (a' * d' + c' * b') * (b * d)"
  26.155 -      (is "?lhs = ?rhs")
  26.156 -    proof -
  26.157 -      have "?lhs = (a * b') * (d * d') + (c * d') * (b * b')"
  26.158 -        by (simp add: int_distrib mult_ac)
  26.159 -      also have "... = (a' * b) * (d * d') + (c' * d) * (b * b')"
  26.160 -        by (simp only: eq1 eq2)
  26.161 -      also have "... = ?rhs"
  26.162 -        by (simp add: int_distrib mult_ac)
  26.163 -      finally show "?lhs = ?rhs" .
  26.164 -    qed
  26.165 -    from neq show "b * d \<noteq> 0" by simp
  26.166 -    from neq show "b' * d' \<noteq> 0" by simp
  26.167 -  qed
  26.168 -  with neq show ?thesis by (simp add: add_fraction_def)
  26.169 -qed
  26.170 -
  26.171 -theorem minus_fraction_cong:
  26.172 -  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> b \<noteq> 0 ==> b' \<noteq> 0
  26.173 -    ==> \<lfloor>-(fract a b)\<rfloor> = \<lfloor>-(fract a' b')\<rfloor>"
  26.174 -proof -
  26.175 -  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"
  26.176 -  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>"
  26.177 -  hence "a * b' = a' * b" ..
  26.178 -  hence "-a * b' = -a' * b" by simp
  26.179 -  hence "\<lfloor>fract (-a) b\<rfloor> = \<lfloor>fract (-a') b'\<rfloor>" ..
  26.180 -  with neq show ?thesis by (simp add: minus_fraction_def)
  26.181 -qed
  26.182 -
  26.183 -theorem mult_fraction_cong:
  26.184 -  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>
  26.185 -    ==> b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0
  26.186 -    ==> \<lfloor>fract a b * fract c d\<rfloor> = \<lfloor>fract a' b' * fract c' d'\<rfloor>"
  26.187 -proof -
  26.188 -  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"  "d \<noteq> 0"  "d' \<noteq> 0"
  26.189 -  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>" hence eq1: "a * b' = a' * b" ..
  26.190 -  assume "\<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>" hence eq2: "c * d' = c' * d" ..
  26.191 -  have "\<lfloor>fract (a * c) (b * d)\<rfloor> = \<lfloor>fract (a' * c') (b' * d')\<rfloor>"
  26.192 -  proof
  26.193 -    from eq1 eq2 have "(a * b') * (c * d') = (a' * b) * (c' * d)" by simp
  26.194 -    thus "(a * c) * (b' * d') = (a' * c') * (b * d)" by (simp add: mult_ac)
  26.195 -    from neq show "b * d \<noteq> 0" by simp
  26.196 -    from neq show "b' * d' \<noteq> 0" by simp
  26.197 -  qed
  26.198 -  with neq show "\<lfloor>fract a b * fract c d\<rfloor> = \<lfloor>fract a' b' * fract c' d'\<rfloor>"
  26.199 -    by (simp add: mult_fraction_def)
  26.200 -qed
  26.201 -
  26.202 -theorem inverse_fraction_cong:
  26.203 -  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract a b\<rfloor> \<noteq> \<lfloor>0\<rfloor> ==> \<lfloor>fract a' b'\<rfloor> \<noteq> \<lfloor>0\<rfloor>
  26.204 -    ==> b \<noteq> 0 ==> b' \<noteq> 0
  26.205 -    ==> \<lfloor>inverse (fract a b)\<rfloor> = \<lfloor>inverse (fract a' b')\<rfloor>"
  26.206 -proof -
  26.207 -  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"
  26.208 -  assume "\<lfloor>fract a b\<rfloor> \<noteq> \<lfloor>0\<rfloor>" and "\<lfloor>fract a' b'\<rfloor> \<noteq> \<lfloor>0\<rfloor>"
  26.209 -  with neq obtain "a \<noteq> 0" and "a' \<noteq> 0" by (simp add: is_zero_fraction_iff)
  26.210 -  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>"
  26.211 -  hence "a * b' = a' * b" ..
  26.212 -  hence "b * a' = b' * a" by (simp only: mult_ac)
  26.213 -  hence "\<lfloor>fract b a\<rfloor> = \<lfloor>fract b' a'\<rfloor>" ..
  26.214 -  with neq show ?thesis by (simp add: inverse_fraction_def)
  26.215 -qed
  26.216 -
  26.217 -theorem le_fraction_cong:
  26.218 -  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>
  26.219 -    ==> b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0
  26.220 -    ==> (fract a b \<le> fract c d) = (fract a' b' \<le> fract c' d')"
  26.221 -proof -
  26.222 -  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"  "d \<noteq> 0"  "d' \<noteq> 0"
  26.223 -  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>" hence eq1: "a * b' = a' * b" ..
  26.224 -  assume "\<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>" hence eq2: "c * d' = c' * d" ..
  26.225 -
  26.226 -  let ?le = "\<lambda>a b c d. ((a * d) * (b * d) \<le> (c * b) * (b * d))"
  26.227 -  {
  26.228 -    fix a b c d x :: int assume x: "x \<noteq> 0"
  26.229 -    have "?le a b c d = ?le (a * x) (b * x) c d"
  26.230 -    proof -
  26.231 -      from x have "0 < x * x" by (auto simp add: zero_less_mult_iff)
  26.232 -      hence "?le a b c d =
  26.233 -          ((a * d) * (b * d) * (x * x) \<le> (c * b) * (b * d) * (x * x))"
  26.234 -        by (simp add: mult_le_cancel_right)
  26.235 -      also have "... = ?le (a * x) (b * x) c d"
  26.236 -        by (simp add: mult_ac)
  26.237 -      finally show ?thesis .
  26.238 -    qed
  26.239 -  } note le_factor = this
  26.240 -
  26.241 -  let ?D = "b * d" and ?D' = "b' * d'"
  26.242 -  from neq have D: "?D \<noteq> 0" by simp
  26.243 -  from neq have "?D' \<noteq> 0" by simp
  26.244 -  hence "?le a b c d = ?le (a * ?D') (b * ?D') c d"
  26.245 -    by (rule le_factor)
  26.246 -  also have "... = ((a * b') * ?D * ?D' * d * d' \<le> (c * d') * ?D * ?D' * b * b')"
  26.247 -    by (simp add: mult_ac)
  26.248 -  also have "... = ((a' * b) * ?D * ?D' * d * d' \<le> (c' * d) * ?D * ?D' * b * b')"
  26.249 -    by (simp only: eq1 eq2)
  26.250 -  also have "... = ?le (a' * ?D) (b' * ?D) c' d'"
  26.251 -    by (simp add: mult_ac)
  26.252 -  also from D have "... = ?le a' b' c' d'"
  26.253 -    by (rule le_factor [symmetric])
  26.254 -  finally have "?le a b c d = ?le a' b' c' d'" .
  26.255 -  with neq show ?thesis by (simp add: le_fraction_def)
  26.256 -qed
  26.257 -
  26.258 -
  26.259 -subsection {* Rational numbers *}
  26.260 -
  26.261 -subsubsection {* The type of rational numbers *}
  26.262 -
  26.263 -typedef (Rat)
  26.264 -  rat = "UNIV :: fraction quot set" ..
  26.265 -
  26.266 -lemma RatI [intro, simp]: "Q \<in> Rat"
  26.267 -  by (simp add: Rat_def)
  26.268 -
  26.269 -constdefs
  26.270 -  fraction_of :: "rat => fraction"
  26.271 -  "fraction_of q == pick (Rep_Rat q)"
  26.272 -  rat_of :: "fraction => rat"
  26.273 -  "rat_of Q == Abs_Rat \<lfloor>Q\<rfloor>"
  26.274 -
  26.275 -theorem rat_of_equality [iff?]: "(rat_of Q = rat_of Q') = (\<lfloor>Q\<rfloor> = \<lfloor>Q'\<rfloor>)"
  26.276 -  by (simp add: rat_of_def Abs_Rat_inject)
  26.277 -
  26.278 -lemma rat_of: "\<lfloor>Q\<rfloor> = \<lfloor>Q'\<rfloor> ==> rat_of Q = rat_of Q'" ..
  26.279 -
  26.280 -constdefs
  26.281 -  Fract :: "int => int => rat"
  26.282 -  "Fract a b == rat_of (fract a b)"
  26.283 -
  26.284 -theorem Fract_inverse: "\<lfloor>fraction_of (Fract a b)\<rfloor> = \<lfloor>fract a b\<rfloor>"
  26.285 -  by (simp add: fraction_of_def rat_of_def Fract_def Abs_Rat_inverse pick_inverse)
  26.286 -
  26.287 -theorem Fract_equality [iff?]:
  26.288 -    "(Fract a b = Fract c d) = (\<lfloor>fract a b\<rfloor> = \<lfloor>fract c d\<rfloor>)"
  26.289 -  by (simp add: Fract_def rat_of_equality)
  26.290 -
  26.291 -theorem eq_rat:
  26.292 -    "b \<noteq> 0 ==> d \<noteq> 0 ==> (Fract a b = Fract c d) = (a * d = c * b)"
  26.293 -  by (simp add: Fract_equality eq_fraction_iff)
  26.294 -
  26.295 -theorem Rat_cases [case_names Fract, cases type: rat]:
  26.296 -  "(!!a b. q = Fract a b ==> b \<noteq> 0 ==> C) ==> C"
  26.297 -proof -
  26.298 -  assume r: "!!a b. q = Fract a b ==> b \<noteq> 0 ==> C"
  26.299 -  obtain x where "q = Abs_Rat x" by (cases q)
  26.300 -  moreover obtain Q where "x = \<lfloor>Q\<rfloor>" by (cases x)
  26.301 -  moreover obtain a b where "Q = fract a b" and "b \<noteq> 0" by (cases Q)
  26.302 -  ultimately have "q = Fract a b" by (simp only: Fract_def rat_of_def)
  26.303 -  thus ?thesis by (rule r)
  26.304 -qed
  26.305 -
  26.306 -theorem Rat_induct [case_names Fract, induct type: rat]:
  26.307 -    "(!!a b. b \<noteq> 0 ==> P (Fract a b)) ==> P q"
  26.308 -  by (cases q) simp
  26.309 -
  26.310 -
  26.311 -subsubsection {* Canonical function definitions *}
  26.312 -
  26.313 -text {*
  26.314 -  Note that the unconditional version below is much easier to read.
  26.315 -*}
  26.316 -
  26.317 -theorem rat_cond_function:
  26.318 -  "(!!q r. P \<lfloor>fraction_of q\<rfloor> \<lfloor>fraction_of r\<rfloor> ==>
  26.319 -      f q r == g (fraction_of q) (fraction_of r)) ==>
  26.320 -    (!!a b a' b' c d c' d'.
  26.321 -      \<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor> ==>
  26.322 -      P \<lfloor>fract a b\<rfloor> \<lfloor>fract c d\<rfloor> ==> P \<lfloor>fract a' b'\<rfloor> \<lfloor>fract c' d'\<rfloor> ==>
  26.323 -      b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0 ==>
  26.324 -      g (fract a b) (fract c d) = g (fract a' b') (fract c' d')) ==>
  26.325 -    P \<lfloor>fract a b\<rfloor> \<lfloor>fract c d\<rfloor> ==>
  26.326 -      f (Fract a b) (Fract c d) = g (fract a b) (fract c d)"
  26.327 -  (is "PROP ?eq ==> PROP ?cong ==> ?P ==> _")
  26.328 -proof -
  26.329 -  assume eq: "PROP ?eq" and cong: "PROP ?cong" and P: ?P
  26.330 -  have "f (Abs_Rat \<lfloor>fract a b\<rfloor>) (Abs_Rat \<lfloor>fract c d\<rfloor>) = g (fract a b) (fract c d)"
  26.331 -  proof (rule quot_cond_function)
  26.332 -    fix X Y assume "P X Y"
  26.333 -    with eq show "f (Abs_Rat X) (Abs_Rat Y) == g (pick X) (pick Y)"
  26.334 -      by (simp add: fraction_of_def pick_inverse Abs_Rat_inverse)
  26.335 -  next
  26.336 -    fix Q Q' R R' :: fraction
  26.337 -    show "\<lfloor>Q\<rfloor> = \<lfloor>Q'\<rfloor> ==> \<lfloor>R\<rfloor> = \<lfloor>R'\<rfloor> ==>
  26.338 -        P \<lfloor>Q\<rfloor> \<lfloor>R\<rfloor> ==> P \<lfloor>Q'\<rfloor> \<lfloor>R'\<rfloor> ==> g Q R = g Q' R'"
  26.339 -      by (induct Q, induct Q', induct R, induct R') (rule cong)
  26.340 -  qed
  26.341 -  thus ?thesis by (unfold Fract_def rat_of_def)
  26.342 -qed
  26.343 -
  26.344 -theorem rat_function:
  26.345 -  "(!!q r. f q r == g (fraction_of q) (fraction_of r)) ==>
  26.346 -    (!!a b a' b' c d c' d'.
  26.347 -      \<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor> ==>
  26.348 -      b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0 ==>
  26.349 -      g (fract a b) (fract c d) = g (fract a' b') (fract c' d')) ==>
  26.350 -    f (Fract a b) (Fract c d) = g (fract a b) (fract c d)"
  26.351 -proof -
  26.352 -  case rule_context from this TrueI
  26.353 -  show ?thesis by (rule rat_cond_function)
  26.354 -qed
  26.355 -
  26.356 -
  26.357 -subsubsection {* Standard operations on rational numbers *}
  26.358 -
  26.359 -instance rat :: zero ..
  26.360 -instance rat :: one ..
  26.361 -instance rat :: plus ..
  26.362 -instance rat :: minus ..
  26.363 -instance rat :: times ..
  26.364 -instance rat :: inverse ..
  26.365 -instance rat :: ord ..
  26.366 -instance rat :: number ..
  26.367 -
  26.368 -defs (overloaded)
  26.369 -  zero_rat_def: "0 == rat_of 0"
  26.370 -  one_rat_def: "1 == rat_of 1"
  26.371 -  add_rat_def: "q + r == rat_of (fraction_of q + fraction_of r)"
  26.372 -  minus_rat_def: "-q == rat_of (-(fraction_of q))"
  26.373 -  diff_rat_def: "q - r == q + (-(r::rat))"
  26.374 -  mult_rat_def: "q * r == rat_of (fraction_of q * fraction_of r)"
  26.375 -  inverse_rat_def: "q \<noteq> 0 ==> inverse q == rat_of (inverse (fraction_of q))"
  26.376 -  divide_rat_def: "r \<noteq> 0 ==> q / r == q * inverse (r::rat)"
  26.377 -  le_rat_def: "q \<le> r == fraction_of q \<le> fraction_of r"
  26.378 -  less_rat_def: "q < r == q \<le> r \<and> q \<noteq> (r::rat)"
  26.379 -  abs_rat_def: "\<bar>q\<bar> == if q < 0 then -q else (q::rat)"
  26.380 -  number_of_rat_def: "number_of b == Fract (number_of b) 1"
  26.381 -
  26.382 -theorem zero_rat: "0 = Fract 0 1"
  26.383 -  by (simp add: zero_rat_def zero_fraction_def rat_of_def Fract_def)        
  26.384 -
  26.385 -theorem one_rat: "1 = Fract 1 1"
  26.386 -  by (simp add: one_rat_def one_fraction_def rat_of_def Fract_def)
  26.387 -
  26.388 -theorem add_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  26.389 -  Fract a b + Fract c d = Fract (a * d + c * b) (b * d)"
  26.390 -proof -
  26.391 -  have "Fract a b + Fract c d = rat_of (fract a b + fract c d)"
  26.392 -    by (rule rat_function, rule add_rat_def, rule rat_of, rule add_fraction_cong)
  26.393 -  also
  26.394 -  assume "b \<noteq> 0"  "d \<noteq> 0"
  26.395 -  hence "fract a b + fract c d = fract (a * d + c * b) (b * d)"
  26.396 -    by (simp add: add_fraction_def)
  26.397 -  finally show ?thesis by (unfold Fract_def)
  26.398 -qed
  26.399 -
  26.400 -theorem minus_rat: "b \<noteq> 0 ==> -(Fract a b) = Fract (-a) b"
  26.401 -proof -
  26.402 -  have "-(Fract a b) = rat_of (-(fract a b))"
  26.403 -    by (rule rat_function, rule minus_rat_def, rule rat_of, rule minus_fraction_cong)
  26.404 -  also assume "b \<noteq> 0" hence "-(fract a b) = fract (-a) b"
  26.405 -    by (simp add: minus_fraction_def)
  26.406 -  finally show ?thesis by (unfold Fract_def)
  26.407 -qed
  26.408 -
  26.409 -theorem diff_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  26.410 -    Fract a b - Fract c d = Fract (a * d - c * b) (b * d)"
  26.411 -  by (simp add: diff_rat_def add_rat minus_rat)
  26.412 -
  26.413 -theorem mult_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  26.414 -  Fract a b * Fract c d = Fract (a * c) (b * d)"
  26.415 -proof -
  26.416 -  have "Fract a b * Fract c d = rat_of (fract a b * fract c d)"
  26.417 -    by (rule rat_function, rule mult_rat_def, rule rat_of, rule mult_fraction_cong)
  26.418 -  also
  26.419 -  assume "b \<noteq> 0"  "d \<noteq> 0"
  26.420 -  hence "fract a b * fract c d = fract (a * c) (b * d)"
  26.421 -    by (simp add: mult_fraction_def)
  26.422 -  finally show ?thesis by (unfold Fract_def)
  26.423 -qed
  26.424 -
  26.425 -theorem inverse_rat: "Fract a b \<noteq> 0 ==> b \<noteq> 0 ==>
  26.426 -  inverse (Fract a b) = Fract b a"
  26.427 -proof -
  26.428 -  assume neq: "b \<noteq> 0" and nonzero: "Fract a b \<noteq> 0"
  26.429 -  hence "\<lfloor>fract a b\<rfloor> \<noteq> \<lfloor>0\<rfloor>"
  26.430 -    by (simp add: zero_rat eq_rat is_zero_fraction_iff)
  26.431 -  with _ inverse_fraction_cong [THEN rat_of]
  26.432 -  have "inverse (Fract a b) = rat_of (inverse (fract a b))"
  26.433 -  proof (rule rat_cond_function)
  26.434 -    fix q assume cond: "\<lfloor>fraction_of q\<rfloor> \<noteq> \<lfloor>0\<rfloor>"
  26.435 -    have "q \<noteq> 0"
  26.436 -    proof (cases q)
  26.437 -      fix a b assume "b \<noteq> 0" and "q = Fract a b"
  26.438 -      from this cond show ?thesis
  26.439 -        by (simp add: Fract_inverse is_zero_fraction_iff zero_rat eq_rat)
  26.440 -    qed
  26.441 -    thus "inverse q == rat_of (inverse (fraction_of q))"
  26.442 -      by (rule inverse_rat_def)
  26.443 -  qed
  26.444 -  also from neq nonzero have "inverse (fract a b) = fract b a"
  26.445 -    by (simp add: inverse_fraction_def)
  26.446 -  finally show ?thesis by (unfold Fract_def)
  26.447 -qed
  26.448 -
  26.449 -theorem divide_rat: "Fract c d \<noteq> 0 ==> b \<noteq> 0 ==> d \<noteq> 0 ==>
  26.450 -  Fract a b / Fract c d = Fract (a * d) (b * c)"
  26.451 -proof -
  26.452 -  assume neq: "b \<noteq> 0"  "d \<noteq> 0" and nonzero: "Fract c d \<noteq> 0"
  26.453 -  hence "c \<noteq> 0" by (simp add: zero_rat eq_rat)
  26.454 -  with neq nonzero show ?thesis
  26.455 -    by (simp add: divide_rat_def inverse_rat mult_rat)
  26.456 -qed
  26.457 -
  26.458 -theorem le_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  26.459 -  (Fract a b \<le> Fract c d) = ((a * d) * (b * d) \<le> (c * b) * (b * d))"
  26.460 -proof -
  26.461 -  have "(Fract a b \<le> Fract c d) = (fract a b \<le> fract c d)"
  26.462 -    by (rule rat_function, rule le_rat_def, rule le_fraction_cong)
  26.463 -  also
  26.464 -  assume "b \<noteq> 0"  "d \<noteq> 0"
  26.465 -  hence "(fract a b \<le> fract c d) = ((a * d) * (b * d) \<le> (c * b) * (b * d))"
  26.466 -    by (simp add: le_fraction_def)
  26.467 -  finally show ?thesis .
  26.468 -qed
  26.469 -
  26.470 -theorem less_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  26.471 -    (Fract a b < Fract c d) = ((a * d) * (b * d) < (c * b) * (b * d))"
  26.472 -  by (simp add: less_rat_def le_rat eq_rat int_less_le)
  26.473 -
  26.474 -theorem abs_rat: "b \<noteq> 0 ==> \<bar>Fract a b\<bar> = Fract \<bar>a\<bar> \<bar>b\<bar>"
  26.475 -  by (simp add: abs_rat_def minus_rat zero_rat less_rat eq_rat)
  26.476 -     (auto simp add: mult_less_0_iff zero_less_mult_iff int_le_less 
  26.477 -                split: abs_split)
  26.478 -
  26.479 -
  26.480 -subsubsection {* The ordered field of rational numbers *}
  26.481 -
  26.482 -lemma rat_add_assoc: "(q + r) + s = q + (r + (s::rat))"
  26.483 -  by (induct q, induct r, induct s) 
  26.484 -     (simp add: add_rat add_ac mult_ac int_distrib)
  26.485 -
  26.486 -lemma rat_add_0: "0 + q = (q::rat)"
  26.487 -  by (induct q) (simp add: zero_rat add_rat)
  26.488 -
  26.489 -lemma rat_left_minus: "(-q) + q = (0::rat)"
  26.490 -  by (induct q) (simp add: zero_rat minus_rat add_rat eq_rat)
  26.491 -
  26.492 -
  26.493 -instance rat :: field
  26.494 -proof
  26.495 -  fix q r s :: rat
  26.496 -  show "(q + r) + s = q + (r + s)"
  26.497 -    by (rule rat_add_assoc)
  26.498 -  show "q + r = r + q"
  26.499 -    by (induct q, induct r) (simp add: add_rat add_ac mult_ac)
  26.500 -  show "0 + q = q"
  26.501 -    by (induct q) (simp add: zero_rat add_rat)
  26.502 -  show "(-q) + q = 0"
  26.503 -    by (rule rat_left_minus)
  26.504 -  show "q - r = q + (-r)"
  26.505 -    by (induct q, induct r) (simp add: add_rat minus_rat diff_rat)
  26.506 -  show "(q * r) * s = q * (r * s)"
  26.507 -    by (induct q, induct r, induct s) (simp add: mult_rat mult_ac)
  26.508 -  show "q * r = r * q"
  26.509 -    by (induct q, induct r) (simp add: mult_rat mult_ac)
  26.510 -  show "1 * q = q"
  26.511 -    by (induct q) (simp add: one_rat mult_rat)
  26.512 -  show "(q + r) * s = q * s + r * s"
  26.513 -    by (induct q, induct r, induct s) 
  26.514 -       (simp add: add_rat mult_rat eq_rat int_distrib)
  26.515 -  show "q \<noteq> 0 ==> inverse q * q = 1"
  26.516 -    by (induct q) (simp add: inverse_rat mult_rat one_rat zero_rat eq_rat)
  26.517 -  show "r \<noteq> 0 ==> q / r = q * inverse r"
  26.518 -    by (induct q, induct r)
  26.519 -       (simp add: mult_rat divide_rat inverse_rat zero_rat eq_rat)
  26.520 -  show "0 \<noteq> (1::rat)"
  26.521 -    by (simp add: zero_rat one_rat eq_rat) 
  26.522 -  assume eq: "s+q = s+r" 
  26.523 -    hence "(-s + s) + q = (-s + s) + r" by (simp only: eq rat_add_assoc)
  26.524 -    thus "q = r" by (simp add: rat_left_minus rat_add_0)
  26.525 -qed
  26.526 -
  26.527 -instance rat :: linorder
  26.528 -proof
  26.529 -  fix q r s :: rat
  26.530 -  {
  26.531 -    assume "q \<le> r" and "r \<le> s"
  26.532 -    show "q \<le> s"
  26.533 -    proof (insert prems, induct q, induct r, induct s)
  26.534 -      fix a b c d e f :: int
  26.535 -      assume neq: "b \<noteq> 0"  "d \<noteq> 0"  "f \<noteq> 0"
  26.536 -      assume 1: "Fract a b \<le> Fract c d" and 2: "Fract c d \<le> Fract e f"
  26.537 -      show "Fract a b \<le> Fract e f"
  26.538 -      proof -
  26.539 -        from neq obtain bb: "0 < b * b" and dd: "0 < d * d" and ff: "0 < f * f"
  26.540 -          by (auto simp add: zero_less_mult_iff linorder_neq_iff)
  26.541 -        have "(a * d) * (b * d) * (f * f) \<le> (c * b) * (b * d) * (f * f)"
  26.542 -        proof -
  26.543 -          from neq 1 have "(a * d) * (b * d) \<le> (c * b) * (b * d)"
  26.544 -            by (simp add: le_rat)
  26.545 -          with ff show ?thesis by (simp add: mult_le_cancel_right)
  26.546 -        qed
  26.547 -        also have "... = (c * f) * (d * f) * (b * b)"
  26.548 -          by (simp only: mult_ac)
  26.549 -        also have "... \<le> (e * d) * (d * f) * (b * b)"
  26.550 -        proof -
  26.551 -          from neq 2 have "(c * f) * (d * f) \<le> (e * d) * (d * f)"
  26.552 -            by (simp add: le_rat)
  26.553 -          with bb show ?thesis by (simp add: mult_le_cancel_right)
  26.554 -        qed
  26.555 -        finally have "(a * f) * (b * f) * (d * d) \<le> e * b * (b * f) * (d * d)"
  26.556 -          by (simp only: mult_ac)
  26.557 -        with dd have "(a * f) * (b * f) \<le> (e * b) * (b * f)"
  26.558 -          by (simp add: mult_le_cancel_right)
  26.559 -        with neq show ?thesis by (simp add: le_rat)
  26.560 -      qed
  26.561 -    qed
  26.562 -  next
  26.563 -    assume "q \<le> r" and "r \<le> q"
  26.564 -    show "q = r"
  26.565 -    proof (insert prems, induct q, induct r)
  26.566 -      fix a b c d :: int
  26.567 -      assume neq: "b \<noteq> 0"  "d \<noteq> 0"
  26.568 -      assume 1: "Fract a b \<le> Fract c d" and 2: "Fract c d \<le> Fract a b"
  26.569 -      show "Fract a b = Fract c d"
  26.570 -      proof -
  26.571 -        from neq 1 have "(a * d) * (b * d) \<le> (c * b) * (b * d)"
  26.572 -          by (simp add: le_rat)
  26.573 -        also have "... \<le> (a * d) * (b * d)"
  26.574 -        proof -
  26.575 -          from neq 2 have "(c * b) * (d * b) \<le> (a * d) * (d * b)"
  26.576 -            by (simp add: le_rat)
  26.577 -          thus ?thesis by (simp only: mult_ac)
  26.578 -        qed
  26.579 -        finally have "(a * d) * (b * d) = (c * b) * (b * d)" .
  26.580 -        moreover from neq have "b * d \<noteq> 0" by simp
  26.581 -        ultimately have "a * d = c * b" by simp
  26.582 -        with neq show ?thesis by (simp add: eq_rat)
  26.583 -      qed
  26.584 -    qed
  26.585 -  next
  26.586 -    show "q \<le> q"
  26.587 -      by (induct q) (simp add: le_rat)
  26.588 -    show "(q < r) = (q \<le> r \<and> q \<noteq> r)"
  26.589 -      by (simp only: less_rat_def)
  26.590 -    show "q \<le> r \<or> r \<le> q"
  26.591 -      by (induct q, induct r) (simp add: le_rat mult_ac, arith)
  26.592 -  }
  26.593 -qed
  26.594 -
  26.595 -instance rat :: ordered_field
  26.596 -proof
  26.597 -  fix q r s :: rat
  26.598 -  show "0 < (1::rat)" 
  26.599 -    by (simp add: zero_rat one_rat less_rat) 
  26.600 -  show "q \<le> r ==> s + q \<le> s + r"
  26.601 -  proof (induct q, induct r, induct s)
  26.602 -    fix a b c d e f :: int
  26.603 -    assume neq: "b \<noteq> 0"  "d \<noteq> 0"  "f \<noteq> 0"
  26.604 -    assume le: "Fract a b \<le> Fract c d"
  26.605 -    show "Fract e f + Fract a b \<le> Fract e f + Fract c d"
  26.606 -    proof -
  26.607 -      let ?F = "f * f" from neq have F: "0 < ?F"
  26.608 -        by (auto simp add: zero_less_mult_iff)
  26.609 -      from neq le have "(a * d) * (b * d) \<le> (c * b) * (b * d)"
  26.610 -        by (simp add: le_rat)
  26.611 -      with F have "(a * d) * (b * d) * ?F * ?F \<le> (c * b) * (b * d) * ?F * ?F"
  26.612 -        by (simp add: mult_le_cancel_right)
  26.613 -      with neq show ?thesis by (simp add: add_rat le_rat mult_ac int_distrib)
  26.614 -    qed
  26.615 -  qed
  26.616 -  show "q < r ==> 0 < s ==> s * q < s * r"
  26.617 -  proof (induct q, induct r, induct s)
  26.618 -    fix a b c d e f :: int
  26.619 -    assume neq: "b \<noteq> 0"  "d \<noteq> 0"  "f \<noteq> 0"
  26.620 -    assume le: "Fract a b < Fract c d"
  26.621 -    assume gt: "0 < Fract e f"
  26.622 -    show "Fract e f * Fract a b < Fract e f * Fract c d"
  26.623 -    proof -
  26.624 -      let ?E = "e * f" and ?F = "f * f"
  26.625 -      from neq gt have "0 < ?E"
  26.626 -        by (auto simp add: zero_rat less_rat le_rat int_less_le eq_rat)
  26.627 -      moreover from neq have "0 < ?F"
  26.628 -        by (auto simp add: zero_less_mult_iff)
  26.629 -      moreover from neq le have "(a * d) * (b * d) < (c * b) * (b * d)"
  26.630 -        by (simp add: less_rat)
  26.631 -      ultimately have "(a * d) * (b * d) * ?E * ?F < (c * b) * (b * d) * ?E * ?F"
  26.632 -        by (simp add: mult_less_cancel_right)
  26.633 -      with neq show ?thesis
  26.634 -        by (simp add: less_rat mult_rat mult_ac)
  26.635 -    qed
  26.636 -  qed
  26.637 -  show "\<bar>q\<bar> = (if q < 0 then -q else q)"
  26.638 -    by (simp only: abs_rat_def)
  26.639 -qed
  26.640 -
  26.641 -
  26.642 -subsection {* Embedding integers *}
  26.643 -
  26.644 -constdefs
  26.645 -  rat :: "int => rat"    (* FIXME generalize int to any numeric subtype (?) *)
  26.646 -  "rat z == Fract z 1"
  26.647 -  int_set :: "rat set"    ("\<int>")    (* FIXME generalize rat to any numeric supertype (?) *)
  26.648 -  "\<int> == range rat"
  26.649 -
  26.650 -lemma rat_inject: "(rat z = rat w) = (z = w)"
  26.651 -proof
  26.652 -  assume "rat z = rat w"
  26.653 -  hence "Fract z 1 = Fract w 1" by (unfold rat_def)
  26.654 -  hence "\<lfloor>fract z 1\<rfloor> = \<lfloor>fract w 1\<rfloor>" ..
  26.655 -  thus "z = w" by auto
  26.656 -next
  26.657 -  assume "z = w"
  26.658 -  thus "rat z = rat w" by simp
  26.659 -qed
  26.660 -
  26.661 -lemma int_set_cases [case_names rat, cases set: int_set]:
  26.662 -  "q \<in> \<int> ==> (!!z. q = rat z ==> C) ==> C"
  26.663 -proof (unfold int_set_def)
  26.664 -  assume "!!z. q = rat z ==> C"
  26.665 -  assume "q \<in> range rat" thus C ..
  26.666 -qed
  26.667 -
  26.668 -lemma int_set_induct [case_names rat, induct set: int_set]:
  26.669 -  "q \<in> \<int> ==> (!!z. P (rat z)) ==> P q"
  26.670 -  by (rule int_set_cases) auto
  26.671 -
  26.672 -theorem number_of_rat: "number_of b = rat (number_of b)"
  26.673 -  by (simp add: number_of_rat_def rat_def)
  26.674 -
  26.675 -end
    27.1 --- a/src/HOL/MicroJava/BV/Kildall.thy	Tue Jan 27 09:44:14 2004 +0100
    27.2 +++ b/src/HOL/MicroJava/BV/Kildall.thy	Tue Jan 27 15:39:51 2004 +0100
    27.3 @@ -367,17 +367,17 @@
    27.4    prefer 3
    27.5    apply assumption
    27.6    apply (erule listE_nth_in)
    27.7 -  apply blast
    27.8 - apply blast
    27.9 +  apply simp
   27.10 + apply simp
   27.11  apply (subst decomp_propa)
   27.12 - apply blast
   27.13 + apply fast
   27.14  apply simp
   27.15  apply (rule conjI)
   27.16   apply (rule merges_preserves_type)
   27.17   apply blast
   27.18   apply clarify
   27.19   apply (rule conjI)
   27.20 -  apply(clarsimp, blast dest!: boundedD)
   27.21 +  apply(clarsimp, fast dest!: boundedD)
   27.22   apply (erule pres_typeD)
   27.23    prefer 3
   27.24    apply assumption
    28.1 --- a/src/HOL/Real/PNat.ML	Tue Jan 27 09:44:14 2004 +0100
    28.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.3 @@ -1,540 +0,0 @@
    28.4 -(*  Title       : HOL/Real/PNat.ML
    28.5 -    ID          : $Id$
    28.6 -    Author      : Jacques D. Fleuriot
    28.7 -    Copyright   : 1998  University of Cambridge
    28.8 -
    28.9 -The positive naturals -- proofs mainly as in theory Nat.
   28.10 -*)
   28.11 -
   28.12 -Goal "mono(%X. {Suc 0} Un Suc`X)";
   28.13 -by (REPEAT (ares_tac [monoI, subset_refl, image_mono, Un_mono] 1));
   28.14 -qed "pnat_fun_mono";
   28.15 -
   28.16 -bind_thm ("pnat_unfold", pnat_fun_mono RS (pnat_def RS def_lfp_unfold));
   28.17 -
   28.18 -Goal "Suc 0 : pnat";
   28.19 -by (stac pnat_unfold 1);
   28.20 -by (rtac (singletonI RS UnI1) 1);
   28.21 -qed "one_RepI";
   28.22 -
   28.23 -Addsimps [one_RepI];
   28.24 -
   28.25 -Goal "i: pnat ==> Suc(i) : pnat";
   28.26 -by (stac pnat_unfold 1);
   28.27 -by (etac (imageI RS UnI2) 1);
   28.28 -qed "pnat_Suc_RepI";
   28.29 -
   28.30 -Goal "Suc (Suc 0) : pnat";
   28.31 -by (rtac (one_RepI RS pnat_Suc_RepI) 1);
   28.32 -qed "two_RepI";
   28.33 -
   28.34 -(*** Induction ***)
   28.35 -
   28.36 -val major::prems = Goal
   28.37 -    "[| i: pnat;  P(Suc 0);   \
   28.38 -\       !!j. [| j: pnat; P(j) |] ==> P(Suc(j)) |]  ==> P(i)";
   28.39 -by (rtac ([pnat_def, pnat_fun_mono, major] MRS def_lfp_induct) 1);
   28.40 -by (blast_tac (claset() addIs prems) 1);
   28.41 -qed "PNat_induct";
   28.42 -
   28.43 -val prems = Goalw [pnat_one_def,pnat_Suc_def]
   28.44 -    "[| P(1);   \
   28.45 -\       !!n. P(n) ==> P(pSuc n) |]  ==> P(n)";
   28.46 -by (rtac (Rep_pnat_inverse RS subst) 1);   
   28.47 -by (rtac (Rep_pnat RS PNat_induct) 1);
   28.48 -by (REPEAT (ares_tac prems 1
   28.49 -     ORELSE eresolve_tac [Abs_pnat_inverse RS subst] 1));
   28.50 -qed "pnat_induct";
   28.51 -
   28.52 -(*Perform induction on n. *)
   28.53 -fun pnat_ind_tac a i = 
   28.54 -  induct_thm_tac pnat_induct a i  THEN  rename_last_tac a [""] (i+1);
   28.55 -
   28.56 -val prems = Goal
   28.57 -    "[| !!x. P x 1;  \
   28.58 -\       !!y. P 1 (pSuc y);  \
   28.59 -\       !!x y. [| P x y |] ==> P (pSuc x) (pSuc y)  \
   28.60 -\    |] ==> P m n";
   28.61 -by (res_inst_tac [("x","m")] spec 1);
   28.62 -by (pnat_ind_tac "n" 1);
   28.63 -by (rtac allI 2);
   28.64 -by (pnat_ind_tac "x" 2);
   28.65 -by (REPEAT (ares_tac (prems@[allI]) 1 ORELSE etac spec 1));
   28.66 -qed "pnat_diff_induct";
   28.67 -
   28.68 -(*Case analysis on the natural numbers*)
   28.69 -val prems = Goal
   28.70 -    "[| n=1 ==> P;  !!x. n = pSuc(x) ==> P |] ==> P";
   28.71 -by (subgoal_tac "n=1 | (EX x. n = pSuc(x))" 1);
   28.72 -by (fast_tac (claset() addSEs prems) 1);
   28.73 -by (pnat_ind_tac "n" 1);
   28.74 -by (rtac (refl RS disjI1) 1);
   28.75 -by (Blast_tac 1);
   28.76 -qed "pnatE";
   28.77 -
   28.78 -(*** Isomorphisms: Abs_Nat and Rep_Nat ***)
   28.79 -
   28.80 -Goal "inj_on Abs_pnat pnat";
   28.81 -by (rtac inj_on_inverseI 1);
   28.82 -by (etac Abs_pnat_inverse 1);
   28.83 -qed "inj_on_Abs_pnat";
   28.84 -
   28.85 -Addsimps [inj_on_Abs_pnat RS inj_on_iff];
   28.86 -
   28.87 -Goal "inj(Rep_pnat)";
   28.88 -by (rtac inj_inverseI 1);
   28.89 -by (rtac Rep_pnat_inverse 1);
   28.90 -qed "inj_Rep_pnat";
   28.91 -
   28.92 -Goal "0 ~: pnat";
   28.93 -by (stac pnat_unfold 1);
   28.94 -by Auto_tac;
   28.95 -qed "zero_not_mem_pnat";
   28.96 -
   28.97 -(* 0 : pnat ==> P *)
   28.98 -bind_thm ("zero_not_mem_pnatE", zero_not_mem_pnat RS notE);
   28.99 -
  28.100 -Addsimps [zero_not_mem_pnat];
  28.101 -
  28.102 -Goal "x : pnat ==> 0 < x";
  28.103 -by (dtac (pnat_unfold RS subst) 1);
  28.104 -by Auto_tac;
  28.105 -qed "mem_pnat_gt_zero";
  28.106 -
  28.107 -Goal "0 < x ==> x: pnat";
  28.108 -by (stac pnat_unfold 1);
  28.109 -by (dtac (gr_implies_not0 RS not0_implies_Suc) 1); 
  28.110 -by (etac exE 1 THEN Asm_simp_tac 1);
  28.111 -by (induct_tac "m" 1);
  28.112 -by (auto_tac (claset(),simpset() 
  28.113 -    addsimps [one_RepI]) THEN dtac pnat_Suc_RepI 1);
  28.114 -by (Blast_tac 1);
  28.115 -qed "gt_0_mem_pnat";
  28.116 -
  28.117 -Goal "(x: pnat) = (0 < x)";
  28.118 -by (blast_tac (claset() addDs [mem_pnat_gt_zero,gt_0_mem_pnat]) 1);
  28.119 -qed "mem_pnat_gt_0_iff";
  28.120 -
  28.121 -Goal "0 < Rep_pnat x";
  28.122 -by (rtac (Rep_pnat RS mem_pnat_gt_zero) 1);
  28.123 -qed "Rep_pnat_gt_zero";
  28.124 -
  28.125 -Goalw [pnat_add_def] "(x::pnat) + y = y + x";
  28.126 -by (simp_tac (simpset() addsimps [add_commute]) 1);
  28.127 -qed "pnat_add_commute";
  28.128 -
  28.129 -(** alternative definition for pnat **)
  28.130 -(** order isomorphism **)
  28.131 -Goal "pnat = {x::nat. 0 < x}";
  28.132 -by (auto_tac (claset(), simpset() addsimps [mem_pnat_gt_0_iff]));  
  28.133 -qed "Collect_pnat_gt_0";
  28.134 -
  28.135 -(*** Distinctness of constructors ***)
  28.136 -
  28.137 -Goalw [pnat_one_def,pnat_Suc_def] "pSuc(m) ~= 1";
  28.138 -by (rtac (inj_on_Abs_pnat RS inj_on_contraD) 1);
  28.139 -by (rtac (Rep_pnat_gt_zero RS Suc_mono RS less_not_refl2) 1);
  28.140 -by (REPEAT (resolve_tac [Rep_pnat RS  pnat_Suc_RepI, one_RepI] 1));
  28.141 -qed "pSuc_not_one";
  28.142 -
  28.143 -bind_thm ("one_not_pSuc", pSuc_not_one RS not_sym);
  28.144 -
  28.145 -AddIffs [pSuc_not_one,one_not_pSuc];
  28.146 -
  28.147 -bind_thm ("pSuc_neq_one", (pSuc_not_one RS notE));
  28.148 -bind_thm ("one_neq_pSuc", pSuc_neq_one RS pSuc_neq_one);
  28.149 -
  28.150 -(** Injectiveness of pSuc **)
  28.151 -
  28.152 -Goalw [pnat_Suc_def] "inj(pSuc)";
  28.153 -by (rtac injI 1);
  28.154 -by (dtac (inj_on_Abs_pnat RS inj_onD) 1);
  28.155 -by (REPEAT (resolve_tac [Rep_pnat, pnat_Suc_RepI] 1));
  28.156 -by (dtac (inj_Suc RS injD) 1);
  28.157 -by (etac (inj_Rep_pnat RS injD) 1);
  28.158 -qed "inj_pSuc"; 
  28.159 -
  28.160 -bind_thm ("pSuc_inject", inj_pSuc RS injD);
  28.161 -
  28.162 -Goal "(pSuc(m)=pSuc(n)) = (m=n)";
  28.163 -by (EVERY1 [rtac iffI, etac pSuc_inject, etac arg_cong]); 
  28.164 -qed "pSuc_pSuc_eq";
  28.165 -
  28.166 -AddIffs [pSuc_pSuc_eq];
  28.167 -
  28.168 -Goal "n ~= pSuc(n)";
  28.169 -by (pnat_ind_tac "n" 1);
  28.170 -by (ALLGOALS Asm_simp_tac);
  28.171 -qed "n_not_pSuc_n";
  28.172 -
  28.173 -bind_thm ("pSuc_n_not_n", n_not_pSuc_n RS not_sym);
  28.174 -
  28.175 -Goal "n ~= 1 ==> EX m. n = pSuc m";
  28.176 -by (rtac pnatE 1);
  28.177 -by (REPEAT (Blast_tac 1));
  28.178 -qed "not1_implies_pSuc";
  28.179 -
  28.180 -Goal "pSuc m = m + 1";
  28.181 -by (auto_tac (claset(),simpset() addsimps [pnat_Suc_def,
  28.182 -    pnat_one_def,Abs_pnat_inverse,pnat_add_def]));
  28.183 -qed "pSuc_is_plus_one";
  28.184 -
  28.185 -Goal
  28.186 -      "(Rep_pnat x + Rep_pnat y): pnat";
  28.187 -by (cut_facts_tac [[Rep_pnat_gt_zero,
  28.188 -    Rep_pnat_gt_zero] MRS add_less_mono,Collect_pnat_gt_0] 1);
  28.189 -by (etac ssubst 1);
  28.190 -by Auto_tac;
  28.191 -qed "sum_Rep_pnat";
  28.192 -
  28.193 -Goalw [pnat_add_def] 
  28.194 -      "Rep_pnat x + Rep_pnat y = Rep_pnat (x + y)";
  28.195 -by (simp_tac (simpset() addsimps [sum_Rep_pnat RS 
  28.196 -                          Abs_pnat_inverse]) 1);
  28.197 -qed "sum_Rep_pnat_sum";
  28.198 -
  28.199 -Goalw [pnat_add_def] 
  28.200 -      "(x + y) + z = x + (y + (z::pnat))";
  28.201 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.202 -by (simp_tac (simpset() addsimps [sum_Rep_pnat RS 
  28.203 -                Abs_pnat_inverse,add_assoc]) 1);
  28.204 -qed "pnat_add_assoc";
  28.205 -
  28.206 -Goalw [pnat_add_def] "x + (y + z) = y + (x + (z::pnat))";
  28.207 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.208 -by (simp_tac (simpset() addsimps [sum_Rep_pnat RS 
  28.209 -          Abs_pnat_inverse,add_left_commute]) 1);
  28.210 -qed "pnat_add_left_commute";
  28.211 -
  28.212 -(*Addition is an AC-operator*)
  28.213 -bind_thms ("pnat_add_ac", [pnat_add_assoc, pnat_add_commute, pnat_add_left_commute]);
  28.214 -
  28.215 -Goalw [pnat_add_def] "((x::pnat) + y = x + z) = (y = z)";
  28.216 -by (auto_tac (claset() addDs [inj_on_Abs_pnat RS inj_onD,
  28.217 -     inj_Rep_pnat RS injD],simpset() addsimps [sum_Rep_pnat]));
  28.218 -qed "pnat_add_left_cancel";
  28.219 -
  28.220 -Goalw [pnat_add_def] "(y + (x::pnat) = z + x) = (y = z)";
  28.221 -by (auto_tac (claset() addDs [inj_on_Abs_pnat RS inj_onD,
  28.222 -     inj_Rep_pnat RS injD],simpset() addsimps [sum_Rep_pnat]));
  28.223 -qed "pnat_add_right_cancel";
  28.224 -
  28.225 -Goalw [pnat_add_def] "!(y::pnat). x + y ~= x";
  28.226 -by (rtac (Rep_pnat_inverse RS subst) 1);
  28.227 -by (auto_tac (claset() addDs [inj_on_Abs_pnat RS inj_onD] 
  28.228 -  	               addSDs [add_eq_self_zero],
  28.229 -	      simpset() addsimps [sum_Rep_pnat, Rep_pnat,Abs_pnat_inverse,
  28.230 -				  Rep_pnat_gt_zero RS less_not_refl2]));
  28.231 -qed "pnat_no_add_ident";
  28.232 -
  28.233 -
  28.234 -(***) (***) (***) (***) (***) (***) (***) (***) (***)
  28.235 -
  28.236 -  (*** pnat_less ***)
  28.237 -
  28.238 -Goalw [pnat_less_def] "~ y < (y::pnat)";
  28.239 -by Auto_tac;
  28.240 -qed "pnat_less_not_refl";
  28.241 -
  28.242 -bind_thm ("pnat_less_irrefl",pnat_less_not_refl RS notE);
  28.243 -
  28.244 -Goalw [pnat_less_def] 
  28.245 -     "x < (y::pnat) ==> x ~= y";
  28.246 -by Auto_tac;
  28.247 -qed "pnat_less_not_refl2";
  28.248 -
  28.249 -Goal "~ Rep_pnat y < 0";
  28.250 -by Auto_tac;
  28.251 -qed "Rep_pnat_not_less0";
  28.252 -
  28.253 -(*** Rep_pnat < 0 ==> P ***)
  28.254 -bind_thm ("Rep_pnat_less_zeroE",Rep_pnat_not_less0 RS notE);
  28.255 -
  28.256 -Goal "~ Rep_pnat y < Suc 0";
  28.257 -by (auto_tac (claset(),simpset() addsimps [less_Suc_eq,
  28.258 -                  Rep_pnat_gt_zero,less_not_refl2]));
  28.259 -qed "Rep_pnat_not_less_one";
  28.260 -
  28.261 -(*** Rep_pnat < 1 ==> P ***)
  28.262 -bind_thm ("Rep_pnat_less_oneE",Rep_pnat_not_less_one RS notE);
  28.263 -
  28.264 -Goalw [pnat_less_def] 
  28.265 -     "x < (y::pnat) ==> Rep_pnat y ~= Suc 0";
  28.266 -by (auto_tac (claset(),simpset() 
  28.267 -    addsimps [Rep_pnat_not_less_one] delsimps [less_Suc0]));
  28.268 -qed "Rep_pnat_gt_implies_not0";
  28.269 -
  28.270 -Goalw [pnat_less_def] 
  28.271 -      "(x::pnat) < y | x = y | y < x";
  28.272 -by (cut_facts_tac [less_linear] 1);
  28.273 -by (fast_tac (claset() addIs [inj_Rep_pnat RS injD]) 1);
  28.274 -qed "pnat_less_linear";
  28.275 -
  28.276 -Goalw [le_def] "Suc 0 <= Rep_pnat x";
  28.277 -by (rtac Rep_pnat_not_less_one 1);
  28.278 -qed "Rep_pnat_le_one";
  28.279 -
  28.280 -Goalw [pnat_less_def]
  28.281 -     "!! (z1::nat). z1 < z2  ==> EX z3. z1 + Rep_pnat z3 = z2";
  28.282 -by (dtac less_imp_add_positive 1);
  28.283 -by (force_tac (claset() addSIs [Abs_pnat_inverse],
  28.284 -	       simpset() addsimps [Collect_pnat_gt_0]) 1);
  28.285 -qed "lemma_less_ex_sum_Rep_pnat";
  28.286 -
  28.287 -
  28.288 -   (*** pnat_le ***)
  28.289 -
  28.290 -(*** alternative definition for pnat_le ***)
  28.291 -Goalw [pnat_le_def,pnat_less_def] 
  28.292 -      "((m::pnat) <= n) = (Rep_pnat m <= Rep_pnat n)";
  28.293 -by (auto_tac (claset() addSIs [leI] addSEs [leD],simpset()));
  28.294 -qed "pnat_le_iff_Rep_pnat_le";
  28.295 -
  28.296 -Goal "!!k::pnat. (k + m <= k + n) = (m<=n)";
  28.297 -by (simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  28.298 -                           sum_Rep_pnat_sum RS sym]) 1);
  28.299 -qed "pnat_add_left_cancel_le";
  28.300 -
  28.301 -Goalw [pnat_less_def] "!!k::pnat. (k + m < k + n) = (m<n)";
  28.302 -by (simp_tac (simpset() addsimps [sum_Rep_pnat_sum RS sym]) 1);
  28.303 -qed "pnat_add_left_cancel_less";
  28.304 -
  28.305 -Addsimps [pnat_add_left_cancel, pnat_add_right_cancel,
  28.306 -  pnat_add_left_cancel_le, pnat_add_left_cancel_less];
  28.307 -
  28.308 -Goalw [pnat_less_def] "i+j < (k::pnat) ==> i<k";
  28.309 -by (auto_tac (claset() addEs [add_lessD1],
  28.310 -    simpset() addsimps [sum_Rep_pnat_sum RS sym]));
  28.311 -qed "pnat_add_lessD1";
  28.312 -
  28.313 -Goal "!!i::pnat. ~ (i+j < i)";
  28.314 -by (rtac  notI 1);
  28.315 -by (etac (pnat_add_lessD1 RS pnat_less_irrefl) 1);
  28.316 -qed "pnat_not_add_less1";
  28.317 -
  28.318 -Goal "!!i::pnat. ~ (j+i < i)";
  28.319 -by (simp_tac (simpset() addsimps [pnat_add_commute, pnat_not_add_less1]) 1);
  28.320 -qed "pnat_not_add_less2";
  28.321 -
  28.322 -AddIffs [pnat_not_add_less1, pnat_not_add_less2];
  28.323 -
  28.324 -Goal "m + k <= n --> m <= (n::pnat)";
  28.325 -by (simp_tac (simpset() addsimps [pnat_le_iff_Rep_pnat_le,
  28.326 -                                  sum_Rep_pnat_sum RS sym]) 1);
  28.327 -qed_spec_mp "pnat_add_leD1";
  28.328 -
  28.329 -Goal "!!n::pnat. m + k <= n ==> k <= n";
  28.330 -by (full_simp_tac (simpset() addsimps [pnat_add_commute]) 1);
  28.331 -by (etac pnat_add_leD1 1);
  28.332 -qed_spec_mp "pnat_add_leD2";
  28.333 -
  28.334 -Goal "!!n::pnat. m + k <= n ==> m <= n & k <= n";
  28.335 -by (blast_tac (claset() addDs [pnat_add_leD1, pnat_add_leD2]) 1);
  28.336 -bind_thm ("pnat_add_leE", result() RS conjE);
  28.337 -
  28.338 -Goalw [pnat_less_def] 
  28.339 -      "!!k l::pnat. [| k < l; m + l = k + n |] ==> m < n";
  28.340 -by (rtac less_add_eq_less 1 THEN assume_tac 1);
  28.341 -by (auto_tac (claset(),simpset() addsimps [sum_Rep_pnat_sum]));
  28.342 -qed "pnat_less_add_eq_less";
  28.343 -
  28.344 -(* ordering on positive naturals in terms of existence of sum *)
  28.345 -(* could provide alternative definition -- Gleason *)
  28.346 -Goalw [pnat_less_def,pnat_add_def] 
  28.347 -      "((z1::pnat) < z2) = (EX z3. z1 + z3 = z2)";
  28.348 -by (rtac iffI 1);
  28.349 -by (res_inst_tac [("t","z2")] (Rep_pnat_inverse RS subst) 1);
  28.350 -by (dtac lemma_less_ex_sum_Rep_pnat 1);
  28.351 -by (etac exE 1 THEN res_inst_tac [("x","z3")] exI 1);
  28.352 -by (auto_tac (claset(),simpset() addsimps [sum_Rep_pnat_sum,Rep_pnat_inverse]));
  28.353 -by (res_inst_tac [("t","Rep_pnat z1")] (add_0_right RS subst) 1);
  28.354 -by (auto_tac (claset(),simpset() addsimps [sum_Rep_pnat_sum RS sym,
  28.355 -               Rep_pnat_gt_zero] delsimps [add_0_right]));
  28.356 -qed "pnat_less_iff";
  28.357 -
  28.358 -Goal "(EX (x::pnat). z1 + x = z2) | z1 = z2 \
  28.359 -\          |(EX x. z2 + x = z1)";
  28.360 -by (cut_facts_tac [pnat_less_linear] 1);
  28.361 -by (asm_full_simp_tac (simpset() addsimps [pnat_less_iff]) 1);
  28.362 -qed "pnat_linear_Ex_eq";
  28.363 -
  28.364 -Goal "!!(x::pnat). x + y = z ==> x < z";
  28.365 -by (rtac (pnat_less_iff RS iffD2) 1);
  28.366 -by (Blast_tac 1);
  28.367 -qed "pnat_eq_lessI";
  28.368 -
  28.369 -(*** Monotonicity of Addition ***)
  28.370 -
  28.371 -Goal "1 * Rep_pnat n = Rep_pnat n";
  28.372 -by (Asm_simp_tac 1);
  28.373 -qed "Rep_pnat_mult_1";
  28.374 -
  28.375 -Goal "Rep_pnat n * 1 = Rep_pnat n";
  28.376 -by (Asm_simp_tac 1);
  28.377 -qed "Rep_pnat_mult_1_right";
  28.378 -
  28.379 -Goal "(Rep_pnat x * Rep_pnat y): pnat";
  28.380 -by (cut_facts_tac [[Rep_pnat_gt_zero,
  28.381 -    Rep_pnat_gt_zero] MRS mult_less_mono1,Collect_pnat_gt_0] 1);
  28.382 -by (etac ssubst 1);
  28.383 -by Auto_tac;
  28.384 -qed "mult_Rep_pnat";
  28.385 -
  28.386 -Goalw [pnat_mult_def] 
  28.387 -      "Rep_pnat x * Rep_pnat y = Rep_pnat (x * y)";
  28.388 -by (simp_tac (simpset() addsimps [mult_Rep_pnat RS Abs_pnat_inverse]) 1);
  28.389 -qed "mult_Rep_pnat_mult";
  28.390 -
  28.391 -Goalw [pnat_mult_def] "m * n = n * (m::pnat)";
  28.392 -by (full_simp_tac (simpset() addsimps [mult_commute]) 1);
  28.393 -qed "pnat_mult_commute";
  28.394 -
  28.395 -Goalw [pnat_mult_def,pnat_add_def] "(m + n)*k = (m*k) + ((n*k)::pnat)";
  28.396 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.397 -by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  28.398 -                Abs_pnat_inverse,sum_Rep_pnat RS 
  28.399 -             Abs_pnat_inverse, add_mult_distrib]) 1);
  28.400 -qed "pnat_add_mult_distrib";
  28.401 -
  28.402 -Goalw [pnat_mult_def,pnat_add_def] "k*(m + n) = (k*m) + ((k*n)::pnat)";
  28.403 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.404 -by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  28.405 -                Abs_pnat_inverse,sum_Rep_pnat RS 
  28.406 -             Abs_pnat_inverse, add_mult_distrib2]) 1);
  28.407 -qed "pnat_add_mult_distrib2";
  28.408 -
  28.409 -Goalw [pnat_mult_def] 
  28.410 -      "(x * y) * z = x * (y * (z::pnat))";
  28.411 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.412 -by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  28.413 -                Abs_pnat_inverse,mult_assoc]) 1);
  28.414 -qed "pnat_mult_assoc";
  28.415 -
  28.416 -Goalw [pnat_mult_def] "x * (y * z) = y * (x * (z::pnat))";
  28.417 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.418 -by (simp_tac (simpset() addsimps [mult_Rep_pnat RS 
  28.419 -          Abs_pnat_inverse,mult_left_commute]) 1);
  28.420 -qed "pnat_mult_left_commute";
  28.421 -
  28.422 -Goalw [pnat_mult_def] "x * (Abs_pnat (Suc 0)) = x";
  28.423 -by (full_simp_tac (simpset() addsimps [one_RepI RS Abs_pnat_inverse,
  28.424 -                   Rep_pnat_inverse]) 1);
  28.425 -qed "pnat_mult_1";
  28.426 -
  28.427 -Goal "Abs_pnat (Suc 0) * x = x";
  28.428 -by (full_simp_tac (simpset() addsimps [pnat_mult_1,
  28.429 -                   pnat_mult_commute]) 1);
  28.430 -qed "pnat_mult_1_left";
  28.431 -
  28.432 -(*Multiplication is an AC-operator*)
  28.433 -bind_thms ("pnat_mult_ac", 
  28.434 -	   [pnat_mult_assoc, pnat_mult_commute, pnat_mult_left_commute]);
  28.435 -
  28.436 -
  28.437 -Goal "!!i::pnat. i<j ==> k*i < k*j";
  28.438 -by (asm_full_simp_tac (simpset() addsimps [pnat_less_def,
  28.439 -    mult_Rep_pnat_mult RS sym,Rep_pnat_gt_zero,mult_less_mono2]) 1);
  28.440 -qed "pnat_mult_less_mono2";
  28.441 -
  28.442 -Goal "!!i::pnat. i<j ==> i*k < j*k";
  28.443 -by (dtac pnat_mult_less_mono2 1);
  28.444 -by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [pnat_mult_commute])));
  28.445 -qed "pnat_mult_less_mono1";
  28.446 -
  28.447 -Goalw [pnat_less_def] "(m*(k::pnat) < n*k) = (m<n)";
  28.448 -by (asm_full_simp_tac (simpset() addsimps [mult_Rep_pnat_mult 
  28.449 -              RS sym,Rep_pnat_gt_zero]) 1);
  28.450 -qed "pnat_mult_less_cancel2";
  28.451 -
  28.452 -Goalw [pnat_less_def] "((k::pnat)*m < k*n) = (m<n)";
  28.453 -by (asm_full_simp_tac (simpset() addsimps [mult_Rep_pnat_mult 
  28.454 -              RS sym,Rep_pnat_gt_zero]) 1);
  28.455 -qed "pnat_mult_less_cancel1";
  28.456 -
  28.457 -Addsimps [pnat_mult_less_cancel1, pnat_mult_less_cancel2];
  28.458 -
  28.459 -Goalw [pnat_mult_def]  "(m*(k::pnat) = n*k) = (m=n)";
  28.460 -by (cut_inst_tac [("x","k")] Rep_pnat_gt_zero 1);
  28.461 -by (auto_tac (claset() addSDs [inj_on_Abs_pnat RS inj_onD,
  28.462 -                               inj_Rep_pnat RS injD] 
  28.463 -                       addIs [mult_Rep_pnat], 
  28.464 -    simpset() addsimps [mult_cancel2]));
  28.465 -qed "pnat_mult_cancel2";
  28.466 -
  28.467 -Goal "((k::pnat)*m = k*n) = (m=n)";
  28.468 -by (rtac (pnat_mult_cancel2 RS subst) 1);
  28.469 -by (auto_tac (claset () addIs [pnat_mult_commute RS subst],simpset()));
  28.470 -qed "pnat_mult_cancel1";
  28.471 -
  28.472 -Addsimps [pnat_mult_cancel1, pnat_mult_cancel2];
  28.473 -
  28.474 -Goal "!!(z1::pnat). z2*z3 = z4*z5  ==> z2*(z1*z3) = z4*(z1*z5)";
  28.475 -by (auto_tac (claset() addIs [pnat_mult_cancel1 RS iffD2],
  28.476 -              simpset() addsimps [pnat_mult_left_commute]));
  28.477 -qed "pnat_same_multI2";
  28.478 -
  28.479 -val [prem] = Goal
  28.480 -    "(!!u. z = Abs_pnat(u) ==> P) ==> P";
  28.481 -by (cut_inst_tac [("x1","z")] 
  28.482 -    (rewrite_rule [pnat_def] (Rep_pnat RS Abs_pnat_inverse)) 1);
  28.483 -by (res_inst_tac [("u","Rep_pnat z")] prem 1);
  28.484 -by (dtac (inj_Rep_pnat RS injD) 1);
  28.485 -by (Asm_simp_tac 1);
  28.486 -qed "eq_Abs_pnat";
  28.487 -
  28.488 -(** embedding of naturals in positive naturals **)
  28.489 -
  28.490 -(* pnat_one_eq! *)
  28.491 -Goalw [pnat_of_nat_def,pnat_one_def]"1 = pnat_of_nat 0";
  28.492 -by (Full_simp_tac 1);
  28.493 -qed "pnat_one_iff";
  28.494 -
  28.495 -Goalw [pnat_of_nat_def,pnat_one_def,
  28.496 -       pnat_add_def] "1 + 1 = pnat_of_nat 1";
  28.497 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.498 -by (auto_tac (claset() addIs [(gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst)],
  28.499 -    simpset()));
  28.500 -qed "pnat_two_eq";
  28.501 -
  28.502 -Goal "inj(pnat_of_nat)";
  28.503 -by (rtac injI 1);
  28.504 -by (rewtac pnat_of_nat_def);
  28.505 -by (dtac (inj_on_Abs_pnat RS inj_onD) 1);
  28.506 -by (auto_tac (claset() addSIs [gt_0_mem_pnat],simpset()));
  28.507 -qed "inj_pnat_of_nat";
  28.508 -
  28.509 -Goal "0 < n + (1::nat)";
  28.510 -by Auto_tac;
  28.511 -qed "nat_add_one_less";
  28.512 -
  28.513 -Goal "0 < n1 + n2 + (1::nat)";
  28.514 -by Auto_tac;
  28.515 -qed "nat_add_one_less1";
  28.516 -
  28.517 -(* this worked with one call to auto_tac before! *)
  28.518 -Goalw [pnat_add_def,pnat_of_nat_def,pnat_one_def] 
  28.519 -      "pnat_of_nat n1 + pnat_of_nat n2 = \
  28.520 -\      pnat_of_nat (n1 + n2) + 1";
  28.521 -by (res_inst_tac [("f","Abs_pnat")] arg_cong 1);
  28.522 -by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 1);
  28.523 -by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 2);
  28.524 -by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 3);
  28.525 -by (rtac (gt_0_mem_pnat RS Abs_pnat_inverse RS ssubst) 4);
  28.526 -by (auto_tac (claset(),
  28.527 -	      simpset() addsimps [sum_Rep_pnat_sum,
  28.528 -				  nat_add_one_less,nat_add_one_less1]));
  28.529 -qed "pnat_of_nat_add";
  28.530 -
  28.531 -Goalw [pnat_of_nat_def,pnat_less_def] 
  28.532 -       "(n < m) = (pnat_of_nat n < pnat_of_nat m)";
  28.533 -by (auto_tac (claset(),simpset() 
  28.534 -    addsimps [Abs_pnat_inverse,Collect_pnat_gt_0]));
  28.535 -qed "pnat_of_nat_less_iff";
  28.536 -Addsimps [pnat_of_nat_less_iff RS sym];
  28.537 -
  28.538 -Goalw [pnat_mult_def,pnat_of_nat_def] 
  28.539 -      "pnat_of_nat n1 * pnat_of_nat n2 = \
  28.540 -\      pnat_of_nat (n1 * n2 + n1 + n2)";
  28.541 -by (auto_tac (claset(),simpset() addsimps [mult_Rep_pnat_mult,
  28.542 -    pnat_add_def,Abs_pnat_inverse,gt_0_mem_pnat]));
  28.543 -qed "pnat_of_nat_mult";
    29.1 --- a/src/HOL/Real/PNat.thy	Tue Jan 27 09:44:14 2004 +0100
    29.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.3 @@ -1,45 +0,0 @@
    29.4 -(*  Title       : PNat.thy
    29.5 -    ID          : $Id$
    29.6 -    Author      : Jacques D. Fleuriot
    29.7 -    Copyright   : 1998  University of Cambridge
    29.8 -    Description : The positive naturals
    29.9 -*) 
   29.10 -
   29.11 -
   29.12 -PNat = Main +
   29.13 -
   29.14 -typedef
   29.15 -  pnat = "lfp(%X. {Suc 0} Un Suc`X)"   (lfp_def)
   29.16 -
   29.17 -instance
   29.18 -   pnat :: {ord, one, plus, times}
   29.19 -
   29.20 -consts
   29.21 -
   29.22 -  pSuc       :: pnat => pnat
   29.23 -
   29.24 -constdefs
   29.25 -  
   29.26 -  pnat_of_nat  :: nat => pnat           
   29.27 -  "pnat_of_nat n     == Abs_pnat(n + 1)"
   29.28 - 
   29.29 -defs
   29.30 -
   29.31 -  pnat_one_def      
   29.32 -       "1 == Abs_pnat(Suc 0)"
   29.33 -  pnat_Suc_def      
   29.34 -       "pSuc == (%n. Abs_pnat(Suc(Rep_pnat(n))))"
   29.35 -
   29.36 -  pnat_add_def
   29.37 -       "x + y == Abs_pnat(Rep_pnat(x) +  Rep_pnat(y))"
   29.38 -
   29.39 -  pnat_mult_def
   29.40 -       "x * y == Abs_pnat(Rep_pnat(x) * Rep_pnat(y))"
   29.41 -
   29.42 -  pnat_less_def
   29.43 -       "x < (y::pnat) == Rep_pnat(x) < Rep_pnat(y)"
   29.44 -
   29.45 -  pnat_le_def
   29.46 -       "x <= (y::pnat) ==  ~(y < x)"
   29.47 -
   29.48 -end
    30.1 --- a/src/HOL/Real/PRat.ML	Tue Jan 27 09:44:14 2004 +0100
    30.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.3 @@ -1,805 +0,0 @@
    30.4 -(*  Title       : PRat.ML
    30.5 -    ID          : $Id$
    30.6 -    Author      : Jacques D. Fleuriot
    30.7 -    Copyright   : 1998  University of Cambridge
    30.8 -    Description : The positive rationals
    30.9 -*) 
   30.10 -
   30.11 -(*** Many theorems similar to those in theory Integ ***)
   30.12 -(*** Proving that ratrel is an equivalence relation ***)
   30.13 -
   30.14 -Goal "[| (x1::pnat) * y2 = x2 * y1; x2 * y3 = x3 * y2 |] \
   30.15 -\            ==> x1 * y3 = x3 * y1";        
   30.16 -by (res_inst_tac [("k1","y2")] (pnat_mult_cancel1 RS iffD1) 1);
   30.17 -by (auto_tac (claset(), simpset() addsimps [pnat_mult_assoc RS sym]));
   30.18 -by (auto_tac (claset(),simpset() addsimps [pnat_mult_commute]));
   30.19 -by (dres_inst_tac [("s","x2 * y3")] sym 1);
   30.20 -by (asm_simp_tac (simpset() addsimps [pnat_mult_left_commute,
   30.21 -    pnat_mult_commute]) 1);
   30.22 -qed "prat_trans_lemma";
   30.23 -
   30.24 -(** Natural deduction for ratrel **)
   30.25 -
   30.26 -Goalw [ratrel_def]
   30.27 -    "(((x1,y1),(x2,y2)): ratrel) = (x1 * y2 = x2 * y1)";
   30.28 -by (Fast_tac 1);
   30.29 -qed "ratrel_iff";
   30.30 -
   30.31 -Goalw [ratrel_def]
   30.32 -    "[| x1 * y2 = x2 * y1 |] ==> ((x1,y1),(x2,y2)): ratrel";
   30.33 -by (Fast_tac  1);
   30.34 -qed "ratrelI";
   30.35 -
   30.36 -Goalw [ratrel_def]
   30.37 -  "p: ratrel --> (EX x1 y1 x2 y2. \
   30.38 -\                  p = ((x1,y1),(x2,y2)) & x1 *y2 = x2 *y1)";
   30.39 -by (Fast_tac 1);
   30.40 -qed "ratrelE_lemma";
   30.41 -
   30.42 -val [major,minor] = Goal
   30.43 -  "[| p: ratrel;  \
   30.44 -\     !!x1 y1 x2 y2. [| p = ((x1,y1),(x2,y2));  x1*y2 = x2*y1 \
   30.45 -\                    |] ==> Q |] ==> Q";
   30.46 -by (cut_facts_tac [major RS (ratrelE_lemma RS mp)] 1);
   30.47 -by (REPEAT (eresolve_tac [asm_rl,exE,conjE,minor] 1));
   30.48 -qed "ratrelE";
   30.49 -
   30.50 -AddSIs [ratrelI];
   30.51 -AddSEs [ratrelE];
   30.52 -
   30.53 -Goal "(x,x): ratrel";
   30.54 -by (pair_tac "x" 1);
   30.55 -by (rtac ratrelI 1);
   30.56 -by (rtac refl 1);
   30.57 -qed "ratrel_refl";
   30.58 -
   30.59 -Goalw [equiv_def, refl_def, sym_def, trans_def]
   30.60 -    "equiv UNIV ratrel";
   30.61 -by (fast_tac (claset() addSIs [ratrel_refl] 
   30.62 -                       addSEs [sym, prat_trans_lemma]) 1);
   30.63 -qed "equiv_ratrel";
   30.64 -
   30.65 -bind_thm ("equiv_ratrel_iff", [equiv_ratrel, UNIV_I, UNIV_I] MRS eq_equiv_class_iff);
   30.66 -
   30.67 -Goalw  [prat_def,ratrel_def,quotient_def] "ratrel``{(x,y)}:prat";
   30.68 -by (Blast_tac 1);
   30.69 -qed "ratrel_in_prat";
   30.70 -
   30.71 -Goal "inj_on Abs_prat prat";
   30.72 -by (rtac inj_on_inverseI 1);
   30.73 -by (etac Abs_prat_inverse 1);
   30.74 -qed "inj_on_Abs_prat";
   30.75 -
   30.76 -Addsimps [equiv_ratrel_iff,inj_on_Abs_prat RS inj_on_iff,
   30.77 -          ratrel_iff, ratrel_in_prat, Abs_prat_inverse];
   30.78 -
   30.79 -Addsimps [equiv_ratrel RS eq_equiv_class_iff];
   30.80 -bind_thm ("eq_ratrelD", equiv_ratrel RSN (2,eq_equiv_class));
   30.81 -
   30.82 -Goal "inj(Rep_prat)";
   30.83 -by (rtac inj_inverseI 1);
   30.84 -by (rtac Rep_prat_inverse 1);
   30.85 -qed "inj_Rep_prat";
   30.86 -
   30.87 -(** prat_of_pnat: the injection from pnat to prat **)
   30.88 -Goal "inj(prat_of_pnat)";
   30.89 -by (rtac injI 1);
   30.90 -by (rewtac prat_of_pnat_def);
   30.91 -by (dtac (inj_on_Abs_prat RS inj_onD) 1);
   30.92 -by (REPEAT (rtac ratrel_in_prat 1));
   30.93 -by (dtac eq_equiv_class 1);
   30.94 -by (rtac equiv_ratrel 1);
   30.95 -by (Fast_tac 1);
   30.96 -by Safe_tac;
   30.97 -by (Asm_full_simp_tac 1);
   30.98 -qed "inj_prat_of_pnat";
   30.99 -
  30.100 -val [prem] = Goal
  30.101 -    "(!!x y. z = Abs_prat(ratrel``{(x,y)}) ==> P) ==> P";
  30.102 -by (res_inst_tac [("x1","z")] 
  30.103 -    (rewrite_rule [prat_def] Rep_prat RS quotientE) 1);
  30.104 -by (dres_inst_tac [("f","Abs_prat")] arg_cong 1);
  30.105 -by (res_inst_tac [("p","x")] PairE 1);
  30.106 -by (rtac prem 1);
  30.107 -by (asm_full_simp_tac (simpset() addsimps [Rep_prat_inverse]) 1);
  30.108 -qed "eq_Abs_prat";
  30.109 -
  30.110 -(**** qinv: inverse on prat ****)
  30.111 -
  30.112 -Goalw [congruent_def] "congruent ratrel (%(x,y). ratrel``{(y,x)})";
  30.113 -by (auto_tac (claset(), simpset() addsimps [pnat_mult_commute]));  
  30.114 -qed "qinv_congruent";
  30.115 -
  30.116 -Goalw [qinv_def]
  30.117 -      "qinv (Abs_prat(ratrel``{(x,y)})) = Abs_prat(ratrel `` {(y,x)})";
  30.118 -by (simp_tac (simpset() addsimps 
  30.119 -	      [equiv_ratrel RS UN_equiv_class, qinv_congruent]) 1);
  30.120 -qed "qinv";
  30.121 -
  30.122 -Goal "qinv (qinv z) = z";
  30.123 -by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  30.124 -by (asm_simp_tac (simpset() addsimps [qinv]) 1);
  30.125 -qed "qinv_qinv";
  30.126 -
  30.127 -Goal "inj(qinv)";
  30.128 -by (rtac injI 1);
  30.129 -by (dres_inst_tac [("f","qinv")] arg_cong 1);
  30.130 -by (asm_full_simp_tac (simpset() addsimps [qinv_qinv]) 1);
  30.131 -qed "inj_qinv";
  30.132 -
  30.133 -Goalw [prat_of_pnat_def] 
  30.134 -      "qinv(prat_of_pnat  (Abs_pnat (Suc 0))) = prat_of_pnat (Abs_pnat (Suc 0))";
  30.135 -by (simp_tac (simpset() addsimps [qinv]) 1);
  30.136 -qed "qinv_1";
  30.137 -
  30.138 -Goal "!!(x1::pnat). [| x1 * y2 = x2 * y1 |] ==> \
  30.139 -\     (x * y1 + x1 * ya) * (ya * y2) = (x * y2 + x2 * ya) * (ya * y1)";
  30.140 -by (auto_tac (claset() addSIs [pnat_same_multI2],
  30.141 -       simpset() addsimps [pnat_add_mult_distrib,
  30.142 -       pnat_mult_assoc]));
  30.143 -by (res_inst_tac [("n1","y2")] (pnat_mult_commute RS subst) 1);
  30.144 -by (auto_tac (claset() addIs [pnat_add_left_cancel RS iffD2],simpset() addsimps pnat_mult_ac));
  30.145 -by (res_inst_tac [("y1","x1")] (pnat_mult_left_commute RS subst) 1);
  30.146 -by (res_inst_tac [("y1","x1")] (pnat_mult_left_commute RS ssubst) 1);
  30.147 -by (auto_tac (claset(),simpset() addsimps [pnat_mult_assoc RS sym]));
  30.148 -qed "prat_add_congruent2_lemma";
  30.149 -
  30.150 -Goal "congruent2 ratrel (%p1 p2.                  \
  30.151 -\        (%(x1,y1). (%(x2,y2). ratrel``{(x1*y2 + x2*y1, y1*y2)}) p2) p1)";
  30.152 -by (rtac (equiv_ratrel RS congruent2_commuteI) 1);
  30.153 -by (auto_tac (claset() delrules [equalityI],
  30.154 -              simpset() addsimps [prat_add_congruent2_lemma]));
  30.155 -by (asm_simp_tac (simpset() addsimps [pnat_mult_commute,pnat_add_commute]) 1);
  30.156 -qed "prat_add_congruent2";
  30.157 -
  30.158 -Goalw [prat_add_def]
  30.159 -   "Abs_prat((ratrel``{(x1,y1)})) + Abs_prat((ratrel``{(x2,y2)})) =   \
  30.160 -\   Abs_prat(ratrel `` {(x1*y2 + x2*y1, y1*y2)})";
  30.161 -by (simp_tac (simpset() addsimps [UN_UN_split_split_eq, prat_add_congruent2, 
  30.162 -				  equiv_ratrel RS UN_equiv_class2]) 1);
  30.163 -qed "prat_add";
  30.164 -
  30.165 -Goal "(z::prat) + w = w + z";
  30.166 -by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  30.167 -by (res_inst_tac [("z","w")] eq_Abs_prat 1);
  30.168 -by (asm_simp_tac
  30.169 -    (simpset() addsimps [prat_add] @ pnat_add_ac @ pnat_mult_ac) 1);
  30.170 -qed "prat_add_commute";
  30.171 -
  30.172 -Goal "((z1::prat) + z2) + z3 = z1 + (z2 + z3)";
  30.173 -by (res_inst_tac [("z","z1")] eq_Abs_prat 1);
  30.174 -by (res_inst_tac [("z","z2")] eq_Abs_prat 1);
  30.175 -by (res_inst_tac [("z","z3")] eq_Abs_prat 1);
  30.176 -by (asm_simp_tac (simpset() addsimps [pnat_add_mult_distrib2,prat_add] @ 
  30.177 -		                     pnat_add_ac @ pnat_mult_ac) 1);
  30.178 -qed "prat_add_assoc";
  30.179 -
  30.180 -(*For AC rewriting*)
  30.181 -Goal "(z1::prat) + (z2 + z3) = z2 + (z1 + z3)";
  30.182 -by(rtac ([prat_add_assoc,prat_add_commute] MRS
  30.183 -         read_instantiate[("f","op +")](thm"mk_left_commute")) 1);
  30.184 -qed "prat_add_left_commute";
  30.185 -
  30.186 -(* Positive Rational addition is an AC operator *)
  30.187 -bind_thms ("prat_add_ac", [prat_add_assoc, prat_add_commute, prat_add_left_commute]);
  30.188 -
  30.189 -
  30.190 -(*** Congruence property for multiplication ***)
  30.191 -
  30.192 -Goalw [congruent2_def]
  30.193 -    "congruent2 ratrel (%p1 p2.                  \
  30.194 -\         (%(x1,y1). (%(x2,y2). ratrel``{(x1*x2, y1*y2)}) p2) p1)";
  30.195 -(*Proof via congruent2_commuteI seems longer*)
  30.196 -by (Clarify_tac 1);
  30.197 -by (asm_simp_tac (simpset() addsimps [pnat_mult_assoc]) 1);
  30.198 -(*The rest should be trivial, but rearranging terms is hard*)
  30.199 -by (res_inst_tac [("x1","x1a")] (pnat_mult_left_commute RS ssubst) 1);
  30.200 -by (asm_simp_tac (simpset() addsimps [pnat_mult_assoc RS sym]) 1);
  30.201 -by (asm_simp_tac (simpset() addsimps pnat_mult_ac) 1);
  30.202 -qed "pnat_mult_congruent2";
  30.203 -
  30.204 -Goalw [prat_mult_def]
  30.205 -  "Abs_prat(ratrel``{(x1,y1)}) * Abs_prat(ratrel``{(x2,y2)}) = \
  30.206 -\  Abs_prat(ratrel``{(x1*x2, y1*y2)})";
  30.207 -by (asm_simp_tac 
  30.208 -    (simpset() addsimps [UN_UN_split_split_eq, pnat_mult_congruent2,
  30.209 -			 equiv_ratrel RS UN_equiv_class2]) 1);
  30.210 -qed "prat_mult";
  30.211 -
  30.212 -Goal "(z::prat) * w = w * z";
  30.213 -by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  30.214 -by (res_inst_tac [("z","w")] eq_Abs_prat 1);
  30.215 -by (asm_simp_tac (simpset() addsimps pnat_mult_ac @ [prat_mult]) 1);
  30.216 -qed "prat_mult_commute";
  30.217 -
  30.218 -Goal "((z1::prat) * z2) * z3 = z1 * (z2 * z3)";
  30.219 -by (res_inst_tac [("z","z1")] eq_Abs_prat 1);
  30.220 -by (res_inst_tac [("z","z2")] eq_Abs_prat 1);
  30.221 -by (res_inst_tac [("z","z3")] eq_Abs_prat 1);
  30.222 -by (asm_simp_tac (simpset() addsimps [prat_mult, pnat_mult_assoc]) 1);
  30.223 -qed "prat_mult_assoc";
  30.224 -
  30.225 -(*For AC rewriting*)
  30.226 -Goal "(x::prat)*(y*z)=y*(x*z)";
  30.227 -by(rtac ([prat_mult_assoc,prat_mult_commute] MRS
  30.228 -         read_instantiate[("f","op *")](thm"mk_left_commute")) 1);
  30.229 -qed "prat_mult_left_commute";
  30.230 -
  30.231 -(*Positive Rational multiplication is an AC operator*)
  30.232 -bind_thms ("prat_mult_ac", [prat_mult_assoc,
  30.233 -                    prat_mult_commute,prat_mult_left_commute]);
  30.234 -
  30.235 -Goalw [prat_of_pnat_def] 
  30.236 -      "(prat_of_pnat (Abs_pnat (Suc 0))) * z = z";
  30.237 -by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  30.238 -by (asm_full_simp_tac (simpset() addsimps [prat_mult] @ pnat_mult_ac) 1);
  30.239 -qed "prat_mult_1";
  30.240 -
  30.241 -Goalw [prat_of_pnat_def] 
  30.242 -      "z * (prat_of_pnat (Abs_pnat (Suc 0))) = z";
  30.243 -by (res_inst_tac [("z","z")] eq_Abs_prat 1);
  30.244 -by (asm_full_simp_tac (simpset() addsimps [prat_mult] @ pnat_mult_ac) 1);
  30.245 -qed "prat_mult_1_right";
  30.246 -
  30.247 -Goalw [prat_of_pnat_def] 
  30.248 -      "prat_of_pnat ((z1::pnat) + z2) = \
  30.249 -\      prat_of_pnat z1 + prat_of_pnat z2";
  30.250 -by (asm_simp_tac (simpset() addsimps [prat_add,
  30.251 -				      pnat_add_mult_distrib,pnat_mult_1]) 1);
  30.252 -qed "prat_of_pnat_add";
  30.253 -
  30.254 -Goalw [prat_of_pnat_def] 
  30.255 -      "prat_of_pnat ((z1::pnat) * z2) = \
  30.256 -\      prat_of_pnat z1 * prat_of_pnat z2";
  30.257 -by (asm_simp_tac (simpset() addsimps [prat_mult, pnat_mult_1]) 1);
  30.258 -qed "prat_of_pnat_mult";
  30.259 -
  30.260 -(*** prat_mult and qinv ***)
  30.261 -
  30.262 -Goalw [prat_def,prat_of_pnat_def] 
  30.263 -      "qinv (q) * q = prat_of_pnat (Abs_pnat (Suc 0))";
  30.264 -by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  30.265 -by (asm_full_simp_tac (simpset() addsimps [qinv,
  30.266 -        prat_mult,pnat_mult_1,pnat_mult_1_left, pnat_mult_commute]) 1);
  30.267 -qed "prat_mult_qinv";
  30.268 -
  30.269 -Goal "q * qinv (q) = prat_of_pnat (Abs_pnat (Suc 0))";
  30.270 -by (rtac (prat_mult_commute RS subst) 1);
  30.271 -by (simp_tac (simpset() addsimps [prat_mult_qinv]) 1);
  30.272 -qed "prat_mult_qinv_right";
  30.273 -
  30.274 -Goal "EX y. (x::prat) * y = prat_of_pnat (Abs_pnat (Suc 0))";
  30.275 -by (fast_tac (claset() addIs [prat_mult_qinv_right]) 1);
  30.276 -qed "prat_qinv_ex";
  30.277 -
  30.278 -Goal "EX! y. (x::prat) * y = prat_of_pnat (Abs_pnat (Suc 0))";
  30.279 -by (auto_tac (claset() addIs [prat_mult_qinv_right],simpset()));
  30.280 -by (dres_inst_tac [("f","%x. ya*x")] arg_cong 1);
  30.281 -by (asm_full_simp_tac (simpset() addsimps [prat_mult_assoc RS sym]) 1);
  30.282 -by (asm_full_simp_tac (simpset() addsimps [prat_mult_commute,
  30.283 -    prat_mult_1,prat_mult_1_right]) 1);
  30.284 -qed "prat_qinv_ex1";
  30.285 -
  30.286 -Goal "EX! y. y * (x::prat) = prat_of_pnat (Abs_pnat (Suc 0))";
  30.287 -by (auto_tac (claset() addIs [prat_mult_qinv],simpset()));
  30.288 -by (dres_inst_tac [("f","%x. x*ya")] arg_cong 1);
  30.289 -by (asm_full_simp_tac (simpset() addsimps [prat_mult_assoc]) 1);
  30.290 -by (asm_full_simp_tac (simpset() addsimps [prat_mult_commute,
  30.291 -    prat_mult_1,prat_mult_1_right]) 1);
  30.292 -qed "prat_qinv_left_ex1";
  30.293 -
  30.294 -Goal "x * y = prat_of_pnat (Abs_pnat (Suc 0)) ==> x = qinv y";
  30.295 -by (cut_inst_tac [("q","y")] prat_mult_qinv 1);
  30.296 -by (res_inst_tac [("x1","y")] (prat_qinv_left_ex1 RS ex1E) 1);
  30.297 -by (Blast_tac 1);
  30.298 -qed "prat_mult_inv_qinv";
  30.299 -
  30.300 -Goal "EX y. x = qinv y";
  30.301 -by (cut_inst_tac [("x","x")] prat_qinv_ex 1);
  30.302 -by (etac exE 1 THEN dtac prat_mult_inv_qinv 1);
  30.303 -by (Fast_tac 1);
  30.304 -qed "prat_as_inverse_ex";
  30.305 -
  30.306 -Goal "qinv(x*y) = qinv(x)*qinv(y)";
  30.307 -by (res_inst_tac [("z","x")] eq_Abs_prat 1);
  30.308 -by (res_inst_tac [("z","y")] eq_Abs_prat 1);
  30.309 -by (auto_tac (claset(),simpset() addsimps [qinv,prat_mult]));
  30.310 -qed "qinv_mult_eq";
  30.311 -
  30.312 -(** Lemmas **)
  30.313 -
  30.314 -Goal "((z1::prat) + z2) * w = (z1 * w) + (z2 * w)";
  30.315 -by (res_inst_tac [("z","z1")] eq_Abs_prat 1);
  30.316 -by (res_inst_tac [("z","z2")] eq_Abs_prat 1);
  30.317 -by (res_inst_tac [("z","w")] eq_Abs_prat 1);
  30.318 -by (asm_simp_tac 
  30.319 -    (simpset() addsimps [pnat_add_mult_distrib2, prat_add, prat_mult] @ 
  30.320 -                        pnat_add_ac @ pnat_mult_ac) 1);
  30.321 -qed "prat_add_mult_distrib";
  30.322 -
  30.323 -val prat_mult_commute'= read_instantiate [("z","w")] prat_mult_commute;
  30.324 -
  30.325 -Goal "(w::prat) * (z1 + z2) = (w * z1) + (w * z2)";
  30.326 -by (simp_tac (simpset() addsimps [prat_mult_commute',prat_add_mult_distrib]) 1);
  30.327 -qed "prat_add_mult_distrib2";
  30.328 -
  30.329 -Addsimps [prat_mult_1, prat_mult_1_right, 
  30.330 -	  prat_mult_qinv, prat_mult_qinv_right];
  30.331 -
  30.332 -      (*** theorems for ordering ***)
  30.333 -(* prove introduction and elimination rules for prat_less *)
  30.334 -
  30.335 -Goalw [prat_less_def]
  30.336 -    "(Q1 < (Q2::prat)) = (EX Q3. Q1 + Q3 = Q2)";
  30.337 -by (Fast_tac 1);
  30.338 -qed "prat_less_iff";
  30.339 -
  30.340 -Goalw [prat_less_def]
  30.341 -      "!!(Q1::prat). Q1 + Q3 = Q2 ==> Q1 < Q2";
  30.342 -by (Fast_tac  1);
  30.343 -qed "prat_lessI";
  30.344 -
  30.345 -(* ordering on positive fractions in terms of existence of sum *)
  30.346 -Goalw [prat_less_def]
  30.347 -      "Q1 < (Q2::prat) --> (EX Q3. Q1 + Q3 = Q2)";
  30.348 -by (Fast_tac 1);
  30.349 -qed "prat_lessE_lemma";
  30.350 -
  30.351 -Goal "!!P. [| Q1 < (Q2::prat); \
  30.352 -\             !! (Q3::prat). Q1 + Q3 = Q2 ==> P |] \
  30.353 -\          ==> P";
  30.354 -by (dtac (prat_lessE_lemma RS mp) 1);
  30.355 -by Auto_tac;
  30.356 -qed "prat_lessE";
  30.357 -
  30.358 -(* qless is a strong order i.e nonreflexive and transitive *)
  30.359 -Goal "!!(q1::prat). [| q1 < q2; q2 < q3 |] ==> q1 < q3";
  30.360 -by (REPEAT(dtac (prat_lessE_lemma RS mp) 1));
  30.361 -by (REPEAT(etac exE 1));
  30.362 -by (hyp_subst_tac 1);
  30.363 -by (res_inst_tac [("Q3.0","Q3 + Q3a")] prat_lessI 1);
  30.364 -by (auto_tac (claset(),simpset() addsimps [prat_add_assoc]));
  30.365 -qed "prat_less_trans";
  30.366 -
  30.367 -Goal "~q < (q::prat)";
  30.368 -by (EVERY1[rtac notI, dtac (prat_lessE_lemma RS mp)]);
  30.369 -by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  30.370 -by (res_inst_tac [("z","Q3")] eq_Abs_prat 1);
  30.371 -by (etac exE 1 THEN res_inst_tac [("z","Q3a")] eq_Abs_prat 1);
  30.372 -by (REPEAT(hyp_subst_tac 1));
  30.373 -by (asm_full_simp_tac (simpset() addsimps [prat_add,
  30.374 -    pnat_no_add_ident,pnat_add_mult_distrib2] @ pnat_mult_ac) 1);
  30.375 -qed "prat_less_not_refl";
  30.376 -
  30.377 -(*** y < y ==> P ***)
  30.378 -bind_thm("prat_less_irrefl",prat_less_not_refl RS notE);
  30.379 -
  30.380 -Goal "!! (q1::prat). q1 < q2 ==> ~ q2 < q1";
  30.381 -by (rtac notI 1);
  30.382 -by (dtac prat_less_trans 1 THEN assume_tac 1);
  30.383 -by (asm_full_simp_tac (simpset() addsimps [prat_less_not_refl]) 1);
  30.384 -qed "prat_less_not_sym";
  30.385 -
  30.386 -(* [| x < y;  ~P ==> y < x |] ==> P *)
  30.387 -bind_thm ("prat_less_asym", prat_less_not_sym RS contrapos_np);
  30.388 -
  30.389 -(* half of positive fraction exists- Gleason p. 120- Proposition 9-2.6(i)*)
  30.390 -Goal "!(q::prat). EX x. x + x = q";
  30.391 -by (rtac allI 1);
  30.392 -by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  30.393 -by (res_inst_tac [("x","Abs_prat (ratrel `` {(x, y+y)})")] exI 1);
  30.394 -by (auto_tac (claset(),
  30.395 -	      simpset() addsimps 
  30.396 -              [prat_add,pnat_mult_assoc RS sym,pnat_add_mult_distrib,
  30.397 -               pnat_add_mult_distrib2]));
  30.398 -qed "lemma_prat_dense";
  30.399 -
  30.400 -Goal "EX (x::prat). x + x = q";
  30.401 -by (res_inst_tac [("z","q")] eq_Abs_prat 1);
  30.402 -by (res_inst_tac [("x","Abs_prat (ratrel `` {(x, y+y)})")] exI 1);
  30.403 -by (auto_tac (claset(),simpset() addsimps 
  30.404 -              [prat_add,pnat_mult_assoc RS sym,pnat_add_mult_distrib,
  30.405 -               pnat_add_mult_distrib2]));
  30.406 -qed "prat_lemma_dense";
  30.407 -
  30.408 -(* there exists a number between any two positive fractions *)
  30.409 -(* Gleason p. 120- Proposition 9-2.6(iv) *)
  30.410 -Goalw [prat_less_def] 
  30.411 -      "!! (q1::prat). q1 < q2 ==> EX x. q1 < x & x < q2";
  30.412 -by (auto_tac (claset() addIs [lemma_prat_dense],simpset()));
  30.413 -by (res_inst_tac [("x","T")] (lemma_prat_dense RS allE) 1);
  30.414 -by (etac exE 1);
  30.415 -by (res_inst_tac [("x","q1 + x")] exI 1);
  30.416 -by (auto_tac (claset() addIs [prat_lemma_dense],
  30.417 -	      simpset() addsimps [prat_add_assoc]));
  30.418 -qed "prat_dense";
  30.419 -
  30.420 -(* ordering of addition for positive fractions *)
  30.421 -Goalw [prat_less_def] "!!(q1::prat). q1 < q2 ==> q1 + x < q2 + x";
  30.422 -by (Step_tac 1);
  30.423 -by (res_inst_tac [("x","T")] exI 1);
  30.424 -by (auto_tac (claset(),simpset() addsimps prat_add_ac));
  30.425 -qed "prat_add_less2_mono1";
  30.426 -
  30.427 -Goal "!!(q1::prat). q1 < q2 ==> x + q1 < x + q2";
  30.428 -by (auto_tac (claset() addIs [prat_add_less2_mono1],
  30.429 -    simpset() addsimps [prat_add_commute]));
  30.430 -qed "prat_add_less2_mono2";
  30.431 -
  30.432 -(* ordering of multiplication for positive fractions *)
  30.433 -Goalw [prat_less_def] 
  30.434 -      "!!(q1::prat). q1 < q2 ==> q1 * x < q2 * x";
  30.435 -by (Step_tac 1);
  30.436 -by (res_inst_tac [("x","T*x")] exI 1);
  30.437 -by (auto_tac (claset(),simpset() addsimps [prat_add_mult_distrib]));
  30.438 -qed "prat_mult_less2_mono1";
  30.439 -
  30.440 -Goal "!!(q1::prat). q1 < q2  ==> x * q1 < x * q2";
  30.441 -by (auto_tac (claset() addDs [prat_mult_less2_mono1],
  30.442 -    simpset() addsimps [prat_mult_commute]));
  30.443 -qed "prat_mult_left_less2_mono1";
  30.444 -
  30.445 -Goal "!!(a1::prat). a1 < a2 ==> a1 * b + a2 * c < a2 * (b + c)";
  30.446 -by (auto_tac (claset() addSIs [prat_add_less2_mono1,prat_mult_less2_mono1],
  30.447 -              simpset() addsimps [prat_add_mult_distrib2]));
  30.448 -qed "lemma_prat_add_mult_mono";
  30.449 -
  30.450 -(* there is no smallest positive fraction *)
  30.451 -Goalw [prat_less_def] "EX (x::prat). x < y";
  30.452 -by (cut_facts_tac [lemma_prat_dense] 1);
  30.453 -by (Fast_tac 1);
  30.454 -qed "qless_Ex";
  30.455 -
  30.456 -(* lemma for proving $< is linear *)
  30.457 -Goalw [prat_def,prat_less_def] 
  30.458 -      "ratrel `` {(x, y * ya)} : {p::(pnat*pnat).True}//ratrel";
  30.459 -by (asm_full_simp_tac (simpset() addsimps [ratrel_def,quotient_def]) 1);
  30.460 -by (Blast_tac 1);
  30.461 -qed "lemma_prat_less_linear";
  30.462 -
  30.463 -(* linearity of < -- Gleason p. 120 - Proposition 9-2.6 *)
  30.464 -(*** FIXME Proof long ***)
  30.465 -Goalw [prat_less_def] 
  30.466 -      "(q1::prat) < q2 | q1 = q2 | q2 < q1";
  30.467 -by (res_inst_tac [("z","q1")] eq_Abs_prat 1);
  30.468 -by (res_inst_tac [("z","q2")] eq_Abs_prat 1);
  30.469 -by (Step_tac 1 THEN REPEAT(dtac (not_ex RS iffD1) 1) 
  30.470 -               THEN Auto_tac);
  30.471 -by (cut_inst_tac  [("z1.0","x*ya"), ("z2.0","xa*y")] pnat_linear_Ex_eq 1);
  30.472 -by (EVERY1[etac disjE,etac exE]);
  30.473 -by (eres_inst_tac 
  30.474 -    [("x","Abs_prat(ratrel``{(xb,ya*y)})")] allE 1);
  30.475 -by (asm_full_simp_tac 
  30.476 -    (simpset() addsimps [prat_add, pnat_mult_assoc 
  30.477 -     RS sym,pnat_add_mult_distrib RS sym]) 1);
  30.478 -by (EVERY1[asm_full_simp_tac (simpset() addsimps pnat_mult_ac),
  30.479 -    etac disjE, assume_tac, etac exE]);
  30.480 -by (thin_tac "!T. Abs_prat (ratrel `` {(x, y)}) + T ~= \
  30.481 -\     Abs_prat (ratrel `` {(xa, ya)})" 1);
  30.482 -by (eres_inst_tac [("x","Abs_prat(ratrel``{(xb,y*ya)})")] allE 1);
  30.483 -by (asm_full_simp_tac (simpset() addsimps [prat_add,
  30.484 -      pnat_mult_assoc RS sym,pnat_add_mult_distrib RS sym]) 1);
  30.485 -by (asm_full_simp_tac (simpset() addsimps pnat_mult_ac) 1);
  30.486 -qed "prat_linear";
  30.487 -
  30.488 -Goal "!!(x::prat). [| x < y ==> P;  x = y ==> P; \
  30.489 -\          y < x ==> P |] ==> P";
  30.490 -by (cut_inst_tac [("q1.0","x"),("q2.0","y")] prat_linear 1);
  30.491 -by Auto_tac;
  30.492 -qed "prat_linear_less2";
  30.493 -
  30.494 -(* Gleason p. 120 -- 9-2.6 (iv) *)
  30.495 -Goal "[| q1 < q2; qinv(q1) = qinv(q2) |] ==> P";
  30.496 -by (cut_inst_tac [("x","qinv (q2)"),("q1.0","q1"), ("q2.0","q2")] 
  30.497 -    prat_mult_less2_mono1 1);
  30.498 -by (assume_tac 1);
  30.499 -by (Asm_full_simp_tac 1 THEN dtac sym 1);
  30.500 -by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  30.501 -qed "lemma1_qinv_prat_less";
  30.502 -
  30.503 -Goal "[| q1 < q2; qinv(q1) < qinv(q2) |] ==> P";
  30.504 -by (cut_inst_tac [("x","qinv (q2)"),("q1.0","q1"), ("q2.0","q2")] 
  30.505 -    prat_mult_less2_mono1 1);
  30.506 -by (assume_tac 1);
  30.507 -by (cut_inst_tac [("x","q1"),("q1.0","qinv (q1)"), ("q2.0","qinv (q2)")] 
  30.508 -    prat_mult_left_less2_mono1 1);
  30.509 -by Auto_tac;
  30.510 -by (dres_inst_tac [("q2.0","prat_of_pnat (Abs_pnat (Suc 0))")] prat_less_trans 1);
  30.511 -by (auto_tac (claset(),simpset() addsimps 
  30.512 -    [prat_less_not_refl]));
  30.513 -qed "lemma2_qinv_prat_less";
  30.514 -
  30.515 -Goal "q1 < q2  ==> qinv (q2) < qinv (q1)";
  30.516 -by (res_inst_tac [("y","qinv q1"), ("x","qinv q2")] prat_linear_less2 1);
  30.517 -by (auto_tac (claset() addEs [lemma1_qinv_prat_less,
  30.518 -                 lemma2_qinv_prat_less],simpset()));
  30.519 -qed "qinv_prat_less";
  30.520 -
  30.521 -Goal "q1 < prat_of_pnat (Abs_pnat (Suc 0)) \
  30.522 -\     ==> prat_of_pnat (Abs_pnat (Suc 0)) < qinv(q1)";
  30.523 -by (dtac qinv_prat_less 1);
  30.524 -by (full_simp_tac (simpset() addsimps [qinv_1]) 1);
  30.525 -qed "prat_qinv_gt_1";
  30.526 -
  30.527 -Goalw [pnat_one_def] 
  30.528 -     "q1 < prat_of_pnat 1 ==> prat_of_pnat 1 < qinv(q1)";
  30.529 -by (etac prat_qinv_gt_1 1);
  30.530 -qed "prat_qinv_is_gt_1";
  30.531 -
  30.532 -Goalw [prat_less_def] 
  30.533 -      "prat_of_pnat (Abs_pnat (Suc 0)) < prat_of_pnat (Abs_pnat (Suc 0)) \
  30.534 -\                   + prat_of_pnat (Abs_pnat (Suc 0))";
  30.535 -by (Fast_tac 1); 
  30.536 -qed "prat_less_1_2";
  30.537 -
  30.538 -Goal "qinv(prat_of_pnat (Abs_pnat (Suc 0)) + \
  30.539 -\     prat_of_pnat (Abs_pnat (Suc 0))) < prat_of_pnat (Abs_pnat (Suc 0))";
  30.540 -by (cut_facts_tac [prat_less_1_2 RS qinv_prat_less] 1);
  30.541 -by (asm_full_simp_tac (simpset() addsimps [qinv_1]) 1);
  30.542 -qed "prat_less_qinv_2_1";
  30.543 -
  30.544 -Goal "!!(x::prat). x < y ==> x*qinv(y) < prat_of_pnat (Abs_pnat (Suc 0))";
  30.545 -by (dres_inst_tac [("x","qinv(y)")] prat_mult_less2_mono1 1);
  30.546 -by (Asm_full_simp_tac 1);
  30.547 -qed "prat_mult_qinv_less_1";
  30.548 -
  30.549 -Goal "(x::prat) < x + x";
  30.550 -by (cut_inst_tac [("x","x")] 
  30.551 -    (prat_less_1_2 RS prat_mult_left_less2_mono1) 1);
  30.552 -by (asm_full_simp_tac (simpset() addsimps 
  30.553 -    [prat_add_mult_distrib2]) 1);
  30.554 -qed "prat_self_less_add_self";
  30.555 -
  30.556 -Goalw [prat_less_def] "(x::prat) < y + x";
  30.557 -by (res_inst_tac [("x","y")] exI 1);
  30.558 -by (simp_tac (simpset() addsimps [prat_add_commute]) 1);
  30.559 -qed "prat_self_less_add_right";
  30.560 -
  30.561 -Goal "(x::prat) < x + y";
  30.562 -by (rtac (prat_add_commute RS subst) 1);
  30.563 -by (simp_tac (simpset() addsimps [prat_self_less_add_right]) 1);
  30.564 -qed "prat_self_less_add_left";
  30.565 -
  30.566 -Goalw [prat_less_def] "prat_of_pnat 1 < y ==> (x::prat) < x * y";
  30.567 -by (auto_tac (claset(),simpset() addsimps [pnat_one_def,
  30.568 -    prat_add_mult_distrib2]));
  30.569 -qed "prat_self_less_mult_right";
  30.570 -
  30.571 -(*** Properties of <= ***)
  30.572 -
  30.573 -Goalw [prat_le_def] "~(w < z) ==> z <= (w::prat)";
  30.574 -by (assume_tac 1);
  30.575 -qed "prat_leI";
  30.576 -
  30.577 -Goalw [prat_le_def] "z<=w ==> ~(w<(z::prat))";
  30.578 -by (assume_tac 1);
  30.579 -qed "prat_leD";
  30.580 -
  30.581 -bind_thm ("prat_leE", make_elim prat_leD);
  30.582 -
  30.583 -Goal "(~(w < z)) = (z <= (w::prat))";
  30.584 -by (fast_tac (claset() addSIs [prat_leI,prat_leD]) 1);
  30.585 -qed "prat_less_le_iff";
  30.586 -
  30.587 -Goalw [prat_le_def] "~ z <= w ==> w<(z::prat)";
  30.588 -by (Fast_tac 1);
  30.589 -qed "not_prat_leE";
  30.590 -
  30.591 -Goalw [prat_le_def] "z < w ==> z <= (w::prat)";
  30.592 -by (fast_tac (claset() addEs [prat_less_asym]) 1);
  30.593 -qed "prat_less_imp_le";
  30.594 -
  30.595 -Goalw [prat_le_def] "!!(x::prat). x <= y ==> x < y | x = y";
  30.596 -by (cut_facts_tac [prat_linear] 1);
  30.597 -by (fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym]) 1);
  30.598 -qed "prat_le_imp_less_or_eq";
  30.599 -
  30.600 -Goalw [prat_le_def] "z<w | z=w ==> z <=(w::prat)";
  30.601 -by (cut_facts_tac [prat_linear] 1);
  30.602 -by (fast_tac (claset() addEs [prat_less_irrefl,prat_less_asym]) 1);
  30.603 -qed "prat_less_or_eq_imp_le";
  30.604 -
  30.605 -Goal "(x <= (y::prat)) = (x < y | x=y)";
  30.606 -by (REPEAT(ares_tac [iffI, prat_less_or_eq_imp_le, prat_le_imp_less_or_eq] 1));
  30.607 -qed "prat_le_eq_less_or_eq";
  30.608 -
  30.609 -Goal "w <= (w::prat)";
  30.610 -by (simp_tac (simpset() addsimps [prat_le_eq_less_or_eq]) 1);
  30.611 -qed "prat_le_refl";
  30.612 -
  30.613 -Goal "[| i <= j; j < k |] ==> i < (k::prat)";
  30.614 -by (dtac prat_le_imp_less_or_eq 1);
  30.615 -by (fast_tac (claset() addIs [prat_less_trans]) 1);
  30.616 -qed "prat_le_less_trans";
  30.617 -
  30.618 -Goal "[| i <= j; j <= k |] ==> i <= (k::prat)";
  30.619 -by (EVERY1 [dtac prat_le_imp_less_or_eq, dtac prat_le_imp_less_or_eq,
  30.620 -            rtac prat_less_or_eq_imp_le, fast_tac (claset() addIs [prat_less_trans])]);
  30.621 -qed "prat_le_trans";
  30.622 -
  30.623 -Goal "[| ~ y < x; y ~= x |] ==> x < (y::prat)";
  30.624 -by (rtac not_prat_leE 1);
  30.625 -by (fast_tac (claset() addDs [prat_le_imp_less_or_eq]) 1);
  30.626 -qed "not_less_not_eq_prat_less";
  30.627 -
  30.628 -Goalw [prat_less_def] 
  30.629 -      "[| x1 < y1; x2 < y2 |] ==> x1 + x2 < y1 + (y2::prat)";
  30.630 -by (REPEAT(etac exE 1));
  30.631 -by (res_inst_tac [("x","T+Ta")] exI 1);
  30.632 -by (auto_tac (claset(),simpset() addsimps prat_add_ac));
  30.633 -qed "prat_add_less_mono";
  30.634 -
  30.635 -Goalw [prat_less_def] 
  30.636 -      "[| x1 < y1; x2 < y2 |] ==> x1 * x2 < y1 * (y2::prat)";
  30.637 -by (REPEAT(etac exE 1));
  30.638 -by (res_inst_tac [("x","T*Ta+T*x2+x1*Ta")] exI 1);
  30.639 -by (auto_tac (claset(),
  30.640 -	      simpset() addsimps prat_add_ac @ 
  30.641 -	                      [prat_add_mult_distrib,prat_add_mult_distrib2]));
  30.642 -qed "prat_mult_less_mono";
  30.643 -
  30.644 -(* more prat_le *)
  30.645 -Goal "!!(q1::prat). q1 <= q2  ==> x * q1 <= x * q2";
  30.646 -by (dtac prat_le_imp_less_or_eq 1);
  30.647 -by (Step_tac 1);
  30.648 -by (auto_tac (claset() addSIs [prat_le_refl, prat_less_imp_le,
  30.649 -			       prat_mult_left_less2_mono1],
  30.650 -	      simpset()));
  30.651 -qed "prat_mult_left_le2_mono1";
  30.652 -
  30.653 -Goal "!!(q1::prat). q1 <= q2  ==> q1 * x <= q2 * x";
  30.654 -by (auto_tac (claset() addDs [prat_mult_left_le2_mono1],
  30.655 -	      simpset() addsimps [prat_mult_commute]));
  30.656 -qed "prat_mult_le2_mono1";
  30.657 -
  30.658 -Goal "q1 <= q2  ==> qinv (q2) <= qinv (q1)";
  30.659 -by (dtac prat_le_imp_less_or_eq 1);
  30.660 -by (Step_tac 1);
  30.661 -by (auto_tac (claset() addSIs [prat_le_refl, prat_less_imp_le,qinv_prat_less],
  30.662 -	      simpset()));
  30.663 -qed "qinv_prat_le";
  30.664 -
  30.665 -Goal "!!(q1::prat). q1 <= q2  ==> x + q1 <= x + q2";
  30.666 -by (dtac prat_le_imp_less_or_eq 1);
  30.667 -by (Step_tac 1);
  30.668 -by (auto_tac (claset() addSIs [prat_le_refl,
  30.669 -			       prat_less_imp_le,prat_add_less2_mono1],
  30.670 -	      simpset() addsimps [prat_add_commute]));
  30.671 -qed "prat_add_left_le2_mono1";
  30.672 -
  30.673 -Goal "!!(q1::prat). q1 <= q2  ==> q1 + x <= q2 + x";
  30.674 -by (auto_tac (claset() addDs [prat_add_left_le2_mono1],
  30.675 -	      simpset() addsimps [prat_add_commute]));
  30.676 -qed "prat_add_le2_mono1";
  30.677 -
  30.678 -Goal "!!k l::prat. [|i<=j;  k<=l |] ==> i + k <= j + l";
  30.679 -by (etac (prat_add_le2_mono1 RS prat_le_trans) 1);
  30.680 -by (simp_tac (simpset() addsimps [prat_add_commute]) 1);
  30.681 -(*j moves to the end because it is free while k, l are bound*)
  30.682 -by (etac prat_add_le2_mono1 1);
  30.683 -qed "prat_add_le_mono";
  30.684 -
  30.685 -Goal "!!(x::prat). x + y < z + y ==> x < z";
  30.686 -by (rtac ccontr 1);
  30.687 -by (etac (prat_leI RS prat_le_imp_less_or_eq RS disjE) 1);
  30.688 -by (dres_inst_tac [("x","y"),("q1.0","z")] prat_add_less2_mono1 1);
  30.689 -by (auto_tac (claset() addIs [prat_less_asym],
  30.690 -    simpset() addsimps [prat_less_not_refl]));
  30.691 -qed "prat_add_right_less_cancel";
  30.692 -
  30.693 -Goal "!!(x::prat). y + x < y + z ==> x < z";
  30.694 -by (res_inst_tac [("y","y")] prat_add_right_less_cancel 1);
  30.695 -by (asm_full_simp_tac (simpset() addsimps [prat_add_commute]) 1);
  30.696 -qed "prat_add_left_less_cancel";
  30.697 -
  30.698 -(*** lemmas required for lemma_gleason9_34 in PReal : w*y > y/z ***)
  30.699 -Goalw [prat_of_pnat_def] 
  30.700 -      "Abs_prat(ratrel``{(x,y)}) = (prat_of_pnat x)*qinv(prat_of_pnat y)";
  30.701 -by (auto_tac (claset(),simpset() addsimps [prat_mult,qinv,pnat_mult_1_left,
  30.702 -    pnat_mult_1]));
  30.703 -qed "Abs_prat_mult_qinv";
  30.704 -
  30.705 -Goal "Abs_prat(ratrel``{(x,y)}) <= Abs_prat(ratrel``{(x,Abs_pnat (Suc 0))})";
  30.706 -by (simp_tac (simpset() addsimps [Abs_prat_mult_qinv]) 1);
  30.707 -by (rtac prat_mult_left_le2_mono1 1);
  30.708 -by (rtac qinv_prat_le 1);
  30.709 -by (pnat_ind_tac "y" 1);
  30.710 -by (dres_inst_tac [("x","prat_of_pnat (Abs_pnat (Suc 0))")] prat_add_le2_mono1 2);
  30.711 -by (cut_facts_tac [prat_less_1_2 RS prat_less_imp_le] 2);
  30.712 -by (auto_tac (claset() addIs [prat_le_trans],
  30.713 -    simpset() addsimps [prat_le_refl,
  30.714 -    pSuc_is_plus_one,pnat_one_def,prat_of_pnat_add]));
  30.715 -qed "lemma_Abs_prat_le1";
  30.716 -
  30.717 -Goal "Abs_prat(ratrel``{(x,Abs_pnat (Suc 0))}) <= Abs_prat(ratrel``{(x*y,Abs_pnat (Suc 0))})";
  30.718 -by (simp_tac (simpset() addsimps [Abs_prat_mult_qinv]) 1);
  30.719 -by (rtac prat_mult_le2_mono1 1);
  30.720 -by (pnat_ind_tac "y" 1);
  30.721 -by (dres_inst_tac [("x","prat_of_pnat x")] prat_add_le2_mono1 2);
  30.722 -by (cut_inst_tac [("z","prat_of_pnat x")] (prat_self_less_add_self 
  30.723 -    RS prat_less_imp_le) 2);
  30.724 -by (auto_tac (claset() addIs [prat_le_trans],
  30.725 -    simpset() addsimps [prat_le_refl,
  30.726 -			pSuc_is_plus_one,pnat_one_def,prat_add_mult_distrib2,
  30.727 -			prat_of_pnat_add,prat_of_pnat_mult]));
  30.728 -qed "lemma_Abs_prat_le2";
  30.729 -
  30.730 -Goal "Abs_prat(ratrel``{(x,z)}) <= Abs_prat(ratrel``{(x*y,Abs_pnat (Suc 0))})";
  30.731 -by (fast_tac (claset() addIs [prat_le_trans,
  30.732 -			      lemma_Abs_prat_le1,lemma_Abs_prat_le2]) 1);
  30.733 -qed "lemma_Abs_prat_le3";
  30.734 -
  30.735 -Goal "Abs_prat(ratrel``{(x*y,Abs_pnat (Suc 0))}) * Abs_prat(ratrel``{(w,x)}) = \
  30.736 -\         Abs_prat(ratrel``{(w*y,Abs_pnat (Suc 0))})";
  30.737 -by (full_simp_tac (simpset() addsimps [prat_mult,
  30.738 -    pnat_mult_1,pnat_mult_1_left] @ pnat_mult_ac) 1);
  30.739 -qed "pre_lemma_gleason9_34";
  30.740 -
  30.741 -Goal "Abs_prat(ratrel``{(y*x,Abs_pnat (Suc 0)*y)}) = \
  30.742 -\         Abs_prat(ratrel``{(x,Abs_pnat (Suc 0))})";
  30.743 -by (auto_tac (claset(),
  30.744 -	      simpset() addsimps [pnat_mult_1,pnat_mult_1_left] @ pnat_mult_ac));
  30.745 -qed "pre_lemma_gleason9_34b";
  30.746 -
  30.747 -Goal "(prat_of_pnat n < prat_of_pnat m) = (n < m)";
  30.748 -by (auto_tac (claset(),simpset() addsimps [prat_less_def,
  30.749 -    pnat_less_iff,prat_of_pnat_add]));
  30.750 -by (res_inst_tac [("z","T")] eq_Abs_prat 1);
  30.751 -by (auto_tac (claset() addDs [pnat_eq_lessI],
  30.752 -    simpset() addsimps [prat_add,pnat_mult_1,
  30.753 -    pnat_mult_1_left,prat_of_pnat_def,pnat_less_iff RS sym]));
  30.754 -qed "prat_of_pnat_less_iff";
  30.755 -
  30.756 -Addsimps [prat_of_pnat_less_iff];
  30.757 -
  30.758 -(*------------------------------------------------------------------*)
  30.759 -
  30.760 -(*** prove witness that will be required to prove non-emptiness ***)
  30.761 -(*** of preal type as defined using Dedekind Sections in PReal  ***)
  30.762 -(*** Show that exists positive real `one' ***)
  30.763 -
  30.764 -Goal "EX q. q: {x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))}";
  30.765 -by (fast_tac (claset() addIs [prat_less_qinv_2_1]) 1);
  30.766 -qed "lemma_prat_less_1_memEx";
  30.767 -
  30.768 -Goal "{x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))} ~= {}";
  30.769 -by (rtac notI 1);
  30.770 -by (cut_facts_tac [lemma_prat_less_1_memEx] 1);
  30.771 -by (Asm_full_simp_tac 1);
  30.772 -qed "lemma_prat_less_1_set_non_empty";
  30.773 -
  30.774 -Goalw [psubset_def] "{} < {x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))}";
  30.775 -by (asm_full_simp_tac (simpset() addsimps 
  30.776 -         [lemma_prat_less_1_set_non_empty RS not_sym]) 1);
  30.777 -qed "empty_set_psubset_lemma_prat_less_1_set";
  30.778 -
  30.779 -(*** exists rational not in set --- prat_of_pnat (Abs_pnat 1) itself ***)
  30.780 -Goal "EX q. q ~: {x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))}";
  30.781 -by (res_inst_tac [("x","prat_of_pnat (Abs_pnat (Suc 0))")] exI 1);
  30.782 -by (auto_tac (claset(),simpset() addsimps [prat_less_not_refl]));
  30.783 -qed "lemma_prat_less_1_not_memEx";
  30.784 -
  30.785 -Goal "{x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))} ~= UNIV";
  30.786 -by (rtac notI 1);
  30.787 -by (cut_facts_tac [lemma_prat_less_1_not_memEx] 1);
  30.788 -by (Asm_full_simp_tac 1);
  30.789 -qed "lemma_prat_less_1_set_not_rat_set";
  30.790 -
  30.791 -Goalw [psubset_def,subset_def] 
  30.792 -      "{x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))} < UNIV";
  30.793 -by (asm_full_simp_tac
  30.794 -    (simpset() addsimps [lemma_prat_less_1_set_not_rat_set,
  30.795 -			 lemma_prat_less_1_not_memEx]) 1);
  30.796 -qed "lemma_prat_less_1_set_psubset_rat_set";
  30.797 -
  30.798 -(*** prove non_emptiness of type ***)
  30.799 -Goal "{x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))} : {A. {} < A & \
  30.800 -\               A < UNIV & \
  30.801 -\               (!y: A. ((!z. z < y --> z: A) & \
  30.802 -\               (EX u: A. y < u)))}";
  30.803 -by (auto_tac (claset() addDs [prat_less_trans],
  30.804 -    simpset() addsimps [empty_set_psubset_lemma_prat_less_1_set,
  30.805 -                       lemma_prat_less_1_set_psubset_rat_set]));
  30.806 -by (dtac prat_dense 1);
  30.807 -by (Fast_tac 1);
  30.808 -qed "preal_1";
    31.1 --- a/src/HOL/Real/PRat.thy	Tue Jan 27 09:44:14 2004 +0100
    31.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.3 @@ -1,50 +0,0 @@
    31.4 -(*  Title       : PRat.thy
    31.5 -    ID          : $Id$
    31.6 -    Author      : Jacques D. Fleuriot
    31.7 -    Copyright   : 1998  University of Cambridge
    31.8 -    Description : The positive rationals
    31.9 -*) 
   31.10 -
   31.11 -PRat = PNat +
   31.12 -
   31.13 -constdefs
   31.14 -    ratrel   ::  "((pnat * pnat) * (pnat * pnat)) set"
   31.15 -    "ratrel  ==  {p. ? x1 y1 x2 y2. p=((x1::pnat,y1),(x2,y2)) & x1*y2 = x2*y1}" 
   31.16 -
   31.17 -typedef prat = "UNIV//ratrel"          (quotient_def)
   31.18 -
   31.19 -instance
   31.20 -   prat  :: {ord,plus,times}
   31.21 -
   31.22 -
   31.23 -constdefs
   31.24 -
   31.25 -  prat_of_pnat :: pnat => prat           
   31.26 -  "prat_of_pnat m == Abs_prat(ratrel``{(m,Abs_pnat 1)})"
   31.27 -
   31.28 -  qinv      :: prat => prat
   31.29 -  "qinv(Q)  == Abs_prat(UN (x,y):Rep_prat(Q). ratrel``{(y,x)})" 
   31.30 -
   31.31 -defs
   31.32 -
   31.33 -  prat_add_def  
   31.34 -  "P + Q == Abs_prat(UN (x1,y1):Rep_prat(P). UN (x2,y2):Rep_prat(Q).
   31.35 -		     ratrel``{(x1*y2 + x2*y1, y1*y2)})"
   31.36 -
   31.37 -  prat_mult_def  
   31.38 -  "P * Q == Abs_prat(UN (x1,y1):Rep_prat(P). UN (x2,y2):Rep_prat(Q).
   31.39 -		     ratrel``{(x1*x2, y1*y2)})"
   31.40 - 
   31.41 -  (*** Gleason p. 119 ***)
   31.42 -  prat_less_def
   31.43 -  "P < (Q::prat) == EX T. P + T = Q"
   31.44 -
   31.45 -  prat_le_def
   31.46 -  "P <= (Q::prat) == ~(Q < P)" 
   31.47 -
   31.48 -end
   31.49 -  
   31.50 -
   31.51 -
   31.52 -
   31.53 -
    32.1 --- a/src/HOL/Real/PReal.thy	Tue Jan 27 09:44:14 2004 +0100
    32.2 +++ b/src/HOL/Real/PReal.thy	Tue Jan 27 15:39:51 2004 +0100
    32.3 @@ -7,44 +7,95 @@
    32.4                    provides some of the definitions.
    32.5  *)
    32.6  
    32.7 -theory PReal = PRat:
    32.8 +theory PReal = RatArith:
    32.9 +
   32.10 +text{*Could be generalized and moved to @{text Ring_and_Field}*}
   32.11 +lemma add_eq_exists: "\<exists>x. a+x = (b::rat)"
   32.12 +by (rule_tac x="b-a" in exI, simp)
   32.13  
   32.14 -typedef preal = "{A::prat set. {} < A & A < UNIV &
   32.15 -                               (\<forall>y \<in> A. ((\<forall>z. z < y --> z \<in> A) &
   32.16 -                                        (\<exists>u \<in> A. y < u)))}"
   32.17 -apply (rule exI) 
   32.18 -apply (rule preal_1) 
   32.19 -done
   32.20 +text{*As a special case, the sum of two positives is positive.  One of the
   32.21 +premises could be weakened to the relation @{text "\<le>"}.*}
   32.22 +lemma pos_add_strict: "[|0<a; b<c|] ==> b < a + (c::'a::ordered_semiring)"
   32.23 +by (insert add_strict_mono [of 0 a b c], simp)
   32.24  
   32.25 -
   32.26 -instance preal :: ord ..
   32.27 -instance preal :: plus ..
   32.28 -instance preal :: times ..
   32.29 +lemma interval_empty_iff:
   32.30 +     "({y::'a::ordered_field. x < y & y < z} = {}) = (~(x < z))"
   32.31 +by (blast dest: dense intro: order_less_trans)
   32.32  
   32.33  
   32.34  constdefs
   32.35 -  preal_of_prat :: "prat => preal"
   32.36 -   "preal_of_prat q     == Abs_preal({x::prat. x < q})"
   32.37 +  cut :: "rat set => bool"
   32.38 +    "cut A == {} \<subset> A &
   32.39 +              A < {r. 0 < r} &
   32.40 +              (\<forall>y \<in> A. ((\<forall>z. 0<z & z < y --> z \<in> A) & (\<exists>u \<in> A. y < u)))"
   32.41 +
   32.42  
   32.43 -  pinv       :: "preal => preal"
   32.44 -  "pinv(R)   == Abs_preal({w. \<exists>y. w < y & qinv y \<notin> Rep_preal(R)})"
   32.45 +lemma cut_of_rat: 
   32.46 +  assumes q: "0 < q" shows "cut {r::rat. 0 < r & r < q}"
   32.47 +proof -
   32.48 +  let ?A = "{r::rat. 0 < r & r < q}"
   32.49 +  from q have pos: "?A < {r. 0 < r}" by force
   32.50 +  have nonempty: "{} \<subset> ?A"
   32.51 +  proof
   32.52 +    show "{} \<subseteq> ?A" by simp
   32.53 +    show "{} \<noteq> ?A"
   32.54 +      by (force simp only: q eq_commute [of "{}"] interval_empty_iff)
   32.55 +  qed
   32.56 +  show ?thesis
   32.57 +    by (simp add: cut_def pos nonempty,
   32.58 +        blast dest: dense intro: order_less_trans)
   32.59 +qed
   32.60 +
   32.61 +
   32.62 +typedef preal = "{A. cut A}"
   32.63 +  by (blast intro: cut_of_rat [OF zero_less_one])
   32.64 +
   32.65 +instance preal :: ord ..
   32.66 +instance preal :: plus ..
   32.67 +instance preal :: minus ..
   32.68 +instance preal :: times ..
   32.69 +instance preal :: inverse ..
   32.70 +
   32.71 +
   32.72 +constdefs
   32.73 +  preal_of_rat :: "rat => preal"
   32.74 +     "preal_of_rat q == Abs_preal({x::rat. 0 < x & x < q})"
   32.75  
   32.76    psup       :: "preal set => preal"
   32.77 -  "psup(P)   == Abs_preal({w. \<exists>X \<in> P. w \<in> Rep_preal(X)})"
   32.78 +    "psup(P)   == Abs_preal(\<Union>X \<in> P. Rep_preal(X))"
   32.79 +
   32.80 +  add_set :: "[rat set,rat set] => rat set"
   32.81 +    "add_set A B == {w. \<exists>x \<in> A. \<exists>y \<in> B. w = x + y}"
   32.82 +
   32.83 +  diff_set :: "[rat set,rat set] => rat set"
   32.84 +    "diff_set A B == {w. \<exists>x. 0 < w & 0 < x & x \<notin> B & x + w \<in> A}"
   32.85 +
   32.86 +  mult_set :: "[rat set,rat set] => rat set"
   32.87 +    "mult_set A B == {w. \<exists>x \<in> A. \<exists>y \<in> B. w = x * y}"
   32.88 +
   32.89 +  inverse_set :: "rat set => rat set"
   32.90 +    "inverse_set A == {x. \<exists>y. 0 < x & x < y & inverse y \<notin> A}"
   32.91 +
   32.92  
   32.93  defs (overloaded)
   32.94  
   32.95 +  preal_less_def:
   32.96 +    "R < (S::preal) == Rep_preal R < Rep_preal S"
   32.97 +
   32.98 +  preal_le_def:
   32.99 +    "R \<le> (S::preal) == Rep_preal R \<subseteq> Rep_preal S"
  32.100 +
  32.101    preal_add_def:
  32.102 -    "R + S == Abs_preal({w. \<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). w = x + y})"
  32.103 +    "R + S == Abs_preal (add_set (Rep_preal R) (Rep_preal S))"
  32.104 +
  32.105 +  preal_diff_def:
  32.106 +    "R - S == Abs_preal (diff_set (Rep_preal R) (Rep_preal S))"
  32.107  
  32.108    preal_mult_def:
  32.109 -    "R * S == Abs_preal({w. \<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). w = x * y})"
  32.110 +    "R * S == Abs_preal(mult_set (Rep_preal R) (Rep_preal S))"
  32.111  
  32.112 -  preal_less_def:
  32.113 -    "R < (S::preal) == Rep_preal(R) < Rep_preal(S)"
  32.114 -
  32.115 -  preal_le_def:
  32.116 -    "R \<le> (S::preal) == Rep_preal(R) \<subseteq> Rep_preal(S)"
  32.117 +  preal_inverse_def:
  32.118 +    "inverse R == Abs_preal(inverse_set (Rep_preal R))"
  32.119  
  32.120  
  32.121  lemma inj_on_Abs_preal: "inj_on Abs_preal preal"
  32.122 @@ -59,108 +110,61 @@
  32.123  apply (rule Rep_preal_inverse)
  32.124  done
  32.125  
  32.126 -lemma empty_not_mem_preal [simp]: "{} \<notin> preal"
  32.127 -by (unfold preal_def, fast)
  32.128 +lemma preal_nonempty: "A \<in> preal ==> \<exists>x\<in>A. 0 < x"
  32.129 +by (unfold preal_def cut_def, blast)
  32.130  
  32.131 -lemma one_set_mem_preal: "{x::prat. x < prat_of_pnat (Abs_pnat (Suc 0))} \<in> preal"
  32.132 -apply (unfold preal_def)
  32.133 -apply (rule preal_1)
  32.134 -done
  32.135 +lemma preal_imp_psubset_positives: "A \<in> preal ==> A < {r. 0 < r}"
  32.136 +by (force simp add: preal_def cut_def)
  32.137  
  32.138 -declare one_set_mem_preal [simp]
  32.139 +lemma preal_exists_bound: "A \<in> preal ==> \<exists>x. 0 < x & x \<notin> A"
  32.140 +by (drule preal_imp_psubset_positives, auto)
  32.141  
  32.142 -lemma preal_psubset_empty: "x \<in> preal ==> {} < x"
  32.143 -by (unfold preal_def, fast)
  32.144 -
  32.145 -lemma Rep_preal_psubset_empty: "{} < Rep_preal x"
  32.146 -by (rule Rep_preal [THEN preal_psubset_empty])
  32.147 +lemma preal_exists_greater: "[| A \<in> preal; y \<in> A |] ==> \<exists>u \<in> A. y < u"
  32.148 +by (unfold preal_def cut_def, blast)
  32.149  
  32.150  lemma mem_Rep_preal_Ex: "\<exists>x. x \<in> Rep_preal X"
  32.151 -apply (cut_tac x = X in Rep_preal_psubset_empty)
  32.152 -apply (auto intro: equals0I [symmetric] simp add: psubset_def)
  32.153 -done
  32.154 -
  32.155 -lemma prealI1:
  32.156 -      "[| {} < A; A < UNIV;
  32.157 -               (\<forall>y \<in> A. ((\<forall>z. z < y --> z \<in> A) &
  32.158 -                         (\<exists>u \<in> A. y < u))) |] ==> A \<in> preal"
  32.159 -apply (unfold preal_def, fast)
  32.160 +apply (insert Rep_preal [of X])
  32.161 +apply (unfold preal_def cut_def, blast)
  32.162  done
  32.163  
  32.164 -lemma prealI2:
  32.165 -      "[| {} < A; A < UNIV;
  32.166 -               \<forall>y \<in> A. (\<forall>z. z < y --> z \<in> A);
  32.167 -               \<forall>y \<in> A. (\<exists>u \<in> A. y < u) |] ==> A \<in> preal"
  32.168 -
  32.169 -apply (unfold preal_def, best)
  32.170 -done
  32.171 -
  32.172 -lemma prealE_lemma:
  32.173 -      "A \<in> preal ==> {} < A & A < UNIV &
  32.174 -                          (\<forall>y \<in> A. ((\<forall>z. z < y --> z \<in> A) &
  32.175 -                                   (\<exists>u \<in> A. y < u)))"
  32.176 -apply (unfold preal_def, fast)
  32.177 -done
  32.178 -
  32.179 -declare prealI1 [intro!] prealI2 [intro!]
  32.180 -
  32.181  declare Abs_preal_inverse [simp]
  32.182  
  32.183 -
  32.184 -lemma prealE_lemma1: "A \<in> preal ==> {} < A"
  32.185 -by (unfold preal_def, fast)
  32.186 -
  32.187 -lemma prealE_lemma2: "A \<in> preal ==> A < UNIV"
  32.188 -by (unfold preal_def, fast)
  32.189 -
  32.190 -lemma prealE_lemma3: "A \<in> preal ==> \<forall>y \<in> A. (\<forall>z. z < y --> z \<in> A)"
  32.191 -by (unfold preal_def, fast)
  32.192 -
  32.193 -lemma prealE_lemma3a: "[| A \<in> preal; y \<in> A |] ==> (\<forall>z. z < y --> z \<in> A)"
  32.194 -by (fast dest!: prealE_lemma3)
  32.195 +lemma preal_downwards_closed: "[| A \<in> preal; y \<in> A; 0 < z; z < y |] ==> z \<in> A"
  32.196 +by (unfold preal_def cut_def, blast)
  32.197  
  32.198 -lemma prealE_lemma3b: "[| A \<in> preal; y \<in> A; z < y |] ==> z \<in> A"
  32.199 -by (fast dest!: prealE_lemma3a)
  32.200 -
  32.201 -lemma prealE_lemma4: "A \<in> preal ==> \<forall>y \<in> A. (\<exists>u \<in> A. y < u)"
  32.202 -by (unfold preal_def, fast)
  32.203 +text{*Relaxing the final premise*}
  32.204 +lemma preal_downwards_closed':
  32.205 +     "[| A \<in> preal; y \<in> A; 0 < z; z \<le> y |] ==> z \<in> A"
  32.206 +apply (simp add: order_le_less)
  32.207 +apply (blast intro: preal_downwards_closed)
  32.208 +done
  32.209  
  32.210 -lemma prealE_lemma4a: "[| A \<in> preal; y \<in> A |] ==> \<exists>u \<in> A. y < u"
  32.211 -by (fast dest!: prealE_lemma4)
  32.212 -
  32.213 -lemma not_mem_Rep_preal_Ex: "\<exists>x. x\<notin> Rep_preal X"
  32.214 +lemma Rep_preal_exists_bound: "\<exists>x. 0 < x & x \<notin> Rep_preal X"
  32.215  apply (cut_tac x = X in Rep_preal)
  32.216 -apply (drule prealE_lemma2)
  32.217 +apply (drule preal_imp_psubset_positives)
  32.218  apply (auto simp add: psubset_def)
  32.219  done
  32.220  
  32.221  
  32.222  subsection{*@{term preal_of_prat}: the Injection from prat to preal*}
  32.223  
  32.224 -text{*A few lemmas*}
  32.225 -
  32.226 -lemma lemma_prat_less_set_mem_preal: "{u::prat. u < y} \<in> preal"
  32.227 -apply (cut_tac qless_Ex)
  32.228 -apply (auto intro: prat_less_trans elim!: prat_less_irrefl)
  32.229 -apply (blast dest: prat_dense)
  32.230 +lemma rat_less_set_mem_preal: "0 < y ==> {u::rat. 0 < u & u < y} \<in> preal"
  32.231 +apply (auto simp add: preal_def cut_def intro: order_less_trans)
  32.232 +apply (force simp only: eq_commute [of "{}"] interval_empty_iff)
  32.233 +apply (blast dest: dense intro: order_less_trans)
  32.234  done
  32.235  
  32.236 -lemma lemma_prat_set_eq: "{u::prat. u < x} = {x. x < y} ==> x = y"
  32.237 -apply (insert prat_linear [of x y], safe)
  32.238 -apply (drule_tac [2] prat_dense, erule_tac [2] exE)
  32.239 -apply (drule prat_dense, erule exE)
  32.240 -apply (blast dest: prat_less_not_sym)
  32.241 -apply (blast dest: prat_less_not_sym)
  32.242 +lemma rat_subset_imp_le:
  32.243 +     "[|{u::rat. 0 < u & u < x} \<subseteq> {u. 0 < u & u < y}; 0<x|] ==> x \<le> y"
  32.244 +apply (simp add: linorder_not_less [symmetric])
  32.245 +apply (blast dest: dense intro: order_less_trans)
  32.246  done
  32.247  
  32.248 -lemma inj_preal_of_prat: "inj(preal_of_prat)"
  32.249 -apply (rule inj_onI)
  32.250 -apply (unfold preal_of_prat_def)
  32.251 -apply (drule inj_on_Abs_preal [THEN inj_onD])
  32.252 -apply (rule lemma_prat_less_set_mem_preal)
  32.253 -apply (rule lemma_prat_less_set_mem_preal)
  32.254 -apply (erule lemma_prat_set_eq)
  32.255 -done
  32.256 +lemma rat_set_eq_imp_eq:
  32.257 +     "[|{u::rat. 0 < u & u < x} = {u. 0 < u & u < y};
  32.258 +        0 < x; 0 < y|] ==> x = y"
  32.259 +by (blast intro: rat_subset_imp_le order_antisym)
  32.260 +
  32.261  
  32.262  
  32.263  subsection{*Theorems for Ordering*}
  32.264 @@ -168,127 +172,173 @@
  32.265  text{*A positive fraction not in a positive real is an upper bound.
  32.266   Gleason p. 122 - Remark (1)*}
  32.267  
  32.268 -lemma not_in_preal_ub: "x \<notin> Rep_preal(R) ==> \<forall>y \<in> Rep_preal(R). y < x"
  32.269 -apply (cut_tac x1 = R in Rep_preal [THEN prealE_lemma]) 
  32.270 -apply (blast intro: not_less_not_eq_prat_less)
  32.271 -done
  32.272 +lemma not_in_preal_ub:
  32.273 +     assumes A: "A \<in> preal"
  32.274 +         and notx: "x \<notin> A"
  32.275 +         and y: "y \<in> A"
  32.276 +         and pos: "0 < x"
  32.277 +        shows "y < x"
  32.278 +proof (cases rule: linorder_cases)
  32.279 +  assume "x<y"
  32.280 +  with notx show ?thesis
  32.281 +    by (simp add:  preal_downwards_closed [OF A y] pos)
  32.282 +next
  32.283 +  assume "x=y"
  32.284 +  with notx and y show ?thesis by simp
  32.285 +next
  32.286 +  assume "y<x"
  32.287 +  thus ?thesis by assumption
  32.288 +qed
  32.289 +
  32.290 +lemmas not_in_Rep_preal_ub = not_in_preal_ub [OF Rep_preal]
  32.291  
  32.292  
  32.293 -text{*@{text preal_less} is a strict order: nonreflexive and transitive *}
  32.294 +subsection{*The @{text "\<le>"} Ordering*}
  32.295 +
  32.296 +lemma preal_le_refl: "w \<le> (w::preal)"
  32.297 +by (simp add: preal_le_def)
  32.298  
  32.299 -lemma preal_less_not_refl: "~ (x::preal) < x"
  32.300 -apply (unfold preal_less_def)
  32.301 -apply (simp (no_asm) add: psubset_def)
  32.302 +lemma preal_le_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::preal)"
  32.303 +by (force simp add: preal_le_def)
  32.304 +
  32.305 +lemma preal_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::preal)"
  32.306 +apply (simp add: preal_le_def)
  32.307 +apply (rule Rep_preal_inject [THEN iffD1], blast)
  32.308  done
  32.309  
  32.310 -lemmas preal_less_irrefl = preal_less_not_refl [THEN notE, standard]
  32.311 +(* Axiom 'order_less_le' of class 'order': *)
  32.312 +lemma preal_less_le: "((w::preal) < z) = (w \<le> z & w \<noteq> z)"
  32.313 +by (simp add: preal_le_def preal_less_def Rep_preal_inject psubset_def)
  32.314 +
  32.315 +instance preal :: order
  32.316 +proof qed
  32.317 + (assumption |
  32.318 +  rule preal_le_refl preal_le_trans preal_le_anti_sym preal_less_le)+
  32.319  
  32.320 -lemma preal_not_refl2: "!!(x::preal). x < y ==> x \<noteq> y"
  32.321 -by (auto simp add: preal_less_not_refl)
  32.322 +lemma preal_imp_pos: "[|A \<in> preal; r \<in> A|] ==> 0 < r"
  32.323 +by (insert preal_imp_psubset_positives, blast)
  32.324  
  32.325 -lemma preal_less_trans: "!!(x::preal). [| x < y; y < z |] ==> x < z"
  32.326 -apply (unfold preal_less_def)
  32.327 -apply (auto dest: subsetD equalityI simp add: psubset_def)
  32.328 +lemma preal_le_linear: "x <= y | y <= (x::preal)"
  32.329 +apply (auto simp add: preal_le_def)
  32.330 +apply (rule ccontr)
  32.331 +apply (blast dest: not_in_Rep_preal_ub intro: preal_imp_pos [OF Rep_preal]
  32.332 +             elim: order_less_asym)
  32.333  done
  32.334  
  32.335 -lemma preal_less_not_sym: "!! (q1::preal). q1 < q2 ==> ~ q2 < q1"
  32.336 -apply (rule notI)
  32.337 -apply (drule preal_less_trans, assumption)
  32.338 -apply (simp add: preal_less_not_refl)
  32.339 -done
  32.340 +instance preal :: linorder
  32.341 +  by (intro_classes, rule preal_le_linear)
  32.342  
  32.343 -(* [| x < y;  ~P ==> y < x |] ==> P *)
  32.344 -lemmas preal_less_asym = preal_less_not_sym [THEN contrapos_np, standard]
  32.345 -
  32.346 -lemma preal_linear:
  32.347 -      "(x::preal) < y | x = y | y < x"
  32.348 -apply (unfold preal_less_def)
  32.349 -apply (auto dest!: inj_Rep_preal [THEN injD] simp add: psubset_def)
  32.350 -apply (rule prealE_lemma3b, rule Rep_preal, assumption)
  32.351 -apply (fast dest: not_in_preal_ub)
  32.352 -done
  32.353  
  32.354  
  32.355  subsection{*Properties of Addition*}
  32.356  
  32.357  lemma preal_add_commute: "(x::preal) + y = y + x"
  32.358 -apply (unfold preal_add_def)
  32.359 +apply (unfold preal_add_def add_set_def)
  32.360  apply (rule_tac f = Abs_preal in arg_cong)
  32.361 -apply (blast intro: prat_add_commute [THEN subst])
  32.362 -done
  32.363 -
  32.364 -text{*Addition of two positive reals gives a positive real*}
  32.365 -
  32.366 -text{*Lemmas for proving positive reals addition set in @{typ preal}*}
  32.367 -
  32.368 -text{*Part 1 of Dedekind sections definition*}
  32.369 -lemma preal_add_set_not_empty:
  32.370 -     "{} < {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y}"
  32.371 -apply (cut_tac mem_Rep_preal_Ex mem_Rep_preal_Ex)
  32.372 -apply (auto intro!: psubsetI)
  32.373 +apply (force simp add: add_commute)
  32.374  done
  32.375  
  32.376 -text{*Part 2 of Dedekind sections definition*}
  32.377 -lemma preal_not_mem_add_set_Ex:
  32.378 -     "\<exists>q. q  \<notin> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y}"
  32.379 -apply (cut_tac X = R in not_mem_Rep_preal_Ex)
  32.380 -apply (cut_tac X = S in not_mem_Rep_preal_Ex, clarify) 
  32.381 -apply (drule not_in_preal_ub)+
  32.382 -apply (rule_tac x = "x+xa" in exI)
  32.383 -apply (auto dest!: bspec) 
  32.384 -apply (drule prat_add_less_mono)
  32.385 -apply (auto simp add: prat_less_not_refl)
  32.386 +text{*Lemmas for proving that addition of two positive reals gives
  32.387 + a positive real*}
  32.388 +
  32.389 +lemma empty_psubset_nonempty: "a \<in> A ==> {} \<subset> A"
  32.390 +by blast
  32.391 +
  32.392 +text{*Part 1 of Dedekind sections definition*}
  32.393 +lemma add_set_not_empty:
  32.394 +     "[|A \<in> preal; B \<in> preal|] ==> {} \<subset> add_set A B"
  32.395 +apply (insert preal_nonempty [of A] preal_nonempty [of B]) 
  32.396 +apply (auto simp add: add_set_def)
  32.397  done
  32.398  
  32.399 -lemma preal_add_set_not_prat_set:
  32.400 -     "{w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y} < UNIV"
  32.401 -apply (auto intro!: psubsetI)
  32.402 -apply (cut_tac R = R and S = S in preal_not_mem_add_set_Ex, auto)
  32.403 +text{*Part 2 of Dedekind sections definition.  A structured version of
  32.404 +this proof is @{text preal_not_mem_mult_set_Ex} below.*}
  32.405 +lemma preal_not_mem_add_set_Ex:
  32.406 +     "[|A \<in> preal; B \<in> preal|] ==> \<exists>q. 0 < q & q \<notin> add_set A B"
  32.407 +apply (insert preal_exists_bound [of A] preal_exists_bound [of B], auto) 
  32.408 +apply (rule_tac x = "x+xa" in exI)
  32.409 +apply (simp add: add_set_def, clarify)
  32.410 +apply (drule not_in_preal_ub, assumption+)+
  32.411 +apply (force dest: add_strict_mono)
  32.412  done
  32.413  
  32.414 +lemma add_set_not_rat_set:
  32.415 +   assumes A: "A \<in> preal" 
  32.416 +       and B: "B \<in> preal"
  32.417 +     shows "add_set A B < {r. 0 < r}"
  32.418 +proof
  32.419 +  from preal_imp_pos [OF A] preal_imp_pos [OF B]
  32.420 +  show "add_set A B \<subseteq> {r. 0 < r}" by (force simp add: add_set_def) 
  32.421 +next
  32.422 +  show "add_set A B \<noteq> {r. 0 < r}"
  32.423 +    by (insert preal_not_mem_add_set_Ex [OF A B], blast) 
  32.424 +qed
  32.425 +
  32.426  text{*Part 3 of Dedekind sections definition*}
  32.427 -lemma preal_add_set_lemma3:
  32.428 -     "\<forall>y \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y}.
  32.429 -         \<forall>z. z < y --> z \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x+y}"
  32.430 -apply auto
  32.431 -apply (frule prat_mult_qinv_less_1)
  32.432 -apply (frule_tac x = x 
  32.433 -       in prat_mult_less2_mono1 [of _ "prat_of_pnat (Abs_pnat (Suc 0))"])
  32.434 -apply (frule_tac x = ya 
  32.435 -       in prat_mult_less2_mono1 [of _ "prat_of_pnat (Abs_pnat (Suc 0))"])
  32.436 -apply simp
  32.437 -apply (drule Rep_preal [THEN prealE_lemma3a])+
  32.438 -apply (erule allE)+
  32.439 -apply auto
  32.440 -apply (rule bexI)+
  32.441 -apply (auto simp add: prat_add_mult_distrib2 [symmetric] 
  32.442 -      prat_add_assoc [symmetric] prat_mult_assoc)
  32.443 +lemma add_set_lemma3:
  32.444 +     "[|A \<in> preal; B \<in> preal; u \<in> add_set A B; 0 < z; z < u|] 
  32.445 +      ==> z \<in> add_set A B"
  32.446 +proof (unfold add_set_def, clarify)
  32.447 +  fix x::rat and y::rat
  32.448 +  assume A: "A \<in> preal" 
  32.449 +     and B: "B \<in> preal"
  32.450 +     and [simp]: "0 < z"
  32.451 +     and zless: "z < x + y"
  32.452 +     and x:  "x \<in> A"
  32.453 +     and y:  "y \<in> B"
  32.454 +  have xpos [simp]: "0<x" by (rule preal_imp_pos [OF A x])
  32.455 +  have ypos [simp]: "0<y" by (rule preal_imp_pos [OF B y])
  32.456 +  have xypos [simp]: "0 < x+y" by (simp add: pos_add_strict)
  32.457 +  let ?f = "z/(x+y)"
  32.458 +  have fless: "?f < 1" by (simp add: zless pos_divide_less_eq)
  32.459 +  show "\<exists>x' \<in> A. \<exists>y'\<in>B. z = x' + y'"
  32.460 +  proof
  32.461 +    show "\<exists>y' \<in> B. z = x*?f + y'"
  32.462 +    proof
  32.463 +      show "z = x*?f + y*?f"
  32.464 +	by (simp add: left_distrib [symmetric] divide_inverse_zero mult_ac
  32.465 +		      order_less_imp_not_eq2)
  32.466 +    next
  32.467 +      show "y * ?f \<in> B"
  32.468 +      proof (rule preal_downwards_closed [OF B y])
  32.469 +        show "0 < y * ?f"
  32.470 +          by (simp add: divide_inverse_zero zero_less_mult_iff)
  32.471 +      next
  32.472 +        show "y * ?f < y"
  32.473 +          by (insert mult_strict_left_mono [OF fless ypos], simp)
  32.474 +      qed
  32.475 +    qed
  32.476 +  next
  32.477 +    show "x * ?f \<in> A"
  32.478 +    proof (rule preal_downwards_closed [OF A x])
  32.479 +      show "0 < x * ?f"
  32.480 +	by (simp add: divide_inverse_zero zero_less_mult_iff)
  32.481 +    next
  32.482 +      show "x * ?f < x"
  32.483 +	by (insert mult_strict_left_mono [OF fless xpos], simp)
  32.484 +    qed
  32.485 +  qed
  32.486 +qed
  32.487 +
  32.488 +text{*Part 4 of Dedekind sections definition*}
  32.489 +lemma add_set_lemma4:
  32.490 +     "[|A \<in> preal; B \<in> preal; y \<in> add_set A B|] ==> \<exists>u \<in> add_set A B. y < u"
  32.491 +apply (auto simp add: add_set_def)
  32.492 +apply (frule preal_exists_greater [of A], auto) 
  32.493 +apply (rule_tac x="u + y" in exI)
  32.494 +apply (auto intro: add_strict_left_mono)
  32.495  done
  32.496  
  32.497 -lemma preal_add_set_lemma4:
  32.498 -     "\<forall>y \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y}.
  32.499 -          \<exists>u \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y}. y < u"
  32.500 -apply auto
  32.501 -apply (drule Rep_preal [THEN prealE_lemma4a])
  32.502 -apply (auto intro: prat_add_less2_mono1)
  32.503 -done
  32.504 -
  32.505 -lemma preal_mem_add_set:
  32.506 -     "{w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x + y} \<in> preal"
  32.507 -apply (rule prealI2)
  32.508 -apply (rule preal_add_set_not_empty)
  32.509 -apply (rule preal_add_set_not_prat_set)
  32.510 -apply (rule preal_add_set_lemma3)
  32.511 -apply (rule preal_add_set_lemma4)
  32.512 +lemma mem_add_set:
  32.513 +     "[|A \<in> preal; B \<in> preal|] ==> add_set A B \<in> preal"
  32.514 +apply (simp (no_asm_simp) add: preal_def cut_def)
  32.515 +apply (blast intro!: add_set_not_empty add_set_not_rat_set
  32.516 +                     add_set_lemma3 add_set_lemma4)
  32.517  done
  32.518  
  32.519  lemma preal_add_assoc: "((x::preal) + y) + z = x + (y + z)"
  32.520 -apply (unfold preal_add_def)
  32.521 -apply (rule_tac f = Abs_preal in arg_cong)
  32.522 -apply (simp (no_asm) add: preal_mem_add_set [THEN Abs_preal_inverse])
  32.523 -apply (auto simp add: prat_add_ac)
  32.524 -apply (rule bexI)
  32.525 -apply (auto intro!: exI simp add: prat_add_ac)
  32.526 +apply (simp add: preal_add_def mem_add_set Rep_preal)
  32.527 +apply (force simp add: add_set_def add_ac)
  32.528  done
  32.529  
  32.530  lemma preal_add_left_commute: "x + (y + z) = y + ((x + z)::preal)"
  32.531 @@ -297,7 +347,7 @@
  32.532    apply (rule preal_add_commute)
  32.533    done
  32.534  
  32.535 -(* Positive Reals addition is an AC operator *)
  32.536 +text{* Positive Real addition is an AC operator *}
  32.537  lemmas preal_add_ac = preal_add_assoc preal_add_commute preal_add_left_commute
  32.538  
  32.539  
  32.540 @@ -306,9 +356,9 @@
  32.541  text{*Proofs essentially same as for addition*}
  32.542  
  32.543  lemma preal_mult_commute: "(x::preal) * y = y * x"
  32.544 -apply (unfold preal_mult_def)
  32.545 +apply (unfold preal_mult_def mult_set_def)
  32.546  apply (rule_tac f = Abs_preal in arg_cong)
  32.547 -apply (blast intro: prat_mult_commute [THEN subst])
  32.548 +apply (force simp add: mult_commute)
  32.549  done
  32.550  
  32.551  text{*Multiplication of two positive reals gives a positive real.}
  32.552 @@ -316,68 +366,109 @@
  32.553  text{*Lemmas for proving positive reals multiplication set in @{typ preal}*}
  32.554  
  32.555  text{*Part 1 of Dedekind sections definition*}
  32.556 -lemma preal_mult_set_not_empty:
  32.557 -     "{} < {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y}"
  32.558 -apply (cut_tac mem_Rep_preal_Ex mem_Rep_preal_Ex)
  32.559 -apply (auto intro!: psubsetI)
  32.560 +lemma mult_set_not_empty:
  32.561 +     "[|A \<in> preal; B \<in> preal|] ==> {} \<subset> mult_set A B"
  32.562 +apply (insert preal_nonempty [of A] preal_nonempty [of B]) 
  32.563 +apply (auto simp add: mult_set_def)
  32.564  done
  32.565  
  32.566  text{*Part 2 of Dedekind sections definition*}
  32.567  lemma preal_not_mem_mult_set_Ex:
  32.568 -     "\<exists>q. q  \<notin> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y}"
  32.569 -apply (cut_tac X = R in not_mem_Rep_preal_Ex)
  32.570 -apply (cut_tac X = S in not_mem_Rep_preal_Ex)
  32.571 -apply (erule exE)+
  32.572 -apply (drule not_in_preal_ub)+
  32.573 -apply (rule_tac x = "x*xa" in exI)
  32.574 -apply (auto, (erule ballE)+, auto)
  32.575 -apply (drule prat_mult_less_mono)
  32.576 -apply (auto simp add: prat_less_not_refl)
  32.577 -done
  32.578 +   assumes A: "A \<in> preal" 
  32.579 +       and B: "B \<in> preal"
  32.580 +     shows "\<exists>q. 0 < q & q \<notin> mult_set A B"
  32.581 +proof -
  32.582 +  from preal_exists_bound [OF A]
  32.583 +  obtain x where [simp]: "0 < x" "x \<notin> A" by blast
  32.584 +  from preal_exists_bound [OF B]
  32.585 +  obtain y where [simp]: "0 < y" "y \<notin> B" by blast
  32.586 +  show ?thesis
  32.587 +  proof (intro exI conjI)
  32.588 +    show "0 < x*y" by (simp add: mult_pos)
  32.589 +    show "x * y \<notin> mult_set A B"
  32.590 +    proof (auto simp add: mult_set_def)
  32.591 +      fix u::rat and v::rat
  32.592 +      assume "u \<in> A" and "v \<in> B" and "x*y = u*v"
  32.593 +      moreover
  32.594 +      with prems have "u<x" and "v<y" by (blast dest: not_in_preal_ub)+
  32.595 +      moreover
  32.596 +      with prems have "0\<le>v"
  32.597 +        by (blast intro: preal_imp_pos [OF B]  order_less_imp_le prems)
  32.598 +      moreover
  32.599 +      hence "u*v < x*y" by (blast intro: mult_strict_mono prems)
  32.600 +      ultimately show False by force
  32.601 +    qed
  32.602 +  qed
  32.603 +qed
  32.604  
  32.605 -lemma preal_mult_set_not_prat_set:
  32.606 -     "{w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y} < UNIV"
  32.607 -apply (auto intro!: psubsetI)
  32.608 -apply (cut_tac R = R and S = S in preal_not_mem_mult_set_Ex, auto)
  32.609 -done
  32.610 +lemma mult_set_not_rat_set:
  32.611 +   assumes A: "A \<in> preal" 
  32.612 +       and B: "B \<in> preal"
  32.613 +     shows "mult_set A B < {r. 0 < r}"
  32.614 +proof
  32.615 +  show "mult_set A B \<subseteq> {r. 0 < r}"
  32.616 +    by (force simp add: mult_set_def
  32.617 +              intro: preal_imp_pos [OF A] preal_imp_pos [OF B] mult_pos)
  32.618 +next
  32.619 +  show "mult_set A B \<noteq> {r. 0 < r}"
  32.620 +    by (insert preal_not_mem_mult_set_Ex [OF A B], blast)
  32.621 +qed
  32.622 +
  32.623 +
  32.624  
  32.625  text{*Part 3 of Dedekind sections definition*}
  32.626 -lemma preal_mult_set_lemma3:
  32.627 -     "\<forall>y \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y}.
  32.628 -         \<forall>z. z < y --> z \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x*y}"
  32.629 -apply auto
  32.630 -apply (frule_tac x = "qinv (ya)" in prat_mult_left_less2_mono1)
  32.631 -apply (simp add: prat_mult_ac)
  32.632 -apply (drule Rep_preal [THEN prealE_lemma3a])
  32.633 -apply (erule allE)
  32.634 -apply (rule bexI)+
  32.635 -apply (auto simp add: prat_mult_assoc)
  32.636 +lemma mult_set_lemma3:
  32.637 +     "[|A \<in> preal; B \<in> preal; u \<in> mult_set A B; 0 < z; z < u|] 
  32.638 +      ==> z \<in> mult_set A B"
  32.639 +proof (unfold mult_set_def, clarify)
  32.640 +  fix x::rat and y::rat
  32.641 +  assume A: "A \<in> preal" 
  32.642 +     and B: "B \<in> preal"
  32.643 +     and [simp]: "0 < z"
  32.644 +     and zless: "z < x * y"
  32.645 +     and x:  "x \<in> A"
  32.646 +     and y:  "y \<in> B"
  32.647 +  have [simp]: "0<y" by (rule preal_imp_pos [OF B y])
  32.648 +  show "\<exists>x' \<in> A. \<exists>y' \<in> B. z = x' * y'"
  32.649 +  proof
  32.650 +    show "\<exists>y'\<in>B. z = (z/y) * y'"
  32.651 +    proof
  32.652 +      show "z = (z/y)*y"
  32.653 +	by (simp add: divide_inverse_zero mult_commute [of y] mult_assoc
  32.654 +		      order_less_imp_not_eq2)
  32.655 +      show "y \<in> B" .
  32.656 +    qed
  32.657 +  next
  32.658 +    show "z/y \<in> A"
  32.659 +    proof (rule preal_downwards_closed [OF A x])
  32.660 +      show "0 < z/y"
  32.661 +	by (simp add: zero_less_divide_iff)
  32.662 +      show "z/y < x" by (simp add: pos_divide_less_eq zless)
  32.663 +    qed
  32.664 +  qed
  32.665 +qed
  32.666 +
  32.667 +text{*Part 4 of Dedekind sections definition*}
  32.668 +lemma mult_set_lemma4:
  32.669 +     "[|A \<in> preal; B \<in> preal; y \<in> mult_set A B|] ==> \<exists>u \<in> mult_set A B. y < u"
  32.670 +apply (auto simp add: mult_set_def)
  32.671 +apply (frule preal_exists_greater [of A], auto) 
  32.672 +apply (rule_tac x="u * y" in exI)
  32.673 +apply (auto intro: preal_imp_pos [of A] preal_imp_pos [of B] 
  32.674 +                   mult_strict_right_mono)
  32.675  done
  32.676  
  32.677 -lemma preal_mult_set_lemma4:
  32.678 -     "\<forall>y \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y}.
  32.679 -          \<exists>u \<in> {w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y}. y < u"
  32.680 -apply auto
  32.681 -apply (drule Rep_preal [THEN prealE_lemma4a])
  32.682 -apply (auto intro: prat_mult_less2_mono1)
  32.683 -done
  32.684  
  32.685 -lemma preal_mem_mult_set:
  32.686 -     "{w. \<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. w = x * y} \<in> preal"
  32.687 -apply (rule prealI2)
  32.688 -apply (rule preal_mult_set_not_empty)
  32.689 -apply (rule preal_mult_set_not_prat_set)
  32.690 -apply (rule preal_mult_set_lemma3)
  32.691 -apply (rule preal_mult_set_lemma4)
  32.692 +lemma mem_mult_set:
  32.693 +     "[|A \<in> preal; B \<in> preal|] ==> mult_set A B \<in> preal"
  32.694 +apply (simp (no_asm_simp) add: preal_def cut_def)
  32.695 +apply (blast intro!: mult_set_not_empty mult_set_not_rat_set
  32.696 +                     mult_set_lemma3 mult_set_lemma4)
  32.697  done
  32.698  
  32.699  lemma preal_mult_assoc: "((x::preal) * y) * z = x * (y * z)"
  32.700 -apply (unfold preal_mult_def)
  32.701 -apply (rule_tac f = Abs_preal in arg_cong)
  32.702 -apply (simp (no_asm) add: preal_mem_mult_set [THEN Abs_preal_inverse])
  32.703 -apply (auto simp add: prat_mult_ac)
  32.704 -apply (rule bexI)
  32.705 -apply (auto intro!: exI simp add: prat_mult_ac)
  32.706 +apply (simp add: preal_mult_def mem_mult_set Rep_preal)
  32.707 +apply (force simp add: mult_set_def mult_ac)
  32.708  done
  32.709  
  32.710  lemma preal_mult_left_commute: "x * (y * z) = y * ((x * z)::preal)"
  32.711 @@ -386,32 +477,64 @@
  32.712    apply (rule preal_mult_commute)
  32.713    done
  32.714  
  32.715 -(* Positive Reals multiplication is an AC operator *)
  32.716 +
  32.717 +text{* Positive Real multiplication is an AC operator *}
  32.718  lemmas preal_mult_ac =
  32.719         preal_mult_assoc preal_mult_commute preal_mult_left_commute
  32.720  
  32.721 -(* Positive Real 1 is the multiplicative identity element *)
  32.722 -(* long *)
  32.723 -lemma preal_mult_1:
  32.724 -      "(preal_of_prat (prat_of_pnat (Abs_pnat (Suc 0)))) * z = z"
  32.725 -apply (unfold preal_of_prat_def preal_mult_def)
  32.726 -apply (rule Rep_preal_inverse [THEN subst])
  32.727 -apply (rule_tac f = Abs_preal in arg_cong)
  32.728 -apply (rule one_set_mem_preal [THEN Abs_preal_inverse, THEN ssubst])
  32.729 -apply (auto simp add: Rep_preal_inverse)
  32.730 -apply (drule Rep_preal [THEN prealE_lemma4a]) 
  32.731 -apply (erule bexE) 
  32.732 -apply (drule prat_mult_less_mono)
  32.733 -apply (auto dest: Rep_preal [THEN prealE_lemma3a])
  32.734 -apply (frule Rep_preal [THEN prealE_lemma4a]) 
  32.735 -apply (erule bexE) 
  32.736 -apply (frule_tac x = "qinv (u)" in prat_mult_less2_mono1)
  32.737 -apply (rule exI, auto, rule_tac x = u in bexI)
  32.738 -apply (auto simp add: prat_mult_assoc)
  32.739 -done
  32.740 +
  32.741 +text{* Positive real 1 is the multiplicative identity element *}
  32.742 +
  32.743 +lemma rat_mem_preal: "0 < q ==> {r::rat. 0 < r & r < q} \<in> preal"
  32.744 +by (simp add: preal_def cut_of_rat)
  32.745  
  32.746 -lemma preal_mult_1_right:
  32.747 -     "z * (preal_of_prat (prat_of_pnat (Abs_pnat (Suc 0)))) = z"
  32.748 +lemma preal_mult_1: "(preal_of_rat 1) * z = z"
  32.749 +proof (induct z)
  32.750 +  fix A :: "rat set"
  32.751 +  assume A: "A \<in> preal"
  32.752 +  have "{w. \<exists>u. 0 < u \<and> u < 1 & (\<exists>v \<in> A. w = u * v)} = A" (is "?lhs = A")
  32.753 +  proof
  32.754 +    show "?lhs \<subseteq> A"
  32.755 +    proof clarify
  32.756 +      fix x::rat and u::rat and v::rat
  32.757 +      assume upos: "0<u" and "u<1" and v: "v \<in> A"
  32.758 +      have vpos: "0<v" by (rule preal_imp_pos [OF A v])
  32.759 +      hence "u*v < 1*v" by (simp only: mult_strict_right_mono prems)
  32.760 +      thus "u * v \<in> A"
  32.761 +        by (force intro: preal_downwards_closed [OF A v] mult_pos upos vpos)
  32.762 +    qed
  32.763 +  next
  32.764 +    show "A \<subseteq> ?lhs"
  32.765 +    proof clarify
  32.766 +      fix x::rat
  32.767 +      assume x: "x \<in> A"
  32.768 +      have xpos: "0<x" by (rule preal_imp_pos [OF A x])
  32.769 +      from preal_exists_greater [OF A x]
  32.770 +      obtain v where v: "v \<in> A" and xlessv: "x < v" ..
  32.771 +      have vpos: "0<v" by (rule preal_imp_pos [OF A v])
  32.772 +      show "\<exists>u. 0 < u \<and> u < 1 \<and> (\<exists>v\<in>A. x = u * v)"
  32.773 +      proof (intro exI conjI)
  32.774 +        show "0 < x/v"
  32.775 +          by (simp add: zero_less_divide_iff xpos vpos)
  32.776 +	show "x / v < 1"
  32.777 +          by (simp add: pos_divide_less_eq vpos xlessv)
  32.778 +        show "\<exists>v'\<in>A. x = (x / v) * v'"
  32.779 +        proof
  32.780 +          show "x = (x/v)*v"
  32.781 +	    by (simp add: divide_inverse_zero mult_assoc vpos
  32.782 +                          order_less_imp_not_eq2)
  32.783 +          show "v \<in> A" .
  32.784 +        qed
  32.785 +      qed
  32.786 +    qed
  32.787 +  qed
  32.788 +  thus "preal_of_rat 1 * Abs_preal A = Abs_preal A"
  32.789 +    by (simp add: preal_of_rat_def preal_mult_def mult_set_def 
  32.790 +                  rat_mem_preal A)
  32.791 +qed
  32.792 +
  32.793 +
  32.794 +lemma preal_mult_1_right: "z * (preal_of_rat 1) = z"
  32.795  apply (rule preal_mult_commute [THEN subst])
  32.796  apply (rule preal_mult_1)
  32.797  done
  32.798 @@ -419,884 +542,821 @@
  32.799  
  32.800  subsection{*Distribution of Multiplication across Addition*}
  32.801  
  32.802 -lemma mem_Rep_preal_addD:
  32.803 -      "z \<in> Rep_preal(R+S) ==>
  32.804 -            \<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). z = x + y"
  32.805 -apply (unfold preal_add_def)
  32.806 -apply (drule preal_mem_add_set [THEN Abs_preal_inverse, THEN subst], fast)
  32.807 -done
  32.808 -
  32.809 -lemma mem_Rep_preal_addI:
  32.810 -      "\<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). z = x + y
  32.811 -       ==> z \<in> Rep_preal(R+S)"
  32.812 -apply (unfold preal_add_def)
  32.813 -apply (rule preal_mem_add_set [THEN Abs_preal_inverse, THEN ssubst], fast)
  32.814 -done
  32.815 -
  32.816  lemma mem_Rep_preal_add_iff:
  32.817 -     "(z \<in> Rep_preal(R+S)) = (\<exists>x \<in> Rep_preal(R).
  32.818 -                                  \<exists>y \<in> Rep_preal(S). z = x + y)"
  32.819 -apply (fast intro!: mem_Rep_preal_addD mem_Rep_preal_addI)
  32.820 -done
  32.821 -
  32.822 -lemma mem_Rep_preal_multD:
  32.823 -      "z \<in> Rep_preal(R*S) ==>
  32.824 -            \<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). z = x * y"
  32.825 -apply (unfold preal_mult_def)
  32.826 -apply (drule preal_mem_mult_set [THEN Abs_preal_inverse, THEN subst], fast)
  32.827 -done
  32.828 -
  32.829 -lemma mem_Rep_preal_multI:
  32.830 -      "\<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). z = x * y
  32.831 -       ==> z \<in> Rep_preal(R*S)"
  32.832 -apply (unfold preal_mult_def)
  32.833 -apply (rule preal_mem_mult_set [THEN Abs_preal_inverse, THEN ssubst], fast)
  32.834 +      "(z \<in> Rep_preal(R+S)) = (\<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. z = x + y)"
  32.835 +apply (simp add: preal_add_def mem_add_set Rep_preal)
  32.836 +apply (simp add: add_set_def) 
  32.837  done
  32.838  
  32.839  lemma mem_Rep_preal_mult_iff:
  32.840 -     "(z \<in> Rep_preal(R*S)) =
  32.841 -      (\<exists>x \<in> Rep_preal(R). \<exists>y \<in> Rep_preal(S). z = x * y)"
  32.842 -by (fast intro!: mem_Rep_preal_multD mem_Rep_preal_multI)
  32.843 -
  32.844 -lemma lemma_add_mult_mem_Rep_preal:
  32.845 -     "[| xb \<in> Rep_preal z1; xc \<in> Rep_preal z2; ya:
  32.846 -                   Rep_preal w; yb \<in> Rep_preal w |] ==>
  32.847 -                   xb * ya + xc * yb \<in> Rep_preal (z1 * w + z2 * w)"
  32.848 -by (fast intro: mem_Rep_preal_addI mem_Rep_preal_multI)
  32.849 +      "(z \<in> Rep_preal(R*S)) = (\<exists>x \<in> Rep_preal R. \<exists>y \<in> Rep_preal S. z = x * y)"
  32.850 +apply (simp add: preal_mult_def mem_mult_set Rep_preal)
  32.851 +apply (simp add: mult_set_def) 
  32.852 +done
  32.853  
  32.854 -lemma lemma_add_mult_mem_Rep_preal1:
  32.855 -     "[| xb \<in> Rep_preal z1; xc \<in> Rep_preal z2; ya:
  32.856 -                   Rep_preal w; yb \<in> Rep_preal w |] ==>
  32.857 -                   yb*(xb + xc) \<in> Rep_preal (w*(z1 + z2))"
  32.858 -by (fast intro: mem_Rep_preal_addI mem_Rep_preal_multI)
  32.859 -
  32.860 -lemma lemma_preal_add_mult_distrib:
  32.861 -     "x \<in> Rep_preal (w * z1 + w * z2) ==>
  32.862 -               x \<in> Rep_preal (w * (z1 + z2))"
  32.863 -apply (auto dest!: mem_Rep_preal_addD mem_Rep_preal_multD)
  32.864 -apply (frule_tac ya = xa and yb = xb and xb = ya and xc = yb in lemma_add_mult_mem_Rep_preal1, auto)
  32.865 -apply (rule_tac x = xa and y = xb in prat_linear_less2)
  32.866 -apply (drule_tac b = ya and c = yb in lemma_prat_add_mult_mono)
  32.867 -apply (rule Rep_preal [THEN prealE_lemma3b])
  32.868 -apply (auto simp add: prat_add_mult_distrib2)
  32.869 -apply (drule_tac ya = xb and yb = xa and xc = ya and xb = yb in lemma_add_mult_mem_Rep_preal1, auto)
  32.870 -apply (drule_tac b = yb and c = ya in lemma_prat_add_mult_mono)
  32.871 -apply (rule Rep_preal [THEN prealE_lemma3b])
  32.872 -apply (erule_tac V = "xb * ya + xb * yb \<in> Rep_preal (w * (z1 + z2))" in thin_rl)
  32.873 -apply (auto simp add: prat_add_mult_distrib prat_add_commute preal_add_ac)
  32.874 +lemma distrib_subset1:
  32.875 +     "Rep_preal (w * (x + y)) \<subseteq> Rep_preal (w * x + w * y)"
  32.876 +apply (auto simp add: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_mult_iff)
  32.877 +apply (force simp add: right_distrib)
  32.878  done
  32.879  
  32.880 -lemma lemma_preal_add_mult_distrib2:
  32.881 -     "x \<in> Rep_preal (w * (z1 + z2)) ==>
  32.882 -               x \<in> Rep_preal (w * z1 + w * z2)"
  32.883 -by (auto dest!: mem_Rep_preal_addD mem_Rep_preal_multD
  32.884 -         intro!: bexI mem_Rep_preal_addI mem_Rep_preal_multI 
  32.885 -         simp add: prat_add_mult_distrib2)
  32.886 +lemma linorder_le_cases [case_names le ge]:
  32.887 +    "((x::'a::linorder) <= y ==> P) ==> (y <= x ==> P) ==> P"
  32.888 +  apply (insert linorder_linear, blast)
  32.889 +  done
  32.890  
  32.891 -lemma preal_add_mult_distrib2: "(w * ((z1::preal) + z2)) = (w * z1) + (w * z2)"
  32.892 -apply (rule inj_Rep_preal [THEN injD])
  32.893 -apply (fast intro: lemma_preal_add_mult_distrib lemma_preal_add_mult_distrib2)
  32.894 +lemma preal_add_mult_distrib_mean:
  32.895 +  assumes a: "a \<in> Rep_preal w"
  32.896 +      and b: "b \<in> Rep_preal w"
  32.897 +      and d: "d \<in> Rep_preal x"
  32.898 +      and e: "e \<in> Rep_preal y"
  32.899 +     shows "\<exists>c \<in> Rep_preal w. a * d + b * e = c * (d + e)"
  32.900 +proof
  32.901 +  let ?c = "(a*d + b*e)/(d+e)"
  32.902 +  have [simp]: "0<a" "0<b" "0<d" "0<e" "0<d+e"
  32.903 +    by (blast intro: preal_imp_pos [OF Rep_preal] a b d e pos_add_strict)+
  32.904 +  have cpos: "0 < ?c"
  32.905 +    by (simp add: zero_less_divide_iff zero_less_mult_iff pos_add_strict)
  32.906 +  show "a * d + b * e = ?c * (d + e)"
  32.907 +    by (simp add: divide_inverse_zero mult_assoc order_less_imp_not_eq2)
  32.908 +  show "?c \<in> Rep_preal w"
  32.909 +    proof (cases rule: linorder_le_cases)
  32.910 +      assume "a \<le> b"
  32.911 +      hence "?c \<le> b"
  32.912 +	by (simp add: pos_divide_le_eq right_distrib mult_right_mono
  32.913 +                      order_less_imp_le)
  32.914 +      thus ?thesis by (rule preal_downwards_closed' [OF Rep_preal b cpos])
  32.915 +    next
  32.916 +      assume "b \<le> a"
  32.917 +      hence "?c \<le> a"
  32.918 +	by (simp add: pos_divide_le_eq right_distrib mult_right_mono
  32.919 +                      order_less_imp_le)
  32.920 +      thus ?thesis by (rule preal_downwards_closed' [OF Rep_preal a cpos])
  32.921 +    qed
  32.922 +  qed
  32.923 +
  32.924 +lemma distrib_subset2:
  32.925 +     "Rep_preal (w * x + w * y) \<subseteq> Rep_preal (w * (x + y))"
  32.926 +apply (auto simp add: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_mult_iff)
  32.927 +apply (drule_tac w=w and x=x and y=y in preal_add_mult_distrib_mean, auto)
  32.928  done
  32.929  
  32.930 -lemma preal_add_mult_distrib: "(((z1::preal) + z2) * w) = (z1 * w) + (z2 * w)"
  32.931 -apply (simp (no_asm) add: preal_mult_commute preal_add_mult_distrib2)
  32.932 +lemma preal_add_mult_distrib2: "(w * ((x::preal) + y)) = (w * x) + (w * y)"
  32.933 +apply (rule inj_Rep_preal [THEN injD])
  32.934 +apply (rule equalityI [OF distrib_subset1 distrib_subset2])
  32.935  done
  32.936  
  32.937 +lemma preal_add_mult_distrib: "(((x::preal) + y) * w) = (x * w) + (y * w)"
  32.938 +by (simp add: preal_mult_commute preal_add_mult_distrib2)
  32.939 +
  32.940  
  32.941  subsection{*Existence of Inverse, a Positive Real*}
  32.942  
  32.943 -lemma qinv_not_mem_Rep_preal_Ex: "\<exists>y. qinv(y) \<notin>  Rep_preal X"
  32.944 -apply (cut_tac X = X in not_mem_Rep_preal_Ex)
  32.945 -apply (erule exE, cut_tac x = x in prat_as_inverse_ex, auto)
  32.946 -done
  32.947 -
  32.948 -lemma lemma_preal_mem_inv_set_ex:
  32.949 -     "\<exists>q. q \<in> {x. \<exists>y. x < y & qinv y \<notin>  Rep_preal A}"
  32.950 -apply (cut_tac X = A in qinv_not_mem_Rep_preal_Ex, auto)
  32.951 -apply (cut_tac y = y in qless_Ex, fast)
  32.952 -done
  32.953 +lemma mem_inv_set_ex:
  32.954 +  assumes A: "A \<in> preal" shows "\<exists>x y. 0 < x & x < y & inverse y \<notin> A"
  32.955 +proof -
  32.956 +  from preal_exists_bound [OF A]
  32.957 +  obtain x where [simp]: "0<x" "x \<notin> A" by blast
  32.958 +  show ?thesis
  32.959 +  proof (intro exI conjI)
  32.960 +    show "0 < inverse (x+1)"
  32.961 +      by (simp add: order_less_trans [OF _ less_add_one]) 
  32.962 +    show "inverse(x+1) < inverse x"
  32.963 +      by (simp add: less_imp_inverse_less less_add_one)
  32.964 +    show "inverse (inverse x) \<notin> A"
  32.965 +      by (simp add: order_less_imp_not_eq2)
  32.966 +  qed
  32.967 +qed
  32.968  
  32.969  text{*Part 1 of Dedekind sections definition*}
  32.970 -lemma preal_inv_set_not_empty: "{} < {x. \<exists>y. x < y & qinv y \<notin>  Rep_preal A}"
  32.971 -apply (cut_tac lemma_preal_mem_inv_set_ex)
  32.972 -apply (auto intro!: psubsetI)
  32.973 +lemma inverse_set_not_empty:
  32.974 +     "A \<in> preal ==> {} \<subset> inverse_set A"
  32.975 +apply (insert mem_inv_set_ex [of A])
  32.976 +apply (auto simp add: inverse_set_def)
  32.977  done
  32.978  
  32.979  text{*Part 2 of Dedekind sections definition*}
  32.980 -lemma qinv_mem_Rep_preal_Ex: "\<exists>y. qinv(y) \<in>  Rep_preal X"
  32.981 -apply (cut_tac X = X in mem_Rep_preal_Ex)
  32.982 -apply (erule exE, cut_tac x = x in prat_as_inverse_ex, auto)
  32.983 -done
  32.984  
  32.985 -lemma preal_not_mem_inv_set_Ex:
  32.986 -     "\<exists>x. x \<notin> {x. \<exists>y. x < y & qinv y \<notin>  Rep_preal A}"
  32.987 -apply (rule ccontr)
  32.988 -apply (cut_tac X = A in qinv_mem_Rep_preal_Ex, auto)
  32.989 -apply (erule allE, clarify) 
  32.990 -apply (drule qinv_prat_less, drule not_in_preal_ub)
  32.991 -apply (erule_tac x = "qinv y" in ballE)
  32.992 -apply (drule prat_less_trans)
  32.993 -apply (auto simp add: prat_less_not_refl)
  32.994 -done
  32.995 +lemma preal_not_mem_inverse_set_Ex:
  32.996 +   assumes A: "A \<in> preal"  shows "\<exists>q. 0 < q & q \<notin> inverse_set A"
  32.997 +proof -
  32.998 +  from preal_nonempty [OF A]
  32.999 +  obtain x where x: "x \<in> A" and  xpos [simp]: "0<x" ..
 32.1000 +  show ?thesis
 32.1001 +  proof (intro exI conjI)
 32.1002 +    show "0 < inverse x" by simp
 32.1003 +    show "inverse x \<notin> inverse_set A"
 32.1004 +    proof (auto simp add: inverse_set_def)
 32.1005 +      fix y::rat 
 32.1006 +      assume ygt: "inverse x < y"
 32.1007 +      have [simp]: "0 < y" by (simp add: order_less_trans [OF _ ygt])
 32.1008 +      have iyless: "inverse y < x" 
 32.1009 +        by (simp add: inverse_less_imp_less [of x] ygt)
 32.1010 +      show "inverse y \<in> A"
 32.1011 +        by (simp add: preal_downwards_closed [OF A x] iyless) 
 32.1012 +    qed
 32.1013 +  qed
 32.1014 +qed
 32.1015  
 32.1016 -lemma preal_inv_set_not_prat_set:
 32.1017 -     "{x. \<exists>y. x < y & qinv y \<notin>  Rep_preal A} < UNIV"
 32.1018 -apply (auto intro!: psubsetI)
 32.1019 -apply (cut_tac A = A in preal_not_mem_inv_set_Ex, auto)
 32.1020 -done
 32.1021 +lemma inverse_set_not_rat_set:
 32.1022 +   assumes A: "A \<in> preal"  shows "inverse_set A < {r. 0 < r}"
 32.1023 +proof
 32.1024 +  show "inverse_set A \<subseteq> {r. 0 < r}"  by (force simp add: inverse_set_def)
 32.1025 +next
 32.1026 +  show "inverse_set A \<noteq> {r. 0 < r}"
 32.1027 +    by (insert preal_not_mem_inverse_set_Ex [OF A], blast)
 32.1028 +qed
 32.1029  
 32.1030  text{*Part 3 of Dedekind sections definition*}
 32.1031 -lemma preal_inv_set_lemma3:
 32.1032 -     "\<forall>y \<in> {x. \<exists>y. x < y & qinv y \<notin> Rep_preal A}.
 32.1033 -        \<forall>z. z < y --> z \<in> {x. \<exists>y. x < y & qinv y \<notin> Rep_preal A}"
 32.1034 -apply auto
 32.1035 -apply (rule_tac x = ya in exI)
 32.1036 -apply (auto intro: prat_less_trans)
 32.1037 +lemma inverse_set_lemma3:
 32.1038 +     "[|A \<in> preal; u \<in> inverse_set A; 0 < z; z < u|] 
 32.1039 +      ==> z \<in> inverse_set A"
 32.1040 +apply (auto simp add: inverse_set_def)
 32.1041 +apply (auto intro: order_less_trans)
 32.1042  done
 32.1043  
 32.1044 -lemma preal_inv_set_lemma4:
 32.1045 -     "\<forall>y \<in> {x. \<exists>y. x < y & qinv y \<notin> Rep_preal A}.
 32.1046 -        Bex {x. \<exists>y. x < y & qinv y \<notin> Rep_preal A} (op < y)"
 32.1047 -by (blast dest: prat_dense)
 32.1048 -
 32.1049 -lemma preal_mem_inv_set: "{x. \<exists>y. x < y & qinv(y) \<notin> Rep_preal(A)} \<in> preal"
 32.1050 -apply (rule prealI2)
 32.1051 -apply (rule preal_inv_set_not_empty)
 32.1052 -apply (rule preal_inv_set_not_prat_set)
 32.1053 -apply (rule preal_inv_set_lemma3)
 32.1054 -apply (rule preal_inv_set_lemma4)
 32.1055 +text{*Part 4 of Dedekind sections definition*}
 32.1056 +lemma inverse_set_lemma4:
 32.1057 +     "[|A \<in> preal; y \<in> inverse_set A|] ==> \<exists>u \<in> inverse_set A. y < u"
 32.1058 +apply (auto simp add: inverse_set_def)
 32.1059 +apply (drule dense [of y]) 
 32.1060 +apply (blast intro: order_less_trans)
 32.1061  done
 32.1062  
 32.1063 -(*more lemmas for inverse *)
 32.1064 -lemma preal_mem_mult_invD:
 32.1065 -     "x \<in> Rep_preal(pinv(A)*A) ==>
 32.1066 -      x \<in> Rep_preal(preal_of_prat (prat_of_pnat (Abs_pnat (Suc 0))))"
 32.1067 -apply (auto dest!: mem_Rep_preal_multD simp add: pinv_def preal_of_prat_def)
 32.1068 -apply (drule preal_mem_inv_set [THEN Abs_preal_inverse, THEN subst])
 32.1069 -apply (auto dest!: not_in_preal_ub)
 32.1070 -apply (drule prat_mult_less_mono, blast, auto)
 32.1071 +
 32.1072 +lemma mem_inverse_set:
 32.1073 +     "A \<in> preal ==> inverse_set A \<in> preal"
 32.1074 +apply (simp (no_asm_simp) add: preal_def cut_def)
 32.1075 +apply (blast intro!: inverse_set_not_empty inverse_set_not_rat_set
 32.1076 +                     inverse_set_lemma3 inverse_set_lemma4)
 32.1077  done
 32.1078  
 32.1079 +
 32.1080  subsection{*Gleason's Lemma 9-3.4, page 122*}
 32.1081  
 32.1082 -lemma lemma1_gleason9_34:
 32.1083 -     "\<forall>xa \<in> Rep_preal(A). xa + x \<in> Rep_preal(A) ==>
 32.1084 -             \<exists>xb \<in> Rep_preal(A). xb + (prat_of_pnat p)*x \<in> Rep_preal(A)"
 32.1085 -apply (cut_tac mem_Rep_preal_Ex)
 32.1086 -apply (induct_tac "p" rule: pnat_induct)
 32.1087 -apply (auto simp add: pnat_one_def pSuc_is_plus_one prat_add_mult_distrib 
 32.1088 -                      prat_of_pnat_add prat_add_assoc [symmetric])
 32.1089 -done
 32.1090 +(*????Why can't I get case_names like nonneg to work?*)
 32.1091 +lemma Gleason9_34_exists:
 32.1092 +  assumes A: "A \<in> preal"
 32.1093 +      and closed: "\<forall>x\<in>A. x + u \<in> A"
 32.1094 +      and nonneg: "0 \<le> z"
 32.1095 +     shows "\<exists>b\<in>A. b + (rat z) * u \<in> A"
 32.1096 +proof (cases z)
 32.1097 +  case (1 n)
 32.1098 +  show ?thesis
 32.1099 +  proof (simp add: prems, induct n)
 32.1100 +    case 0
 32.1101 +      from preal_nonempty [OF A]
 32.1102 +      show ?case  by force 
 32.1103 +    case (Suc k)
 32.1104 +      from this obtain b where "b \<in> A" "b + rat (int k) * u \<in> A" ..
 32.1105 +      hence "b + rat (int k)*u + u \<in> A" by (simp add: closed)
 32.1106 +      thus ?case by (force simp add: left_distrib add_ac prems) 
 32.1107 +  qed
 32.1108 +next
 32.1109 +  case (2 n)
 32.1110 +  with nonneg show ?thesis by simp
 32.1111 +qed
 32.1112 +
 32.1113  
 32.1114 -lemma lemma1b_gleason9_34:
 32.1115 -     "Abs_prat (ratrel `` {(y, z)}) < 
 32.1116 -      xb +
 32.1117 -      Abs_prat (ratrel `` {(x*y, Abs_pnat (Suc 0))}) * 
 32.1118 -      Abs_prat (ratrel `` {(w, x)})"
 32.1119 -apply (rule_tac j =
 32.1120 -        "Abs_prat (ratrel `` 
 32.1121 -           { (x * y, Abs_pnat (Suc 0))}) * Abs_prat (ratrel `` {(w, x)})" 
 32.1122 -       in prat_le_less_trans)
 32.1123 -apply (rule_tac [2] prat_self_less_add_right)
 32.1124 -apply (auto intro: lemma_Abs_prat_le3 
 32.1125 -            simp add: prat_mult pre_lemma_gleason9_34b pnat_mult_assoc)
 32.1126 -done
 32.1127 +lemma Gleason9_34_contra:
 32.1128 +  assumes A: "A \<in> preal"
 32.1129 +    shows "[|\<forall>x\<in>A. x + u \<in> A; 0 < u; 0 < y; y \<notin> A|] ==> False"
 32.1130 +proof (induct u, induct y)
 32.1131 +  fix a::int and b::int
 32.1132 +  fix c::int and d::int
 32.1133 +  assume bpos [simp]: "0 < b"
 32.1134 +     and dpos [simp]: "0 < d"
 32.1135 +     and closed: "\<forall>x\<in>A. x + (Fract c d) \<in> A"
 32.1136 +     and upos: "0 < Fract c d"
 32.1137 +     and ypos: "0 < Fract a b"
 32.1138 +     and notin: "Fract a b \<notin> A"
 32.1139 +  have cpos [simp]: "0 < c" 
 32.1140 +    by (simp add: zero_less_Fract_iff [OF dpos, symmetric] upos) 
 32.1141 +  have apos [simp]: "0 < a" 
 32.1142 +    by (simp add: zero_less_Fract_iff [OF bpos, symmetric] ypos) 
 32.1143 +  let ?k = "a*d"
 32.1144 +  have frle: "Fract a b \<le> rat ?k * (Fract c d)" 
 32.1145 +  proof -
 32.1146 +    have "?thesis = ((a * d * b * d) \<le> c * b * (a * d * b * d))"
 32.1147 +      by (simp add: rat_def mult_rat le_rat order_less_imp_not_eq2 mult_ac) 
 32.1148 +    moreover
 32.1149 +    have "(1 * (a * d * b * d)) \<le> c * b * (a * d * b * d)"
 32.1150 +      by (rule mult_mono, 
 32.1151 +          simp_all add: int_one_le_iff_zero_less zero_less_mult_iff 
 32.1152 +                        order_less_imp_le)
 32.1153 +    ultimately
 32.1154 +    show ?thesis by simp
 32.1155 +  qed
 32.1156 +  have k: "0 \<le> ?k" by (simp add: order_less_imp_le zero_less_mult_iff)  
 32.1157 +  from Gleason9_34_exists [OF A closed k]
 32.1158 +  obtain z where z: "z \<in> A" 
 32.1159 +             and mem: "z + rat ?k * Fract c d \<in> A" ..
 32.1160 +  have less: "z + rat ?k * Fract c d < Fract a b"
 32.1161 +    by (rule not_in_preal_ub [OF A notin mem ypos])
 32.1162 +  have "0<z" by (rule preal_imp_pos [OF A z])
 32.1163 +  with frle and less show False by arith 
 32.1164 +qed
 32.1165  
 32.1166 -lemma lemma_gleason9_34a:
 32.1167 -     "\<forall>xa \<in> Rep_preal(A). xa + x \<in> Rep_preal(A) ==> False"
 32.1168 -apply (cut_tac X = A in not_mem_Rep_preal_Ex)
 32.1169 -apply (erule exE)
 32.1170 -apply (drule not_in_preal_ub)
 32.1171 -apply (rule_tac z = x in eq_Abs_prat)
 32.1172 -apply (rule_tac z = xa in eq_Abs_prat)
 32.1173 -apply (drule_tac p = "y*xb" in lemma1_gleason9_34)
 32.1174 -apply (erule bexE)
 32.1175 -apply (cut_tac x = y and y = xb and w = xaa and z = ya and xb = xba in lemma1b_gleason9_34)
 32.1176 -apply (drule_tac x = "xba + prat_of_pnat (y * xb) * x" in bspec)
 32.1177 -apply (auto intro: prat_less_asym simp add: prat_of_pnat_def)
 32.1178 -done
 32.1179  
 32.1180 -lemma lemma_gleason9_34: "\<exists>r \<in> Rep_preal(R). r + x \<notin> Rep_preal(R)"
 32.1181 -apply (rule ccontr)
 32.1182 -apply (blast intro: lemma_gleason9_34a)
 32.1183 -done
 32.1184 +lemma Gleason9_34:
 32.1185 +  assumes A: "A \<in> preal"
 32.1186 +      and upos: "0 < u"
 32.1187 +    shows "\<exists>r \<in> A. r + u \<notin> A"
 32.1188 +proof (rule ccontr, simp)
 32.1189 +  assume closed: "\<forall>r\<in>A. r + u \<in> A"
 32.1190 +  from preal_exists_bound [OF A]
 32.1191 +  obtain y where y: "y \<notin> A" and ypos: "0 < y" by blast
 32.1192 +  show False
 32.1193 +    by (rule Gleason9_34_contra [OF A closed upos ypos y])
 32.1194 +qed
 32.1195 +
 32.1196  
 32.1197  
 32.1198  subsection{*Gleason's Lemma 9-3.6*}
 32.1199  
 32.1200 -lemma lemma1_gleason9_36: "r + r*qinv(xa)*Q3 = r*qinv(xa)*(xa + Q3)"
 32.1201 -apply (simp (no_asm_use) add: prat_add_mult_distrib2 prat_mult_assoc)
 32.1202 -done
 32.1203 +lemma lemma_gleason9_36:
 32.1204 +  assumes A: "A \<in> preal"
 32.1205 +      and x: "1 < x"
 32.1206 +    shows "\<exists>r \<in> A. r*x \<notin> A"
 32.1207 +proof -
 32.1208 +  from preal_nonempty [OF A]
 32.1209 +  obtain y where y: "y \<in> A" and  ypos: "0<y" ..
 32.1210 +  show ?thesis 
 32.1211 +  proof (rule classical)
 32.1212 +    assume "~(\<exists>r\<in>A. r * x \<notin> A)"
 32.1213 +    with y have ymem: "y * x \<in> A" by blast 
 32.1214 +    from ypos mult_strict_left_mono [OF x]
 32.1215 +    have yless: "y < y*x" by simp 
 32.1216 +    let ?d = "y*x - y"
 32.1217 +    from yless have dpos: "0 < ?d" and eq: "y + ?d = y*x" by auto
 32.1218 +    from Gleason9_34 [OF A dpos]
 32.1219 +    obtain r where r: "r\<in>A" and notin: "r + ?d \<notin> A" ..
 32.1220 +    have rpos: "0<r" by (rule preal_imp_pos [OF A r])
 32.1221 +    with dpos have rdpos: "0 < r + ?d" by arith
 32.1222 +    have "~ (r + ?d \<le> y + ?d)"
 32.1223 +    proof
 32.1224 +      assume le: "r + ?d \<le> y + ?d" 
 32.1225 +      from ymem have yd: "y + ?d \<in> A" by (simp add: eq)
 32.1226 +      have "r + ?d \<in> A" by (rule preal_downwards_closed' [OF A yd rdpos le])
 32.1227 +      with notin show False by simp
 32.1228 +    qed
 32.1229 +    hence "y < r" by simp
 32.1230 +    with ypos have  dless: "?d < (r * ?d)/y"
 32.1231 +      by (simp add: pos_less_divide_eq mult_commute [of ?d]
 32.1232 +                    mult_strict_right_mono dpos)
 32.1233 +    have "r + ?d < r*x"
 32.1234 +    proof -
 32.1235 +      have "r + ?d < r + (r * ?d)/y" by (simp add: dless)
 32.1236 +      also with ypos have "... = (r/y) * (y + ?d)"
 32.1237 +	by (simp only: right_distrib divide_inverse_zero mult_ac, simp)
 32.1238 +      also have "... = r*x" using ypos
 32.1239 +	by simp
 32.1240 +      finally show "r + ?d < r*x" .
 32.1241 +    qed
 32.1242 +    with r notin rdpos
 32.1243 +    show "\<exists>r\<in>A. r * x \<notin> A" by (blast dest:  preal_downwards_closed [OF A])
 32.1244 +  qed  
 32.1245 +qed
 32.1246  
 32.1247 -lemma lemma2_gleason9_36: "r*qinv(xa)*(xa*x) = r*x"
 32.1248 -apply (simp (no_asm_use) add: prat_mult_ac)
 32.1249 +subsection{*Existence of Inverse: Part 2*}
 32.1250 +
 32.1251 +lemma mem_Rep_preal_inverse_iff:
 32.1252 +      "(z \<in> Rep_preal(inverse R)) = 
 32.1253 +       (0 < z \<and> (\<exists>y. z < y \<and> inverse y \<notin> Rep_preal R))"
 32.1254 +apply (simp add: preal_inverse_def mem_inverse_set Rep_preal)
 32.1255 +apply (simp add: inverse_set_def) 
 32.1256  done
 32.1257  
 32.1258 -(*** FIXME: long! ***)
 32.1259 -lemma lemma_gleason9_36:
 32.1260 -     "prat_of_pnat 1 < x ==> \<exists>r \<in> Rep_preal(A). r*x \<notin> Rep_preal(A)"
 32.1261 -apply (rule_tac X1 = A in mem_Rep_preal_Ex [THEN exE])
 32.1262 -apply (rule_tac Q = "xa*x \<in> Rep_preal (A) " in excluded_middle [THEN disjE])
 32.1263 -apply fast
 32.1264 -apply (drule_tac x = xa in prat_self_less_mult_right)
 32.1265 -apply (erule prat_lessE)
 32.1266 -apply (cut_tac R = A and x = Q3 in lemma_gleason9_34)
 32.1267 -apply (drule sym, auto)
 32.1268 -apply (frule not_in_preal_ub)
 32.1269 -apply (drule_tac x = "xa + Q3" in bspec, assumption)
 32.1270 -apply (drule prat_add_right_less_cancel)
 32.1271 -apply (drule_tac x = "qinv (xa) *Q3" in prat_mult_less2_mono1)
 32.1272 -apply (drule_tac x = r in prat_add_less2_mono2)
 32.1273 -apply (simp add: prat_mult_assoc [symmetric] lemma1_gleason9_36)
 32.1274 -apply (drule sym)
 32.1275 -apply (auto simp add: lemma2_gleason9_36)
 32.1276 -apply (rule_tac x = r in bexI)
 32.1277 -apply (rule notI)
 32.1278 -apply (drule_tac y = "r*x" in Rep_preal [THEN prealE_lemma3b], auto)
 32.1279 +lemma Rep_preal_of_rat:
 32.1280 +     "0 < q ==> Rep_preal (preal_of_rat q) = {x. 0 < x \<and> x < q}"
 32.1281 +by (simp add: preal_of_rat_def rat_mem_preal) 
 32.1282 +
 32.1283 +lemma subset_inverse_mult_lemma:
 32.1284 +      assumes xpos: "0 < x" and xless: "x < 1"
 32.1285 +         shows "\<exists>r u y. 0 < r & r < y & inverse y \<notin> Rep_preal R & 
 32.1286 +                        u \<in> Rep_preal R & x = r * u"
 32.1287 +proof -
 32.1288 +  from xpos and xless have "1 < inverse x" by (simp add: one_less_inverse_iff)
 32.1289 +  from lemma_gleason9_36 [OF Rep_preal this]
 32.1290 +  obtain r where r: "r \<in> Rep_preal R" 
 32.1291 +             and notin: "r * (inverse x) \<notin> Rep_preal R" ..
 32.1292 +  have rpos: "0<r" by (rule preal_imp_pos [OF Rep_preal r])
 32.1293 +  from preal_exists_greater [OF Rep_preal r]
 32.1294 +  obtain u where u: "u \<in> Rep_preal R" and rless: "r < u" ..
 32.1295 +  have upos: "0<u" by (rule preal_imp_pos [OF Rep_preal u])
 32.1296 +  show ?thesis
 32.1297 +  proof (intro exI conjI)
 32.1298 +    show "0 < x/u" using xpos upos
 32.1299 +      by (simp add: zero_less_divide_iff)  
 32.1300 +    show "x/u < x/r" using xpos upos rpos
 32.1301 +      by (simp add: divide_inverse_zero mult_less_cancel_left rless) 
 32.1302 +    show "inverse (x / r) \<notin> Rep_preal R" using notin
 32.1303 +      by (simp add: divide_inverse_zero mult_commute) 
 32.1304 +    show "u \<in> Rep_preal R" by (rule u) 
 32.1305 +    show "x = x / u * u" using upos 
 32.1306 +      by (simp add: divide_inverse_zero mult_commute) 
 32.1307 +  qed
 32.1308 +qed
 32.1309 +
 32.1310 +lemma subset_inverse_mult: 
 32.1311 +     "Rep_preal(preal_of_rat 1) \<subseteq> Rep_preal(inverse R * R)"
 32.1312 +apply (auto simp add: Bex_def Rep_preal_of_rat mem_Rep_preal_inverse_iff 
 32.1313 +                      mem_Rep_preal_mult_iff)
 32.1314 +apply (blast dest: subset_inverse_mult_lemma) 
 32.1315  done
 32.1316  
 32.1317 -lemma lemma_gleason9_36a:
 32.1318 -     "prat_of_pnat (Abs_pnat (Suc 0)) < x ==>
 32.1319 -      \<exists>r \<in> Rep_preal(A). r*x \<notin> Rep_preal(A)"
 32.1320 -apply (rule lemma_gleason9_36)
 32.1321 -apply (simp (no_asm_simp) add: pnat_one_def)
 32.1322 +lemma inverse_mult_subset_lemma:
 32.1323 +     assumes rpos: "0 < r" 
 32.1324 +         and rless: "r < y"
 32.1325 +         and notin: "inverse y \<notin> Rep_preal R"
 32.1326 +         and q: "q \<in> Rep_preal R"
 32.1327 +     shows "r*q < 1"
 32.1328 +proof -
 32.1329 +  have "q < inverse y" using rpos rless
 32.1330 +    by (simp add: not_in_preal_ub [OF Rep_preal notin] q)
 32.1331 +  hence "r * q < r/y" using rpos
 32.1332 +    by (simp add: divide_inverse_zero mult_less_cancel_left)
 32.1333 +  also have "... \<le> 1" using rpos rless
 32.1334 +    by (simp add: pos_divide_le_eq)
 32.1335 +  finally show ?thesis .
 32.1336 +qed
 32.1337 +
 32.1338 +lemma inverse_mult_subset:
 32.1339 +     "Rep_preal(inverse R * R) \<subseteq> Rep_preal(preal_of_rat 1)"
 32.1340 +apply (auto simp add: Bex_def Rep_preal_of_rat mem_Rep_preal_inverse_iff 
 32.1341 +                      mem_Rep_preal_mult_iff)
 32.1342 +apply (simp add: zero_less_mult_iff preal_imp_pos [OF Rep_preal]) 
 32.1343 +apply (blast intro: inverse_mult_subset_lemma) 
 32.1344 +done
 32.1345 +
 32.1346 +lemma preal_mult_inverse:
 32.1347 +     "inverse R * R = (preal_of_rat 1)"
 32.1348 +apply (rule inj_Rep_preal [THEN injD])
 32.1349 +apply (rule equalityI [OF inverse_mult_subset subset_inverse_mult]) 
 32.1350 +done
 32.1351 +
 32.1352 +lemma preal_mult_inverse_right:
 32.1353 +     "R * inverse R = (preal_of_rat 1)"
 32.1354 +apply (rule preal_mult_commute [THEN subst])
 32.1355 +apply (rule preal_mult_inverse)
 32.1356  done
 32.1357  
 32.1358  
 32.1359 -subsection{*Existence of Inverse: Part 2*}
 32.1360 -lemma preal_mem_mult_invI:
 32.1361 -     "x \<in> Rep_preal(preal_of_prat (prat_of_pnat (Abs_pnat (Suc 0))))
 32.1362 -      ==> x \<in> Rep_preal(pinv(A)*A)"
 32.1363 -apply (auto intro!: mem_Rep_preal_multI simp add: pinv_def preal_of_prat_def)
 32.1364 -apply (rule preal_mem_inv_set [THEN Abs_preal_inverse, THEN ssubst])
 32.1365 -apply (drule prat_qinv_gt_1)
 32.1366 -apply (drule_tac A = A in lemma_gleason9_36a, auto)
 32.1367 -apply (drule Rep_preal [THEN prealE_lemma4a])
 32.1368 -apply (auto, drule qinv_prat_less)
 32.1369 -apply (rule_tac x = "qinv (u) *x" in exI)
 32.1370 -apply (rule conjI)
 32.1371 -apply (rule_tac x = "qinv (r) *x" in exI)
 32.1372 -apply (auto intro: prat_mult_less2_mono1 simp add: qinv_mult_eq qinv_qinv)
 32.1373 -apply (rule_tac x = u in bexI)
 32.1374 -apply (auto simp add: prat_mult_assoc prat_mult_left_commute)
 32.1375 -done
 32.1376 -
 32.1377 -lemma preal_mult_inv:
 32.1378 -     "pinv(A)*A = (preal_of_prat (prat_of_pnat (Abs_pnat (Suc 0))))"
 32.1379 -apply (rule inj_Rep_preal [THEN injD])
 32.1380 -apply (fast dest: preal_mem_mult_invD preal_mem_mult_invI)
 32.1381 -done
 32.1382 +text{*Theorems needing @{text Gleason9_34}*}
 32.1383  
 32.1384 -lemma preal_mult_inv_right:
 32.1385 -     "A*pinv(A) = (preal_of_prat (prat_of_pnat (Abs_pnat (Suc 0))))"
 32.1386 -apply (rule preal_mult_commute [THEN subst])
 32.1387 -apply (rule preal_mult_inv)
 32.1388 -done
 32.1389 -
 32.1390 -
 32.1391 -text{*Theorems needing @{text lemma_gleason9_34}*}
 32.1392 +lemma Rep_preal_self_subset: "Rep_preal (R) \<subseteq> Rep_preal(R + S)"
 32.1393 +proof 
 32.1394 +  fix r
 32.1395 +  assume r: "r \<in> Rep_preal R"
 32.1396 +  have rpos: "0<r" by (rule preal_imp_pos [OF Rep_preal r])
 32.1397 +  from mem_Rep_preal_Ex 
 32.1398 +  obtain y where y: "y \<in> Rep_preal S" ..
 32.1399 +  have ypos: "0<y" by (rule preal_imp_pos [OF Rep_preal y])
 32.1400 +  have ry: "r+y \<in> Rep_preal(R + S)" using r y
 32.1401 +    by (auto simp add: mem_Rep_preal_add_iff)
 32.1402 +  show "r \<in> Rep_preal(R + S)" using r ypos rpos 
 32.1403 +    by (simp add:  preal_downwards_closed [OF Rep_preal ry]) 
 32.1404 +qed
 32.1405  
 32.1406 -lemma Rep_preal_self_subset: "Rep_preal (R1) \<subseteq> Rep_preal(R1 + R2)"
 32.1407 -apply (cut_tac X = R2 in mem_Rep_preal_Ex)
 32.1408 -apply (auto intro!: bexI 
 32.1409 -            intro: Rep_preal [THEN prealE_lemma3b] prat_self_less_add_left 
 32.1410 -                   mem_Rep_preal_addI)
 32.1411 -done
 32.1412 +lemma Rep_preal_sum_not_subset: "~ Rep_preal (R + S) \<subseteq> Rep_preal(R)"
 32.1413 +proof -
 32.1414 +  from mem_Rep_preal_Ex 
 32.1415 +  obtain y where y: "y \<in> Rep_preal S" ..
 32.1416 +  have ypos: "0<y" by (rule preal_imp_pos [OF Rep_preal y])
 32.1417 +  from  Gleason9_34 [OF Rep_preal ypos]
 32.1418 +  obtain r where r: "r \<in> Rep_preal R" and notin: "r + y \<notin> Rep_preal R" ..
 32.1419 +  have "r + y \<in> Rep_preal (R + S)" using r y
 32.1420 +    by (auto simp add: mem_Rep_preal_add_iff)
 32.1421 +  thus ?thesis using notin by blast
 32.1422 +qed
 32.1423  
 32.1424 -lemma Rep_preal_sum_not_subset: "~ Rep_preal (R1 + R2) \<subseteq> Rep_preal(R1)"
 32.1425 -apply (cut_tac X = R2 in mem_Rep_preal_Ex)
 32.1426 -apply (erule exE)
 32.1427 -apply (cut_tac R = R1 in lemma_gleason9_34)
 32.1428 -apply (auto intro: mem_Rep_preal_addI)
 32.1429 -done
 32.1430 -
 32.1431 -lemma Rep_preal_sum_not_eq: "Rep_preal (R1 + R2) \<noteq> Rep_preal(R1)"
 32.1432 -apply (rule notI)
 32.1433 -apply (erule equalityE)
 32.1434 -apply (simp add: Rep_preal_sum_not_subset)
 32.1435 -done
 32.1436 +lemma Rep_preal_sum_not_eq: "Rep_preal (R + S) \<noteq> Rep_preal(R)"
 32.1437 +by (insert Rep_preal_sum_not_subset, blast)
 32.1438  
 32.1439  text{*at last, Gleason prop. 9-3.5(iii) page 123*}
 32.1440 -lemma preal_self_less_add_left: "(R1::preal) < R1 + R2"
 32.1441 +lemma preal_self_less_add_left: "(R::preal) < R + S"
 32.1442  apply (unfold preal_less_def psubset_def)
 32.1443  apply (simp add: Rep_preal_self_subset Rep_preal_sum_not_eq [THEN not_sym])
 32.1444  done
 32.1445  
 32.1446 -lemma preal_self_less_add_right: "(R1::preal) < R2 + R1"
 32.1447 -apply (simp add: preal_add_commute preal_self_less_add_left)
 32.1448 -done
 32.1449 +lemma preal_self_less_add_right: "(R::preal) < S + R"
 32.1450 +by (simp add: preal_add_commute preal_self_less_add_left)
 32.1451 +
 32.1452 +lemma preal_not_eq_self: "x \<noteq> x + (y::preal)"
 32.1453 +by (insert preal_self_less_add_left [of x y], auto)
 32.1454  
 32.1455  
 32.1456 -subsection{*The @{text "\<le>"} Ordering*}
 32.1457 -
 32.1458 -lemma preal_less_le_iff: "(~(w < z)) = (z \<le> (w::preal))"
 32.1459 -apply (unfold preal_le_def psubset_def preal_less_def)
 32.1460 -apply (insert preal_linear [of w z])
 32.1461 -apply (auto simp add: preal_less_def psubset_def)
 32.1462 -done
 32.1463 -
 32.1464 -lemma preal_le_iff_less_or_eq:
 32.1465 -     "((x::preal) \<le> y) = (x < y | x = y)"
 32.1466 -apply (unfold preal_le_def preal_less_def psubset_def)
 32.1467 -apply (auto intro: inj_Rep_preal [THEN injD])
 32.1468 -done
 32.1469 -
 32.1470 -lemma preal_le_refl: "w \<le> (w::preal)"
 32.1471 -apply (simp add: preal_le_def)
 32.1472 -done
 32.1473 -
 32.1474 -lemma preal_le_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::preal)"
 32.1475 -apply (simp add: preal_le_iff_less_or_eq) 
 32.1476 -apply (blast intro: preal_less_trans)
 32.1477 -done
 32.1478 -
 32.1479 -lemma preal_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::preal)"
 32.1480 -apply (simp add: preal_le_iff_less_or_eq) 
 32.1481 -apply (blast intro: preal_less_asym)
 32.1482 -done
 32.1483 +subsection{*Subtraction for Positive Reals*}
 32.1484  
 32.1485 -lemma preal_neq_iff: "(w \<noteq> z) = (w<z | z < (w::preal))"
 32.1486 -apply (insert preal_linear [of w z])
 32.1487 -apply (auto elim: preal_less_irrefl)
 32.1488 -done
 32.1489 -
 32.1490 -(* Axiom 'order_less_le' of class 'order': *)
 32.1491 -lemma preal_less_le: "((w::preal) < z) = (w \<le> z & w \<noteq> z)"
 32.1492 -apply (simp (no_asm) add: preal_less_le_iff [symmetric] preal_neq_iff)
 32.1493 -apply (blast elim!: preal_less_asym)
 32.1494 -done
 32.1495 -
 32.1496 -instance preal :: order
 32.1497 -proof qed
 32.1498 - (assumption |
 32.1499 -  rule preal_le_refl preal_le_trans preal_le_anti_sym preal_less_le)+
 32.1500 -
 32.1501 -lemma preal_le_linear: "x <= y | y <= (x::preal)"
 32.1502 -apply (insert preal_linear [of x y]) 
 32.1503 -apply (auto simp add: order_less_le) 
 32.1504 -done
 32.1505 -
 32.1506 -instance preal :: linorder
 32.1507 -  by (intro_classes, rule preal_le_linear)
 32.1508 -
 32.1509 -
 32.1510 -subsection{*Gleason prop. 9-3.5(iv), page 123*}
 32.1511 -
 32.1512 -text{*Proving @{term "A < B ==> \<exists>D. A + D = B"}*}
 32.1513 -
 32.1514 -text{*Define the claimed D and show that it is a positive real*}
 32.1515 +text{*Gleason prop. 9-3.5(iv), page 123: proving @{term "A < B ==> \<exists>D. A + D =
 32.1516 +B"}. We define the claimed @{term D} and show that it is a positive real*}
 32.1517  
 32.1518  text{*Part 1 of Dedekind sections definition*}
 32.1519 -lemma lemma_ex_mem_less_left_add1:
 32.1520 -     "A < B ==>
 32.1521 -      \<exists>q. q \<in> {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}"
 32.1522 -apply (unfold preal_less_def psubset_def)
 32.1523 -apply (clarify) 
 32.1524 -apply (drule_tac x1 = B in Rep_preal [THEN prealE_lemma4a])
 32.1525 -apply (auto simp add: prat_less_def)
 32.1526 -done
 32.1527 -
 32.1528 -lemma preal_less_set_not_empty:
 32.1529 -     "A < B ==> {} < {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}"
 32.1530 -apply (drule lemma_ex_mem_less_left_add1)
 32.1531 -apply (auto intro!: psubsetI)
 32.1532 +lemma diff_set_not_empty:
 32.1533 +     "R < S ==> {} \<subset> diff_set (Rep_preal S) (Rep_preal R)"
 32.1534 +apply (auto simp add: preal_less_def diff_set_def elim!: equalityE) 
 32.1535 +apply (frule_tac x1 = S in Rep_preal [THEN preal_exists_greater])
 32.1536 +apply (drule preal_imp_pos [OF Rep_preal], clarify)
 32.1537 +apply (cut_tac a=x and b=u in add_eq_exists, force) 
 32.1538  done
 32.1539  
 32.1540  text{*Part 2 of Dedekind sections definition*}
 32.1541 -lemma lemma_ex_not_mem_less_left_add1:
 32.1542 -     "\<exists>q. q \<notin> {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}"
 32.1543 -apply (cut_tac X = B in not_mem_Rep_preal_Ex)
 32.1544 +lemma diff_set_nonempty:
 32.1545 +     "\<exists>q. 0 < q & q \<notin> diff_set (Rep_preal S) (Rep_preal R)"
 32.1546 +apply (cut_tac X = S in Rep_preal_exists_bound)
 32.1547  apply (erule exE)
 32.1548  apply (rule_tac x = x in exI, auto)
 32.1549 -apply (cut_tac x = x and y = n in prat_self_less_add_right)
 32.1550 -apply (auto dest: Rep_preal [THEN prealE_lemma3b])
 32.1551 +apply (simp add: diff_set_def) 
 32.1552 +apply (auto dest: Rep_preal [THEN preal_downwards_closed])
 32.1553  done
 32.1554  
 32.1555 -lemma preal_less_set_not_prat_set:
 32.1556 -     "{d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)} < UNIV"
 32.1557 -apply (auto intro!: psubsetI)
 32.1558 -apply (cut_tac A = A and B = B in lemma_ex_not_mem_less_left_add1, auto)
 32.1559 -done
 32.1560 +lemma diff_set_not_rat_set:
 32.1561 +     "diff_set (Rep_preal S) (Rep_preal R) < {r. 0 < r}" (is "?lhs < ?rhs")
 32.1562 +proof
 32.1563 +  show "?lhs \<subseteq> ?rhs" by (auto simp add: diff_set_def) 
 32.1564 +  show "?lhs \<noteq> ?rhs" using diff_set_nonempty by blast
 32.1565 +qed
 32.1566  
 32.1567  text{*Part 3 of Dedekind sections definition*}
 32.1568 -lemma preal_less_set_lemma3:
 32.1569 -     "A < B ==> \<forall>y \<in> {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}.
 32.1570 -     \<forall>z. z < y --> z \<in> {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}"
 32.1571 -apply auto
 32.1572 -apply (drule_tac x = n in prat_add_less2_mono2)
 32.1573 -apply (drule Rep_preal [THEN prealE_lemma3b], auto)
 32.1574 +lemma diff_set_lemma3:
 32.1575 +     "[|R < S; u \<in> diff_set (Rep_preal S) (Rep_preal R); 0 < z; z < u|] 
 32.1576 +      ==> z \<in> diff_set (Rep_preal S) (Rep_preal R)"
 32.1577 +apply (auto simp add: diff_set_def) 
 32.1578 +apply (rule_tac x=x in exI) 
 32.1579 +apply (drule Rep_preal [THEN preal_downwards_closed], auto)
 32.1580  done
 32.1581  
 32.1582 -lemma preal_less_set_lemma4:
 32.1583 -     "A < B ==> \<forall>y \<in> {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}.
 32.1584 -        Bex {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)} (op < y)"
 32.1585 -apply auto
 32.1586 -apply (drule Rep_preal [THEN prealE_lemma4a])
 32.1587 -apply (auto simp add: prat_less_def prat_add_assoc)
 32.1588 +text{*Part 4 of Dedekind sections definition*}
 32.1589 +lemma diff_set_lemma4:
 32.1590 +     "[|R < S; y \<in> diff_set (Rep_preal S) (Rep_preal R)|] 
 32.1591 +      ==> \<exists>u \<in> diff_set (Rep_preal S) (Rep_preal R). y < u"
 32.1592 +apply (auto simp add: diff_set_def) 
 32.1593 +apply (drule Rep_preal [THEN preal_exists_greater], clarify) 
 32.1594 +apply (cut_tac a="x+y" and b=u in add_eq_exists, clarify)  
 32.1595 +apply (rule_tac x="y+xa" in exI) 
 32.1596 +apply (auto simp add: add_ac)
 32.1597  done
 32.1598  
 32.1599 -lemma preal_mem_less_set:
 32.1600 -     "!! (A::preal). A < B ==>
 32.1601 -      {d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}: preal"
 32.1602 -apply (rule prealI2)
 32.1603 -apply (rule preal_less_set_not_empty)
 32.1604 -apply (rule_tac [2] preal_less_set_not_prat_set)
 32.1605 -apply (rule_tac [2] preal_less_set_lemma3)
 32.1606 -apply (rule_tac [3] preal_less_set_lemma4, auto)
 32.1607 +lemma mem_diff_set:
 32.1608 +     "R < S ==> diff_set (Rep_preal S) (Rep_preal R) \<in> preal"
 32.1609 +apply (unfold preal_def cut_def)
 32.1610 +apply (blast intro!: diff_set_not_empty diff_set_not_rat_set
 32.1611 +                     diff_set_lemma3 diff_set_lemma4)
 32.1612 +done
 32.1613 +
 32.1614 +lemma mem_Rep_preal_diff_iff:
 32.1615 +      "R < S ==>
 32.1616 +       (z \<in> Rep_preal(S-R)) = 
 32.1617 +       (\<exists>x. 0 < x & 0 < z & x \<notin> Rep_preal R & x + z \<in> Rep_preal S)"
 32.1618 +apply (simp add: preal_diff_def mem_diff_set Rep_preal)
 32.1619 +apply (force simp add: diff_set_def) 
 32.1620  done
 32.1621  
 32.1622 -text{*proving that @{term "A + D \<le> B"}*}
 32.1623 -lemma preal_less_add_left_subsetI:
 32.1624 -       "!! (A::preal). A < B ==>
 32.1625 -          A + Abs_preal({d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}) \<le> B"
 32.1626 -apply (unfold preal_le_def)
 32.1627 -apply (rule subsetI)
 32.1628 -apply (drule mem_Rep_preal_addD)
 32.1629 -apply (auto simp add: preal_mem_less_set [THEN Abs_preal_inverse])
 32.1630 -apply (drule not_in_preal_ub)
 32.1631 -apply (drule bspec, assumption)
 32.1632 -apply (drule_tac x = y in prat_add_less2_mono1)
 32.1633 -apply (drule_tac x1 = B in Rep_preal [THEN prealE_lemma3b], auto)
 32.1634 +
 32.1635 +text{*proving that @{term "R + D \<le> S"}*}
 32.1636 +
 32.1637 +lemma less_add_left_lemma:
 32.1638 +  assumes Rless: "R < S"
 32.1639 +      and a: "a \<in> Rep_preal R"
 32.1640 +      and cb: "c + b \<in> Rep_preal S"
 32.1641 +      and "c \<notin> Rep_preal R"
 32.1642 +      and "0 < b"
 32.1643 +      and "0 < c"
 32.1644 +  shows "a + b \<in> Rep_preal S"
 32.1645 +proof -
 32.1646 +  have "0<a" by (rule preal_imp_pos [OF Rep_preal a])
 32.1647 +  moreover
 32.1648 +  have "a < c" using prems
 32.1649 +    by (blast intro: not_in_Rep_preal_ub ) 
 32.1650 +  ultimately show ?thesis using prems
 32.1651 +    by (simp add: preal_downwards_closed [OF Rep_preal cb]) 
 32.1652 +qed
 32.1653 +
 32.1654 +lemma less_add_left_le1:
 32.1655 +       "R < (S::preal) ==> R + (S-R) \<le> S"
 32.1656 +apply (auto simp add: Bex_def preal_le_def mem_Rep_preal_add_iff 
 32.1657 +                      mem_Rep_preal_diff_iff)
 32.1658 +apply (blast intro: less_add_left_lemma) 
 32.1659  done
 32.1660  
 32.1661 -subsection{*proving that @{term "B \<le> A + D"} --- trickier*}
 32.1662 +subsection{*proving that @{term "S \<le> R + D"} --- trickier*}
 32.1663  
 32.1664  lemma lemma_sum_mem_Rep_preal_ex:
 32.1665 -     "x \<in> Rep_preal(B) ==> \<exists>e. x + e \<in> Rep_preal(B)"
 32.1666 -apply (drule Rep_preal [THEN prealE_lemma4a])
 32.1667 -apply (auto simp add: prat_less_def)
 32.1668 +     "x \<in> Rep_preal S ==> \<exists>e. 0 < e & x + e \<in> Rep_preal S"
 32.1669 +apply (drule Rep_preal [THEN preal_exists_greater], clarify) 
 32.1670 +apply (cut_tac a=x and b=u in add_eq_exists, auto) 
 32.1671  done
 32.1672  
 32.1673 -lemma preal_less_add_left_subsetI2:
 32.1674 -       "!! (A::preal). A < B ==>
 32.1675 -          B \<le> A + Abs_preal({d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)})"
 32.1676 -apply (unfold preal_le_def)
 32.1677 -apply (rule subsetI)
 32.1678 -apply (rule_tac Q = "x \<in> Rep_preal (A) " in excluded_middle [THEN disjE])
 32.1679 -apply (rule mem_Rep_preal_addI)
 32.1680 -apply (drule lemma_sum_mem_Rep_preal_ex)
 32.1681 -apply (erule exE)
 32.1682 -apply (cut_tac R = A and x = e in lemma_gleason9_34, erule bexE)
 32.1683 -apply (drule not_in_preal_ub, drule bspec, assumption)
 32.1684 -apply (erule prat_lessE)
 32.1685 -apply (rule_tac x = r in bexI)
 32.1686 -apply (rule_tac x = Q3 in bexI)
 32.1687 -apply (cut_tac [4] Rep_preal_self_subset)
 32.1688 -apply (auto simp add: preal_mem_less_set [THEN Abs_preal_inverse])
 32.1689 -apply (rule_tac x = "r+e" in exI)
 32.1690 -apply (simp add: prat_add_ac)
 32.1691 +lemma less_add_left_lemma2:
 32.1692 +  assumes Rless: "R < S"
 32.1693 +      and x:     "x \<in> Rep_preal S"
 32.1694 +      and xnot: "x \<notin>  Rep_preal R"
 32.1695 +  shows "\<exists>u v z. 0 < v & 0 < z & u \<in> Rep_preal R & z \<notin> Rep_preal R & 
 32.1696 +                     z + v \<in> Rep_preal S & x = u + v"
 32.1697 +proof -
 32.1698 +  have xpos: "0<x" by (rule preal_imp_pos [OF Rep_preal x])
 32.1699 +  from lemma_sum_mem_Rep_preal_ex [OF x]
 32.1700 +  obtain e where epos: "0 < e" and xe: "x + e \<in> Rep_preal S" by blast
 32.1701 +  from  Gleason9_34 [OF Rep_preal epos]
 32.1702 +  obtain r where r: "r \<in> Rep_preal R" and notin: "r + e \<notin> Rep_preal R" ..
 32.1703 +  with x xnot xpos have rless: "r < x" by (blast intro: not_in_Rep_preal_ub)
 32.1704 +  from add_eq_exists [of r x]
 32.1705 +  obtain y where eq: "x = r+y" by auto
 32.1706 +  show ?thesis 
 32.1707 +  proof (intro exI conjI)
 32.1708 +    show "r \<in> Rep_preal R" by (rule r)
 32.1709 +    show "r + e \<notin> Rep_preal R" by (rule notin)
 32.1710 +    show "r + e + y \<in> Rep_preal S" using xe eq by (simp add: add_ac)
 32.1711 +    show "x = r + y" by (simp add: eq)
 32.1712 +    show "0 < r + e" using epos preal_imp_pos [OF Rep_preal r]
 32.1713 +      by simp
 32.1714 +    show "0 < y" using rless eq by arith
 32.1715 +  qed
 32.1716 +qed
 32.1717 +
 32.1718 +lemma less_add_left_le2: "R < (S::preal) ==> S \<le> R + (S-R)"
 32.1719 +apply (auto simp add: preal_le_def)
 32.1720 +apply (case_tac "x \<in> Rep_preal R")
 32.1721 +apply (cut_tac Rep_preal_self_subset [of R], force)
 32.1722 +apply (auto simp add: Bex_def mem_Rep_preal_add_iff mem_Rep_preal_diff_iff)
 32.1723 +apply (blast dest: less_add_left_lemma2)
 32.1724  done
 32.1725  
 32.1726 -(*** required proof ***)
 32.1727 -lemma preal_less_add_left:
 32.1728 -     "!! (A::preal). A < B ==>
 32.1729 -          A + Abs_preal({d. \<exists>n. n \<notin> Rep_preal(A) & n + d \<in> Rep_preal(B)}) = B"
 32.1730 -apply (blast intro: preal_le_anti_sym preal_less_add_left_subsetI preal_less_add_left_subsetI2)
 32.1731 -done
 32.1732 +lemma less_add_left: "R < (S::preal) ==> R + (S-R) = S"
 32.1733 +by (blast intro: preal_le_anti_sym [OF less_add_left_le1 less_add_left_le2])
 32.1734  
 32.1735 -lemma preal_less_add_left_Ex: "!! (A::preal). A < B ==> \<exists>D. A + D = B"
 32.1736 -by (fast dest: preal_less_add_left)
 32.1737 +lemma less_add_left_Ex: "R < (S::preal) ==> \<exists>D. R + D = S"
 32.1738 +by (fast dest: less_add_left)
 32.1739  
 32.1740 -lemma preal_add_less2_mono1: "!!(A::preal). A < B ==> A + C < B + C"
 32.1741 -apply (auto dest!: preal_less_add_left_Ex simp add: preal_add_assoc)
 32.1742 +lemma preal_add_less2_mono1: "R < (S::preal) ==> R + T < S + T"
 32.1743 +apply (auto dest!: less_add_left_Ex simp add: preal_add_assoc)
 32.1744  apply (rule_tac y1 = D in preal_add_commute [THEN subst])
 32.1745  apply (auto intro: preal_self_less_add_left simp add: preal_add_assoc [symmetric])
 32.1746  done
 32.1747  
 32.1748 -lemma preal_add_less2_mono2: "!!(A::preal). A < B ==> C + A < C + B"
 32.1749 -by (auto intro: preal_add_less2_mono1 simp add: preal_add_commute)
 32.1750 +lemma preal_add_less2_mono2: "R < (S::preal) ==> T + R < T + S"
 32.1751 +by (auto intro: preal_add_less2_mono1 simp add: preal_add_commute [of T])
 32.1752  
 32.1753 -lemma preal_mult_less_mono1:
 32.1754 -      "!!(q1::preal). q1 < q2 ==> q1 * x < q2 * x"
 32.1755 -apply (drule preal_less_add_left_Ex)
 32.1756 -apply (auto simp add: preal_add_mult_distrib preal_self_less_add_left)
 32.1757 -done
 32.1758 -
 32.1759 -lemma preal_mult_left_less_mono1: "!!(q1::preal). q1 < q2  ==> x * q1 < x * q2"
 32.1760 -by (auto dest: preal_mult_less_mono1 simp add: preal_mult_commute)
 32.1761 -
 32.1762 -lemma preal_mult_left_le_mono1: "!!(q1::preal). q1 \<le> q2  ==> x * q1 \<le> x * q2"
 32.1763 -apply (simp add: preal_le_iff_less_or_eq) 
 32.1764 -apply (blast intro!: preal_mult_left_less_mono1)
 32.1765 +lemma preal_add_right_less_cancel: "R + T < S + T ==> R < (S::preal)"
 32.1766 +apply (insert linorder_less_linear [of R S], auto)
 32.1767 +apply (drule_tac R = S and T = T in preal_add_less2_mono1)
 32.1768 +apply (blast dest: order_less_trans) 
 32.1769  done
 32.1770  
 32.1771 -lemma preal_mult_le_mono1: "!!(q1::preal). q1 \<le> q2  ==> q1 * x \<le> q2 * x"
 32.1772 -by (auto dest: preal_mult_left_le_mono1 simp add: preal_mult_commute)
 32.1773 -
 32.1774 -lemma preal_add_left_le_mono1: "!!(q1::preal). q1 \<le> q2  ==> x + q1 \<le> x + q2"
 32.1775 -apply (simp add: preal_le_iff_less_or_eq) 
 32.1776 -apply (auto intro!: preal_add_less2_mono1 simp add: preal_add_commute)
 32.1777 -done
 32.1778 -
 32.1779 -lemma preal_add_le_mono1: "!!(q1::preal). q1 \<le> q2  ==> q1 + x \<le> q2 + x"
 32.1780 -by (auto dest: preal_add_left_le_mono1 simp add: preal_add_commute)
 32.1781 +lemma preal_add_left_less_cancel: "T + R < T + S ==> R <  (S::preal)"
 32.1782 +by (auto elim: preal_add_right_less_cancel simp add: preal_add_commute [of T])
 32.1783  
 32.1784 -lemma preal_add_right_less_cancel: "!!(A::preal). A + C < B + C ==> A < B"
 32.1785 -apply (cut_tac preal_linear)
 32.1786 -apply (auto elim: preal_less_irrefl)
 32.1787 -apply (drule_tac A = B and C = C in preal_add_less2_mono1)
 32.1788 -apply (fast dest: preal_less_trans elim: preal_less_irrefl)
 32.1789 -done
 32.1790 -
 32.1791 -lemma preal_add_left_less_cancel: "!!(A::preal). C + A < C + B ==> A < B"
 32.1792 -by (auto elim: preal_add_right_less_cancel simp add: preal_add_commute)
 32.1793 -
 32.1794 -lemma preal_add_less_iff1 [simp]: "((A::preal) + C < B + C) = (A < B)"
 32.1795 +lemma preal_add_less_cancel_right: "((R::preal) + T < S + T) = (R < S)"
 32.1796  by (blast intro: preal_add_less2_mono1 preal_add_right_less_cancel)
 32.1797  
 32.1798 -lemma preal_add_less_iff2 [simp]: "(C + (A::preal) < C + B) = (A < B)"
 32.1799 +lemma preal_add_less_cancel_left: "(T + (R::preal) < T + S) = (R < S)"
 32.1800  by (blast intro: preal_add_less2_mono2 preal_add_left_less_cancel)
 32.1801  
 32.1802 +lemma preal_add_le_cancel_right: "((R::preal) + T \<le> S + T) = (R \<le> S)"
 32.1803 +by (simp add: linorder_not_less [symmetric] preal_add_less_cancel_right) 
 32.1804 +
 32.1805 +lemma preal_add_le_cancel_left: "(T + (R::preal) \<le> T + S) = (R \<le> S)"
 32.1806 +by (simp add: linorder_not_less [symmetric] preal_add_less_cancel_left) 
 32.1807 +
 32.1808  lemma preal_add_less_mono:
 32.1809       "[| x1 < y1; x2 < y2 |] ==> x1 + x2 < y1 + (y2::preal)"
 32.1810 -apply (auto dest!: preal_less_add_left_Ex simp add: preal_add_ac)
 32.1811 +apply (auto dest!: less_add_left_Ex simp add: preal_add_ac)
 32.1812  apply (rule preal_add_assoc [THEN subst])
 32.1813  apply (rule preal_self_less_add_right)
 32.1814  done
 32.1815  
 32.1816 -lemma preal_mult_less_mono:
 32.1817 -     "[| x1 < y1; x2 < y2 |] ==> x1 * x2 < y1 * (y2::preal)"
 32.1818 -apply (auto dest!: preal_less_add_left_Ex simp add: preal_add_mult_distrib preal_add_mult_distrib2 preal_self_less_add_left preal_add_assoc preal_mult_ac)
 32.1819 +lemma preal_add_right_cancel: "(R::preal) + T = S + T ==> R = S"
 32.1820 +apply (insert linorder_less_linear [of R S], safe)
 32.1821 +apply (drule_tac [!] T = T in preal_add_less2_mono1, auto)
 32.1822  done
 32.1823  
 32.1824 -lemma preal_add_right_cancel: "(A::preal) + C = B + C ==> A = B"
 32.1825 -apply (cut_tac preal_linear [of A B], safe)
 32.1826 -apply (drule_tac [!] C = C in preal_add_less2_mono1)
 32.1827 -apply (auto elim: preal_less_irrefl)
 32.1828 -done
 32.1829 -
 32.1830 -lemma preal_add_left_cancel: "!!(A::preal). C + A = C + B ==> A = B"
 32.1831 +lemma preal_add_left_cancel: "C + A = C + B ==> A = (B::preal)"
 32.1832  by (auto intro: preal_add_right_cancel simp add: preal_add_commute)
 32.1833  
 32.1834 -lemma preal_add_left_cancel_iff [simp]: "(C + A = C + B) = ((A::preal) = B)"
 32.1835 +lemma preal_add_left_cancel_iff: "(C + A = C + B) = ((A::preal) = B)"
 32.1836  by (fast intro: preal_add_left_cancel)
 32.1837  
 32.1838 -lemma preal_add_right_cancel_iff [simp]: "(A + C = B + C) = ((A::preal) = B)"
 32.1839 +lemma preal_add_right_cancel_iff: "(A + C = B + C) = ((A::preal) = B)"
 32.1840  by (fast intro: preal_add_right_cancel)
 32.1841  
 32.1842 +lemmas preal_cancels =
 32.1843 +    preal_add_less_cancel_right preal_add_less_cancel_left
 32.1844 +    preal_add_le_cancel_right preal_add_le_cancel_left
 32.1845 +    preal_add_left_cancel_iff preal_add_right_cancel_iff
 32.1846  
 32.1847  
 32.1848  subsection{*Completeness of type @{typ preal}*}
 32.1849  
 32.1850  text{*Prove that supremum is a cut*}
 32.1851  
 32.1852 -lemma preal_sup_mem_Ex:
 32.1853 -     "\<exists>X. X \<in> P ==> \<exists>q.  q \<in> {w. \<exists>X. X \<in> P & w \<in> Rep_preal X}"
 32.1854 -apply safe
 32.1855 -apply (cut_tac X = X in mem_Rep_preal_Ex, auto)
 32.1856 +text{*Part 1 of Dedekind sections definition*}
 32.1857 +
 32.1858 +lemma preal_sup_set_not_empty:
 32.1859 +     "P \<noteq> {} ==> {} \<subset> (\<Union>X \<in> P. Rep_preal(X))"
 32.1860 +apply auto
 32.1861 +apply (cut_tac X = x in mem_Rep_preal_Ex, auto)
 32.1862  done
 32.1863  
 32.1864 -text{*Part 1 of Dedekind sections definition*}
 32.1865 -lemma preal_sup_set_not_empty:
 32.1866 -     "\<exists>(X::preal). X \<in> P ==>
 32.1867 -          {} < {w. \<exists>X \<in> P. w \<in> Rep_preal X}"
 32.1868 -apply (drule preal_sup_mem_Ex)
 32.1869 -apply (auto intro!: psubsetI)
 32.1870 -done
 32.1871  
 32.1872  text{*Part 2 of Dedekind sections definition*}
 32.1873 -lemma preal_sup_not_mem_Ex:
 32.1874 -     "\<exists>Y. (\<forall>X \<in> P. X < Y)
 32.1875 -          ==> \<exists>q. q \<notin> {w. \<exists>X. X \<in> P & w \<in> Rep_preal(X)}"
 32.1876 -apply (unfold preal_less_def)
 32.1877 -apply (auto simp add: psubset_def)
 32.1878 -apply (cut_tac X = Y in not_mem_Rep_preal_Ex)
 32.1879 -apply (erule exE)
 32.1880 -apply (rule_tac x = x in exI)
 32.1881 -apply (auto dest!: bspec)
 32.1882 +
 32.1883 +lemma preal_sup_not_exists:
 32.1884 +     "\<forall>X \<in> P. X \<le> Y ==> \<exists>q. 0 < q & q \<notin> (\<Union>X \<in> P. Rep_preal(X))"
 32.1885 +apply (cut_tac X = Y in Rep_preal_exists_bound)
 32.1886 +apply (auto simp add: preal_le_def)
 32.1887  done
 32.1888  
 32.1889 -lemma preal_sup_not_mem_Ex1:
 32.1890 -     "\<exists>Y. (\<forall>X \<in> P. X \<le> Y)
 32.1891 -          ==> \<exists>q. q \<notin> {w. \<exists>X. X \<in> P & w \<in> Rep_preal(X)}"
 32.1892 -apply (unfold preal_le_def, safe)
 32.1893 -apply (cut_tac X = Y in not_mem_Rep_preal_Ex)
 32.1894 -apply (erule exE)
 32.1895 -apply (rule_tac x = x in exI)
 32.1896 -apply (auto dest!: bspec)
 32.1897 -done
 32.1898 -
 32.1899 -lemma preal_sup_set_not_prat_set:
 32.1900 -     "\<exists>Y. (\<forall>X \<in> P. X < Y) ==> {w. \<exists>X \<in> P. w \<in> Rep_preal(X)} < UNIV"
 32.1901 -apply (drule preal_sup_not_mem_Ex)
 32.1902 -apply (auto intro!: psubsetI)
 32.1903 -done
 32.1904 -
 32.1905 -lemma preal_sup_set_not_prat_set1:
 32.1906 -     "\<exists>Y. (\<forall>X \<in> P. X \<le> Y) ==> {w. \<exists>X \<in> P. w \<in> Rep_preal(X)} < UNIV"
 32.1907 -apply (drule preal_sup_not_mem_Ex1)
 32.1908 -apply (auto intro!: psubsetI)
 32.1909 +lemma preal_sup_set_not_rat_set:
 32.1910 +     "\<forall>X \<in> P. X \<le> Y ==> (\<Union>X \<in> P. Rep_preal(X)) < {r. 0 < r}"
 32.1911 +apply (drule preal_sup_not_exists)
 32.1912 +apply (blast intro: preal_imp_pos [OF Rep_preal])  
 32.1913  done
 32.1914  
 32.1915  text{*Part 3 of Dedekind sections definition*}
 32.1916  lemma preal_sup_set_lemma3:
 32.1917 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X < Y) |]
 32.1918 -          ==> \<forall>y \<in> {w. \<exists>X \<in> P. w \<in> Rep_preal X}.
 32.1919 -              \<forall>z. z < y --> z \<in> {w. \<exists>X \<in> P. w \<in> Rep_preal X}"
 32.1920 -apply (auto elim: Rep_preal [THEN prealE_lemma3b])
 32.1921 -done
 32.1922 -
 32.1923 -lemma preal_sup_set_lemma3_1:
 32.1924 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X \<le> Y) |]
 32.1925 -          ==> \<forall>y \<in> {w. \<exists>X \<in> P. w \<in> Rep_preal X}.
 32.1926 -              \<forall>z. z < y --> z \<in> {w. \<exists>X \<in> P. w \<in> Rep_preal X}"
 32.1927 -apply (auto elim: Rep_preal [THEN prealE_lemma3b])
 32.1928 -done
 32.1929 +     "[|P \<noteq> {}; \<forall>X \<in> P. X \<le> Y; u \<in> (\<Union>X \<in> P. Rep_preal(X)); 0 < z; z < u|]
 32.1930 +      ==> z \<in> (\<Union>X \<in> P. Rep_preal(X))"
 32.1931 +by (auto elim: Rep_preal [THEN preal_downwards_closed])
 32.1932  
 32.1933 +text{*Part 4 of Dedekind sections definition*}
 32.1934  lemma preal_sup_set_lemma4:
 32.1935 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X < Y) |]
 32.1936 -          ==>  \<forall>y \<in> {w. \<exists>X \<in> P. w \<in> Rep_preal X}.
 32.1937 -              Bex {w. \<exists>X \<in> P. w \<in> Rep_preal X} (op < y)"
 32.1938 -apply (blast dest: Rep_preal [THEN prealE_lemma4a])
 32.1939 -done
 32.1940 -
 32.1941 -lemma preal_sup_set_lemma4_1:
 32.1942 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X \<le> Y) |]
 32.1943 -          ==>  \<forall>y \<in> {w. \<exists>X \<in> P. w \<in> Rep_preal X}.
 32.1944 -              Bex {w. \<exists>X \<in> P. w \<in> Rep_preal X} (op < y)"
 32.1945 -apply (blast dest: Rep_preal [THEN prealE_lemma4a])
 32.1946 -done
 32.1947 +     "[|P \<noteq> {}; \<forall>X \<in> P. X \<le> Y; y \<in> (\<Union>X \<in> P. Rep_preal(X)) |]
 32.1948 +          ==> \<exists>u \<in> (\<Union>X \<in> P. Rep_preal(X)). y < u"
 32.1949 +by (blast dest: Rep_preal [THEN preal_exists_greater])
 32.1950  
 32.1951  lemma preal_sup:
 32.1952 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X < Y) |]
 32.1953 -          ==> {w. \<exists>X \<in> P. w \<in> Rep_preal(X)}: preal"
 32.1954 -apply (rule prealI2)
 32.1955 -apply (rule preal_sup_set_not_empty)
 32.1956 -apply (rule_tac [2] preal_sup_set_not_prat_set)
 32.1957 -apply (rule_tac [3] preal_sup_set_lemma3)
 32.1958 -apply (rule_tac [5] preal_sup_set_lemma4, auto)
 32.1959 +     "[|P \<noteq> {}; \<forall>X \<in> P. X \<le> Y|] ==> (\<Union>X \<in> P. Rep_preal(X)) \<in> preal"
 32.1960 +apply (unfold preal_def cut_def)
 32.1961 +apply (blast intro!: preal_sup_set_not_empty preal_sup_set_not_rat_set
 32.1962 +                     preal_sup_set_lemma3 preal_sup_set_lemma4)
 32.1963  done
 32.1964  
 32.1965 -lemma preal_sup1:
 32.1966 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X \<le> Y) |]
 32.1967 -          ==> {w. \<exists>X \<in> P. w \<in> Rep_preal(X)}: preal"
 32.1968 -apply (rule prealI2)
 32.1969 -apply (rule preal_sup_set_not_empty)
 32.1970 -apply (rule_tac [2] preal_sup_set_not_prat_set1)
 32.1971 -apply (rule_tac [3] preal_sup_set_lemma3_1)
 32.1972 -apply (rule_tac [5] preal_sup_set_lemma4_1, auto)
 32.1973 -done
 32.1974 -
 32.1975 -lemma preal_psup_leI: "\<exists>Y. (\<forall>X \<in> P. X < Y) ==> \<forall>x \<in> P. x \<le> psup P"
 32.1976 -apply (unfold psup_def)
 32.1977 -apply (auto simp add: preal_le_def)
 32.1978 -apply (rule preal_sup [THEN Abs_preal_inverse, THEN ssubst], auto)
 32.1979 -done
 32.1980 -
 32.1981 -lemma preal_psup_leI2: "\<exists>Y. (\<forall>X \<in> P. X \<le> Y) ==> \<forall>x \<in> P. x \<le> psup P"
 32.1982 -apply (unfold psup_def)
 32.1983 -apply (auto simp add: preal_le_def)
 32.1984 -apply (rule preal_sup1 [THEN Abs_preal_inverse, THEN ssubst])
 32.1985 -apply (auto simp add: preal_le_def)
 32.1986 +lemma preal_psup_le:
 32.1987 +     "[| \<forall>X \<in> P. X \<le> Y;  x \<in> P |] ==> x \<le> psup P"
 32.1988 +apply (simp (no_asm_simp) add: preal_le_def) 
 32.1989 +apply (subgoal_tac "P \<noteq> {}") 
 32.1990 +apply (auto simp add: psup_def preal_sup) 
 32.1991  done
 32.1992  
 32.1993 -lemma preal_psup_leI2b:
 32.1994 -     "[| \<exists>Y. (\<forall>X \<in> P. X < Y); x \<in> P |] ==> x \<le> psup P"
 32.1995 -apply (blast dest!: preal_psup_leI)
 32.1996 -done
 32.1997 -
 32.1998 -lemma preal_psup_leI2a:
 32.1999 -     "[| \<exists>Y. (\<forall>X \<in> P. X \<le> Y); x \<in> P |] ==> x \<le> psup P"
 32.2000 -apply (blast dest!: preal_psup_leI2)
 32.2001 -done
 32.2002 -
 32.2003 -lemma psup_le_ub: "[| \<exists>X. X \<in> P; \<forall>X \<in> P. X < Y |] ==> psup P \<le> Y"
 32.2004 -apply (unfold psup_def)
 32.2005 +lemma psup_le_ub: "[| P \<noteq> {}; \<forall>X \<in> P. X \<le> Y |] ==> psup P \<le> Y"
 32.2006 +apply (simp (no_asm_simp) add: preal_le_def)
 32.2007 +apply (simp add: psup_def preal_sup) 
 32.2008  apply (auto simp add: preal_le_def)
 32.2009 -apply (drule preal_sup [OF exI exI, THEN Abs_preal_inverse, THEN subst])
 32.2010 -apply (rotate_tac [2] 1)
 32.2011 -prefer 2 apply assumption
 32.2012 -apply (auto dest!: bspec simp add: preal_less_def psubset_def)
 32.2013 -done
 32.2014 -
 32.2015 -lemma psup_le_ub1: "[| \<exists>X. X \<in> P; \<forall>X \<in> P. X \<le> Y |] ==> psup P \<le> Y"
 32.2016 -apply (unfold psup_def)
 32.2017 -apply (auto simp add: preal_le_def)
 32.2018 -apply (drule preal_sup1 [OF exI exI, THEN Abs_preal_inverse, THEN subst])
 32.2019 -apply (rotate_tac [2] 1)
 32.2020 -prefer 2 apply assumption
 32.2021 -apply (auto dest!: bspec simp add: preal_less_def psubset_def preal_le_def)
 32.2022  done
 32.2023  
 32.2024  text{*Supremum property*}
 32.2025  lemma preal_complete:
 32.2026 -     "[|\<exists>(X::preal). X \<in> P; \<exists>Y. (\<forall>X \<in> P. X < Y) |]
 32.2027 -          ==> (\<forall>Y. (\<exists>X \<in> P. Y < X) = (Y < psup P))"
 32.2028 -apply (frule preal_sup [THEN Abs_preal_inverse], fast)
 32.2029 -apply (auto simp add: psup_def preal_less_def)
 32.2030 -apply (cut_tac x = Xa and y = Ya in preal_linear)
 32.2031 -apply (auto dest: psubsetD simp add: preal_less_def)
 32.2032 +     "[| P \<noteq> {}; \<forall>X \<in> P. X \<le> Y |] ==> (\<exists>X \<in> P. Z < X) = (Z < psup P)"
 32.2033 +apply (simp add: preal_less_def psup_def preal_sup)
 32.2034 +apply (auto simp add: preal_le_def)
 32.2035 +apply (rename_tac U) 
 32.2036 +apply (cut_tac x = U and y = Z in linorder_less_linear)
 32.2037 +apply (auto simp add: preal_less_def)
 32.2038  done
 32.2039  
 32.2040  
 32.2041 -subsection{*The Embadding from @{typ prat} into @{typ preal}*}
 32.2042 +subsection{*The Embadding from @{typ rat} into @{typ preal}*}
 32.2043  
 32.2044 -lemma lemma_preal_rat_less: "x < z1 + z2 ==> x * z1 * qinv (z1 + z2) < z1"
 32.2045 -apply (drule_tac x = "z1 * qinv (z1 + z2) " in prat_mult_less2_mono1)
 32.2046 -apply (simp add: prat_mult_ac)
 32.2047 -done
 32.2048 -
 32.2049 -lemma lemma_preal_rat_less2: "x < z1 + z2 ==> x * z2 * qinv (z1 + z2) < z2"
 32.2050 -apply (subst prat_add_commute)
 32.2051 -apply (drule prat_add_commute [THEN subst])
 32.2052 -apply (erule lemma_preal_rat_less)
 32.2053 +lemma preal_of_rat_add_lemma1:
 32.2054 +     "[|x < y + z; 0 < x; 0 < y|] ==> x * y * inverse (y + z) < (y::rat)"
 32.2055 +apply (frule_tac c = "y * inverse (y + z) " in mult_strict_right_mono)
 32.2056 +apply (simp add: zero_less_mult_iff) 
 32.2057 +apply (simp add: mult_ac)
 32.2058  done
 32.2059  
 32.2060 -lemma preal_of_prat_add:
 32.2061 -      "preal_of_prat ((z1::prat) + z2) =
 32.2062 -       preal_of_prat z1 + preal_of_prat z2"
 32.2063 -apply (unfold preal_of_prat_def preal_add_def)
 32.2064 +lemma preal_of_rat_add_lemma2:
 32.2065 +  assumes "u < x + y"
 32.2066 +      and "0 < x"
 32.2067 +      and "0 < y"
 32.2068 +      and "0 < u"
 32.2069 +  shows "\<exists>v w::rat. w < y & 0 < v & v < x & 0 < w & u = v + w"
 32.2070 +proof (intro exI conjI)
 32.2071 +  show "u * x * inverse(x+y) < x" using prems 
 32.2072 +    by (simp add: preal_of_rat_add_lemma1) 
 32.2073 +  show "u * y * inverse(x+y) < y" using prems 
 32.2074 +    by (simp add: preal_of_rat_add_lemma1 add_commute [of x]) 
 32.2075 +  show "0 < u * x * inverse (x + y)" using prems
 32.2076 +    by (simp add: zero_less_mult_iff) 
 32.2077 +  show "0 < u * y * inverse (x + y)" using prems
 32.2078 +    by (simp add: zero_less_mult_iff) 
 32.2079 +  show "u = u * x * inverse (x + y) + u * y * inverse (x + y)" using prems
 32.2080 +    by (simp add: left_distrib [symmetric] right_distrib [symmetric] mult_ac)
 32.2081 +qed
 32.2082 +
 32.2083 +lemma preal_of_rat_add:
 32.2084 +     "[| 0 < x; 0 < y|] 
 32.2085 +      ==> preal_of_rat ((x::rat) + y) = preal_of_rat x + preal_of_rat y"
 32.2086 +apply (unfold preal_of_rat_def preal_add_def)
 32.2087 +apply (simp add: rat_mem_preal) 
 32.2088  apply (rule_tac f = Abs_preal in arg_cong)
 32.2089 -apply (auto intro: prat_add_less_mono 
 32.2090 -            simp add: lemma_prat_less_set_mem_preal [THEN Abs_preal_inverse])
 32.2091 -apply (rule_tac x = "x*z1*qinv (z1+z2) " in exI, rule conjI)
 32.2092 -apply (erule lemma_preal_rat_less)
 32.2093 -apply (rule_tac x = "x*z2*qinv (z1+z2) " in exI, rule conjI)
 32.2094 -apply (erule lemma_preal_rat_less2)
 32.2095 -apply (simp add: prat_add_mult_distrib [symmetric] 
 32.2096 -                 prat_add_mult_distrib2 [symmetric] prat_mult_ac)
 32.2097 +apply (auto simp add: add_set_def) 
 32.2098 +apply (blast dest: preal_of_rat_add_lemma2) 
 32.2099 +done
 32.2100 +
 32.2101 +lemma preal_of_rat_mult_lemma1:
 32.2102 +     "[|x < y; 0 < x; 0 < z|] ==> x * z * inverse y < (z::rat)"
 32.2103 +apply (frule_tac c = "z * inverse y" in mult_strict_right_mono)
 32.2104 +apply (simp add: zero_less_mult_iff)
 32.2105 +apply (subgoal_tac "y * (z * inverse y) = z * (y * inverse y)")
 32.2106 +apply (simp_all add: mult_ac)
 32.2107  done
 32.2108  
 32.2109 -lemma lemma_preal_rat_less3: "x < xa ==> x*z1*qinv(xa) < z1"
 32.2110 -apply (drule_tac x = "z1 * qinv xa" in prat_mult_less2_mono1)
 32.2111 -apply (drule prat_mult_left_commute [THEN subst])
 32.2112 -apply (simp add: prat_mult_ac)
 32.2113 -done
 32.2114 +lemma preal_of_rat_mult_lemma2: 
 32.2115 +  assumes xless: "x < y * z"
 32.2116 +      and xpos: "0 < x"
 32.2117 +      and ypos: "0 < y"
 32.2118 +  shows "x * z * inverse y * inverse z < (z::rat)"
 32.2119 +proof -
 32.2120 +  have "0 < y * z" using prems by simp
 32.2121 +  hence zpos:  "0 < z" using prems by (simp add: zero_less_mult_iff)
 32.2122 +  have "x * z * inverse y * inverse z = x * inverse y * (z * inverse z)"
 32.2123 +    by (simp add: mult_ac)
 32.2124 +  also have "... = x/y" using zpos
 32.2125 +    by (simp add: divide_inverse_zero)
 32.2126 +  also have "... < z"
 32.2127 +    by (simp add: pos_divide_less_eq [OF ypos] mult_commute) 
 32.2128 +  finally show ?thesis .
 32.2129 +qed
 32.2130  
 32.2131 -lemma lemma_preal_rat_less4: "xa < z1 * z2 ==> xa*z2*qinv(z1*z2) < z2"
 32.2132 -apply (drule_tac x = "z2 * qinv (z1*z2) " in prat_mult_less2_mono1)
 32.2133 -apply (drule prat_mult_left_commute [THEN subst])
 32.2134 -apply (simp add: prat_mult_ac)
 32.2135 +lemma preal_of_rat_mult_lemma3:
 32.2136 +  assumes uless: "u < x * y"
 32.2137 +      and "0 < x"
 32.2138 +      and "0 < y"
 32.2139 +      and "0 < u"
 32.2140 +  shows "\<exists>v w::rat. v < x & w < y & 0 < v & 0 < w & u = v * w"
 32.2141 +proof -
 32.2142 +  from dense [OF uless] 
 32.2143 +  obtain r where "u < r" "r < x * y" by blast
 32.2144 +  thus ?thesis
 32.2145 +  proof (intro exI conjI)
 32.2146 +  show "u * x * inverse r < x" using prems 
 32.2147 +    by (simp add: preal_of_rat_mult_lemma1) 
 32.2148 +  show "r * y * inverse x * inverse y < y" using prems
 32.2149 +    by (simp add: preal_of_rat_mult_lemma2)
 32.2150 +  show "0 < u * x * inverse r" using prems
 32.2151 +    by (simp add: zero_less_mult_iff) 
 32.2152 +  show "0 < r * y * inverse x * inverse y" using prems
 32.2153 +    by (simp add: zero_less_mult_iff) 
 32.2154 +  have "u * x * inverse r * (r * y * inverse x * inverse y) =
 32.2155 +        u * (r * inverse r) * (x * inverse x) * (y * inverse y)"
 32.2156 +    by (simp only: mult_ac)
 32.2157 +  thus "u = u * x * inverse r * (r * y * inverse x * inverse y)" using prems
 32.2158 +    by simp
 32.2159 +  qed
 32.2160 +qed
 32.2161 +
 32.2162 +lemma preal_of_rat_mult:
 32.2163 +     "[| 0 < x; 0 < y|] 
 32.2164 +      ==> preal_of_rat ((x::rat) * y) = preal_of_rat x * preal_of_rat y"
 32.2165 +apply (unfold preal_of_rat_def preal_mult_def)
 32.2166 +apply (simp add: rat_mem_preal) 
 32.2167 +apply (rule_tac f = Abs_preal in arg_cong)
 32.2168 +apply (auto simp add: zero_less_mult_iff mult_strict_mono mult_set_def) 
 32.2169 +apply (blast dest: preal_of_rat_mult_lemma3) 
 32.2170  done
 32.2171  
 32.2172 -lemma preal_of_prat_mult:
 32.2173 -      "preal_of_prat ((z1::prat) * z2) =
 32.2174 -       preal_of_prat z1 * preal_of_prat z2"
 32.2175 -apply (unfold preal_of_prat_def preal_mult_def)
 32.2176 -apply (rule_tac f = Abs_preal in arg_cong)
 32.2177 -apply (auto intro: prat_mult_less_mono 
 32.2178 -            simp add: lemma_prat_less_set_mem_preal [THEN Abs_preal_inverse])
 32.2179 -apply (drule prat_dense, safe)
 32.2180 -apply (rule_tac x = "x*z1*qinv (xa) " in exI, rule conjI)
 32.2181 -apply (erule lemma_preal_rat_less3)
 32.2182 -apply (rule_tac x = " xa*z2*qinv (z1*z2) " in exI, rule conjI)
 32.2183 -apply (erule lemma_preal_rat_less4)
 32.2184 -apply (simp add: qinv_mult_eq [symmetric] prat_mult_ac)
 32.2185 -apply (simp add: prat_mult_assoc [symmetric])
 32.2186 -done
 32.2187 +lemma preal_of_rat_less_iff:
 32.2188 +      "[| 0 < x; 0 < y|] ==> (preal_of_rat x < preal_of_rat y) = (x < y)"
 32.2189 +by (force simp add: preal_of_rat_def preal_less_def rat_mem_preal) 
 32.2190  
 32.2191 -lemma preal_of_prat_less_iff [simp]:
 32.2192 -      "(preal_of_prat p < preal_of_prat q) = (p < q)"
 32.2193 -apply (unfold preal_of_prat_def preal_less_def)
 32.2194 -apply (auto dest!: lemma_prat_set_eq elim: prat_less_trans 
 32.2195 -        simp add: lemma_prat_less_set_mem_preal psubset_def prat_less_not_refl)
 32.2196 -apply (rule_tac x = p and y = q in prat_linear_less2)
 32.2197 -apply (auto intro: prat_less_irrefl)
 32.2198 -done
 32.2199 +lemma preal_of_rat_le_iff:
 32.2200 +      "[| 0 < x; 0 < y|] ==> (preal_of_rat x \<le> preal_of_rat y) = (x \<le> y)"
 32.2201 +by (simp add: preal_of_rat_less_iff linorder_not_less [symmetric]) 
 32.2202 +
 32.2203 +lemma preal_of_rat_eq_iff:
 32.2204 +      "[| 0 < x; 0 < y|] ==> (preal_of_rat x = preal_of_rat y) = (x = y)"
 32.2205 +by (simp add: preal_of_rat_le_iff order_eq_iff) 
 32.2206  
 32.2207  
 32.2208  ML
 32.2209  {*
 32.2210  val inj_on_Abs_preal = thm"inj_on_Abs_preal";
 32.2211  val inj_Rep_preal = thm"inj_Rep_preal";
 32.2212 -val empty_not_mem_preal = thm"empty_not_mem_preal";
 32.2213 -val one_set_mem_preal = thm"one_set_mem_preal";
 32.2214 -val preal_psubset_empty = thm"preal_psubset_empty";
 32.2215  val mem_Rep_preal_Ex = thm"mem_Rep_preal_Ex";
 32.2216 -val inj_preal_of_prat = thm"inj_preal_of_prat";
 32.2217 -val not_in_preal_ub = thm"not_in_preal_ub";
 32.2218 -val preal_less_not_refl = thm"preal_less_not_refl";
 32.2219 -val preal_less_trans = thm"preal_less_trans";
 32.2220 -val preal_less_not_sym = thm"preal_less_not_sym";
 32.2221 -val preal_linear = thm"preal_linear";
 32.2222  val preal_add_commute = thm"preal_add_commute";
 32.2223 -val preal_add_set_not_empty = thm"preal_add_set_not_empty";
 32.2224 -val preal_not_mem_add_set_Ex = thm"preal_not_mem_add_set_Ex";
 32.2225 -val preal_add_set_not_prat_set = thm"preal_add_set_not_prat_set";
 32.2226 -val preal_mem_add_set = thm"preal_mem_add_set";
 32.2227  val preal_add_assoc = thm"preal_add_assoc";
 32.2228  val preal_add_left_commute = thm"preal_add_left_commute";
 32.2229  val preal_mult_commute = thm"preal_mult_commute";
 32.2230 -val preal_mult_set_not_empty = thm"preal_mult_set_not_empty";
 32.2231 -val preal_not_mem_mult_set_Ex = thm"preal_not_mem_mult_set_Ex";
 32.2232 -val preal_mult_set_not_prat_set = thm"preal_mult_set_not_prat_set";
 32.2233 -val preal_mem_mult_set = thm"preal_mem_mult_set";
 32.2234  val preal_mult_assoc = thm"preal_mult_assoc";
 32.2235  val preal_mult_left_commute = thm"preal_mult_left_commute";
 32.2236 -val preal_mult_1 = thm"preal_mult_1";
 32.2237 -val preal_mult_1_right = thm"preal_mult_1_right";
 32.2238 -val mem_Rep_preal_addD = thm"mem_Rep_preal_addD";
 32.2239 -val mem_Rep_preal_addI = thm"mem_Rep_preal_addI";
 32.2240 -val mem_Rep_preal_add_iff = thm"mem_Rep_preal_add_iff";
 32.2241 -val mem_Rep_preal_multD = thm"mem_Rep_preal_multD";
 32.2242 -val mem_Rep_preal_multI = thm"mem_Rep_preal_multI";
 32.2243 -val mem_Rep_preal_mult_iff = thm"mem_Rep_preal_mult_iff";
 32.2244  val preal_add_mult_distrib2 = thm"preal_add_mult_distrib2";
 32.2245  val preal_add_mult_distrib = thm"preal_add_mult_distrib";
 32.2246 -val qinv_not_mem_Rep_preal_Ex = thm"qinv_not_mem_Rep_preal_Ex";
 32.2247 -val preal_inv_set_not_empty = thm"preal_inv_set_not_empty";
 32.2248 -val qinv_mem_Rep_preal_Ex = thm"qinv_mem_Rep_preal_Ex";
 32.2249 -val preal_not_mem_inv_set_Ex = thm"preal_not_mem_inv_set_Ex";
 32.2250 -val preal_inv_set_not_prat_set = thm"preal_inv_set_not_prat_set";
 32.2251 -val preal_mem_inv_set = thm"preal_mem_inv_set";
 32.2252 -val preal_mem_mult_invD = thm"preal_mem_mult_invD";
 32.2253 -val preal_mem_mult_invI = thm"preal_mem_mult_invI";
 32.2254 -val preal_mult_inv = thm"preal_mult_inv";
 32.2255 -val preal_mult_inv_right = thm"preal_mult_inv_right";
 32.2256 -val Rep_preal_self_subset = thm"Rep_preal_self_subset";
 32.2257 -val Rep_preal_sum_not_subset = thm"Rep_preal_sum_not_subset";
 32.2258 -val Rep_preal_sum_not_eq = thm"Rep_preal_sum_not_eq";
 32.2259  val preal_self_less_add_left = thm"preal_self_less_add_left";
 32.2260  val preal_self_less_add_right = thm"preal_self_less_add_right";
 32.2261 -val preal_less_le_iff = thm"preal_less_le_iff";
 32.2262 -val preal_le_refl = thm"preal_le_refl";
 32.2263 -val preal_le_trans = thm"preal_le_trans";
 32.2264 -val preal_le_anti_sym = thm"preal_le_anti_sym";
 32.2265 -val preal_neq_iff = thm"preal_neq_iff";
 32.2266 -val preal_less_le = thm"preal_less_le";
 32.2267 -val psubset_trans = thm"psubset_trans";
 32.2268 -val preal_less_set_not_empty = thm"preal_less_set_not_empty";
 32.2269 -val preal_less_set_not_prat_set = thm"preal_less_set_not_prat_set";
 32.2270 -val preal_mem_less_set = thm"preal_mem_less_set";
 32.2271 -val preal_less_add_left_subsetI = thm"preal_less_add_left_subsetI";
 32.2272 -val preal_less_add_left_subsetI2 = thm"preal_less_add_left_subsetI2";
 32.2273 -val preal_less_add_left = thm"preal_less_add_left";
 32.2274 -val preal_less_add_left_Ex = thm"preal_less_add_left_Ex";
 32.2275 +val less_add_left = thm"less_add_left";
 32.2276  val preal_add_less2_mono1 = thm"preal_add_less2_mono1";
 32.2277  val preal_add_less2_mono2 = thm"preal_add_less2_mono2";
 32.2278 -val preal_mult_less_mono1 = thm"preal_mult_less_mono1";
 32.2279 -val preal_mult_left_less_mono1 = thm"preal_mult_left_less_mono1";
 32.2280 -val preal_mult_left_le_mono1 = thm"preal_mult_left_le_mono1";
 32.2281 -val preal_mult_le_mono1 = thm"preal_mult_le_mono1";
 32.2282 -val preal_add_left_le_mono1 = thm"preal_add_left_le_mono1";
 32.2283 -val preal_add_le_mono1 = thm"preal_add_le_mono1";
 32.2284  val preal_add_right_less_cancel = thm"preal_add_right_less_cancel";
 32.2285  val preal_add_left_less_cancel = thm"preal_add_left_less_cancel";
 32.2286 -val preal_add_less_iff1 = thm"preal_add_less_iff1";
 32.2287 -val preal_add_less_iff2 = thm"preal_add_less_iff2";
 32.2288 -val preal_add_less_mono = thm"preal_add_less_mono";
 32.2289 -val preal_mult_less_mono = thm"preal_mult_less_mono";
 32.2290  val preal_add_right_cancel = thm"preal_add_right_cancel";
 32.2291  val preal_add_left_cancel = thm"preal_add_left_cancel";
 32.2292  val preal_add_left_cancel_iff = thm"preal_add_left_cancel_iff";
 32.2293  val preal_add_right_cancel_iff = thm"preal_add_right_cancel_iff";
 32.2294 -val preal_sup_mem_Ex = thm"preal_sup_mem_Ex";
 32.2295 -val preal_sup_set_not_empty = thm"preal_sup_set_not_empty";
 32.2296 -val preal_sup_not_mem_Ex = thm"preal_sup_not_mem_Ex";
 32.2297 -val preal_sup_not_mem_Ex1 = thm"preal_sup_not_mem_Ex1";
 32.2298 -val preal_sup_set_not_prat_set = thm"preal_sup_set_not_prat_set";
 32.2299 -val preal_sup_set_not_prat_set1 = thm"preal_sup_set_not_prat_set1";
 32.2300 -val preal_sup = thm"preal_sup";
 32.2301 -val preal_sup1 = thm"preal_sup1";
 32.2302 -val preal_psup_leI = thm"preal_psup_leI";
 32.2303 -val preal_psup_leI2 = thm"preal_psup_leI2";
 32.2304 -val preal_psup_leI2b = thm"preal_psup_leI2b";
 32.2305 -val preal_psup_leI2a = thm"preal_psup_leI2a";
 32.2306 +val preal_psup_le = thm"preal_psup_le";
 32.2307  val psup_le_ub = thm"psup_le_ub";
 32.2308 -val psup_le_ub1 = thm"psup_le_ub1";
 32.2309  val preal_complete = thm"preal_complete";
 32.2310 -val preal_of_prat_add = thm"preal_of_prat_add";
 32.2311 -val preal_of_prat_mult = thm"preal_of_prat_mult";
 32.2312 +val preal_of_rat_add = thm"preal_of_rat_add";
 32.2313 +val preal_of_rat_mult = thm"preal_of_rat_mult";
 32.2314  
 32.2315  val preal_add_ac = thms"preal_add_ac";
 32.2316  val preal_mult_ac = thms"preal_mult_ac";
    33.1 --- a/src/HOL/Real/RComplete.ML	Tue Jan 27 09:44:14 2004 +0100
    33.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.3 @@ -1,250 +0,0 @@
    33.4 -(*  Title       : HOL/Real/RComplete.ML
    33.5 -    ID          : $Id$
    33.6 -    Author      : Jacques D. Fleuriot
    33.7 -    Copyright   : 1998  University of Cambridge
    33.8 -
    33.9 -Completeness theorems for positive reals and reals.
   33.10 -*) 
   33.11 -
   33.12 -Goal "x/2 + x/2 = (x::real)";
   33.13 -by (Simp_tac 1);
   33.14 -qed "real_sum_of_halves";
   33.15 -
   33.16 -(*---------------------------------------------------------
   33.17 -       Completeness of reals: use supremum property of 
   33.18 -       preal and theorems about real_preal. Theorems 
   33.19 -       previously in Real.ML. 
   33.20 - ---------------------------------------------------------*)
   33.21 - (*a few lemmas*)
   33.22 -Goal "ALL x:P. 0 < x ==> \ 
   33.23 -\       ((EX x:P. y < x) = (EX X. real_of_preal X : P & \
   33.24 -\                          y < real_of_preal X))";
   33.25 -by (blast_tac (claset() addSDs [bspec, 
   33.26 -		    real_gt_zero_preal_Ex RS iffD1]) 1);
   33.27 -qed "real_sup_lemma1";
   33.28 -
   33.29 -Goal "[| ALL x:P. 0 < x;  a: P;   ALL x: P. x < y |] \
   33.30 -\         ==> (EX X. X: {w. real_of_preal w : P}) & \
   33.31 -\             (EX Y. ALL X: {w. real_of_preal w : P}. X < Y)";
   33.32 -by (rtac conjI 1);
   33.33 -by (blast_tac (claset() addDs [bspec, 
   33.34 -                real_gt_zero_preal_Ex RS iffD1]) 1);
   33.35 -by Auto_tac;
   33.36 -by (dtac bspec 1 THEN assume_tac 1);
   33.37 -by (ftac bspec 1  THEN assume_tac 1);
   33.38 -by (dtac order_less_trans 1 THEN assume_tac 1); 
   33.39 -by (dtac (real_gt_zero_preal_Ex RS iffD1) 1);
   33.40 -by (Force_tac 1);     
   33.41 -qed "real_sup_lemma2";
   33.42 -
   33.43 -(*-------------------------------------------------------------
   33.44 -            Completeness of Positive Reals
   33.45 - -------------------------------------------------------------*)
   33.46 -
   33.47 -(**
   33.48 - Supremum property for the set of positive reals
   33.49 - FIXME: long proof - should be improved
   33.50 -**)
   33.51 -
   33.52 -(*Let P be a non-empty set of positive reals, with an upper bound y.
   33.53 -  Then P has a least upper bound (written S).*)
   33.54 -Goal "[| ALL x:P. (0::real) < x;  EX x. x: P;  EX y. ALL x: P. x<y |] \
   33.55 -\     ==> (EX S. ALL y. (EX x: P. y < x) = (y < S))";
   33.56 -by (res_inst_tac 
   33.57 -   [("x","real_of_preal (psup({w. real_of_preal w : P}))")] exI 1);
   33.58 -by (Clarify_tac 1); 
   33.59 -by (case_tac "0 < ya" 1);
   33.60 -by Auto_tac; 
   33.61 -by (ftac real_sup_lemma2 1 THEN REPEAT (assume_tac 1));
   33.62 -by (dtac (real_gt_zero_preal_Ex RS iffD1) 1);
   33.63 -by (dtac (real_less_all_real2) 3);
   33.64 -by Auto_tac;
   33.65 -by (rtac (preal_complete RS spec RS iffD1) 1);
   33.66 -by Auto_tac;
   33.67 -by (ftac real_gt_preal_preal_Ex 1);
   33.68 -by (Force_tac 1);   
   33.69 -(* second part *)
   33.70 -by (rtac (real_sup_lemma1 RS iffD2) 1 THEN assume_tac 1);
   33.71 -by (auto_tac (claset() addSDs [real_less_all_real2,
   33.72 -                               real_gt_zero_preal_Ex RS iffD1],
   33.73 -	      simpset()));
   33.74 -by (ftac real_sup_lemma2 2 THEN REPEAT (assume_tac 1));
   33.75 -by (ftac real_sup_lemma2 1 THEN REPEAT (assume_tac 1));
   33.76 -by (rtac (preal_complete RS spec RS iffD2 RS bexE) 1);
   33.77 -by (Blast_tac 3);
   33.78 -by (ALLGOALS(Blast_tac));
   33.79 -qed "posreal_complete";
   33.80 -
   33.81 -(*--------------------------------------------------------
   33.82 -   Completeness properties using isUb, isLub etc.
   33.83 - -------------------------------------------------------*)
   33.84 -
   33.85 -Goal "[| isLub R S x; isLub R S y |] ==> x = (y::real)";
   33.86 -by (ftac isLub_isUb 1);
   33.87 -by (forw_inst_tac [("x","y")] isLub_isUb 1);
   33.88 -by (blast_tac (claset() addSIs [real_le_anti_sym]
   33.89 -                        addSDs [isLub_le_isUb]) 1);
   33.90 -qed "real_isLub_unique";
   33.91 -
   33.92 -Goalw [setle_def,setge_def] "[| (x::real) <=* S'; S <= S' |] ==> x <=* S";
   33.93 -by (Blast_tac 1);
   33.94 -qed "real_order_restrict";
   33.95 -
   33.96 -(*----------------------------------------------------------------
   33.97 -           Completeness theorem for the positive reals(again)
   33.98 - ----------------------------------------------------------------*)
   33.99 -
  33.100 -Goal "[| ALL x: S. 0 < x; \
  33.101 -\        EX x. x: S; \
  33.102 -\        EX u. isUb (UNIV::real set) S u \
  33.103 -\     |] ==> EX t. isLub (UNIV::real set) S t";
  33.104 -by (res_inst_tac 
  33.105 -    [("x","real_of_preal(psup({w. real_of_preal w : S}))")] exI 1);
  33.106 -by (auto_tac (claset(), simpset() addsimps 
  33.107 -    [isLub_def,leastP_def,isUb_def]));
  33.108 -by (auto_tac (claset() addSIs [setleI,setgeI] 
  33.109 -	         addSDs [(real_gt_zero_preal_Ex) RS iffD1],
  33.110 -	      simpset()));
  33.111 -by (forw_inst_tac [("x","y")] bspec 1 THEN assume_tac 1);
  33.112 -by (dtac ((real_gt_zero_preal_Ex) RS iffD1) 1);
  33.113 -by (auto_tac (claset(), simpset() addsimps [real_of_preal_le_iff]));
  33.114 -by (rtac preal_psup_leI2a 1);
  33.115 -by (forw_inst_tac [("y","real_of_preal ya")] setleD 1 THEN assume_tac 1);
  33.116 -by (ftac real_ge_preal_preal_Ex 1);
  33.117 -by (Step_tac 1);
  33.118 -by (res_inst_tac [("x","y")] exI 1);
  33.119 -by (blast_tac (claset() addSDs [setleD] addIs [real_of_preal_le_iff RS iffD1]) 1);
  33.120 -by (forw_inst_tac [("x","x")] bspec 1 THEN assume_tac 1);
  33.121 -by (ftac isUbD2 1);
  33.122 -by (dtac ((real_gt_zero_preal_Ex) RS iffD1) 1);
  33.123 -by (auto_tac (claset() addSDs [isUbD, real_ge_preal_preal_Ex],
  33.124 -	      simpset() addsimps [real_of_preal_le_iff]));
  33.125 -by (blast_tac (claset() addSDs [setleD] addSIs [psup_le_ub1] 
  33.126 -	                addIs [real_of_preal_le_iff RS iffD1]) 1);
  33.127 -qed "posreals_complete";
  33.128 -
  33.129 -
  33.130 -(*-------------------------------
  33.131 -    Lemmas
  33.132 - -------------------------------*)
  33.133 -Goal "ALL y : {z. EX x: P. z = x + (-xa) + 1} Int {x. 0 < x}. 0 < y";
  33.134 -by Auto_tac;
  33.135 -qed "real_sup_lemma3";
  33.136 - 
  33.137 -Goal "(xa <= S + X + (-Z)) = (xa + (-X) + Z <= (S::real))";
  33.138 -by Auto_tac;
  33.139 -qed "lemma_le_swap2";
  33.140 -
  33.141 -Goal "[| (x::real) + (-X) + 1 <= S; xa <= x |] ==> xa <= S + X + (- 1)";
  33.142 -by (arith_tac 1);
  33.143 -by Auto_tac;
  33.144 -qed "lemma_real_complete2b";
  33.145 -
  33.146 -(*----------------------------------------------------------
  33.147 -      reals Completeness (again!)
  33.148 - ----------------------------------------------------------*)
  33.149 -Goal "[| EX X. X: S;  EX Y. isUb (UNIV::real set) S Y |]  \
  33.150 -\     ==> EX t. isLub (UNIV :: real set) S t";
  33.151 -by (Step_tac 1);
  33.152 -by (subgoal_tac "EX u. u: {z. EX x: S. z = x + (-X) + 1} \
  33.153 -\                Int {x. 0 < x}" 1);
  33.154 -by (subgoal_tac "isUb (UNIV::real set) ({z. EX x: S. z = x + (-X) + 1} \
  33.155 -\                Int {x. 0 < x})  (Y + (-X) + 1)" 1); 
  33.156 -by (cut_inst_tac [("P","S"),("xa","X")] real_sup_lemma3 1);
  33.157 -by (EVERY1[forward_tac [exI RSN (3,posreals_complete)], Blast_tac, Blast_tac, 
  33.158 -	   Step_tac]);
  33.159 -by (res_inst_tac [("x","t + X + (- 1)")] exI 1);
  33.160 -by (rtac isLubI2 1);
  33.161 -by (rtac setgeI 2 THEN Step_tac 2);
  33.162 -by (subgoal_tac "isUb (UNIV:: real set) ({z. EX x: S. z = x + (-X) + 1} \
  33.163 -\                Int {x. 0 < x})  (y + (-X) + 1)" 2); 
  33.164 -by (dres_inst_tac [("y","(y + (- X) + 1)")] isLub_le_isUb 2 
  33.165 -      THEN assume_tac 2);
  33.166 -by (full_simp_tac
  33.167 -    (simpset() addsimps [real_diff_def, diff_le_eq RS sym] @
  33.168 -                        add_ac) 2);
  33.169 -by (rtac (setleI RS isUbI) 1);
  33.170 -by (Step_tac 1);
  33.171 -by (res_inst_tac [("R1.0","x"),("R2.0","y")] real_linear_less2 1);
  33.172 -by (stac lemma_le_swap2 1);
  33.173 -by (ftac isLubD2 1 THEN assume_tac 2);
  33.174 -by (Step_tac 1);
  33.175 -by (Blast_tac 1);
  33.176 -by (arith_tac 1);
  33.177 -by (stac lemma_le_swap2 1);
  33.178 -by (ftac isLubD2 1 THEN assume_tac 2);
  33.179 -by (Blast_tac 1);
  33.180 -by (rtac lemma_real_complete2b 1);
  33.181 -by (etac order_less_imp_le 2);
  33.182 -by (blast_tac (claset() addSIs [isLubD2]) 1 THEN Step_tac 1);
  33.183 -by (full_simp_tac (simpset() addsimps [real_add_assoc]) 1);
  33.184 -by (blast_tac (claset() addDs [isUbD] addSIs [setleI RS isUbI]
  33.185 -                        addIs [add_right_mono]) 1);
  33.186 -by (blast_tac (claset() addDs [isUbD] addSIs [setleI RS isUbI]
  33.187 -                        addIs [add_right_mono]) 1);
  33.188 -by (Auto_tac);
  33.189 -qed "reals_complete";
  33.190 -
  33.191 -(*----------------------------------------------------------------
  33.192 -        Related: Archimedean property of reals
  33.193 - ----------------------------------------------------------------*)
  33.194 -
  33.195 -Goal "0 < real (Suc n)";
  33.196 -by (res_inst_tac [("y","real n")] order_le_less_trans 1); 
  33.197 -by (rtac (real_of_nat_ge_zero) 1);
  33.198 -by (simp_tac (simpset() addsimps [real_of_nat_Suc]) 1); 
  33.199 -qed "real_of_nat_Suc_gt_zero";
  33.200 -
  33.201 -Goal "0 < x ==> EX n. inverse (real(Suc n)) < x";
  33.202 -by (rtac ccontr 1);
  33.203 -by (subgoal_tac "ALL n. x * real (Suc n) <= 1" 1);
  33.204 -by (asm_full_simp_tac
  33.205 -    (simpset() addsimps [linorder_not_less, inverse_eq_divide]) 2); 
  33.206 -by (Clarify_tac 2);
  33.207 -by (dres_inst_tac [("x","n")] spec 2); 
  33.208 -by (dres_inst_tac [("c","real (Suc n)")] (mult_right_mono) 2); 
  33.209 -by (rtac real_of_nat_ge_zero 2);
  33.210 -by (asm_full_simp_tac (simpset()  
  33.211 -	 addsimps [real_of_nat_Suc_gt_zero RS real_not_refl2 RS not_sym, 
  33.212 -                   real_mult_commute]) 2); 
  33.213 -by (subgoal_tac "isUb (UNIV::real set) \
  33.214 -\                     {z. EX n. z = x*(real (Suc n))} 1" 1);
  33.215 -by (subgoal_tac "EX X. X : {z. EX n. z = x*(real (Suc n))}" 1);
  33.216 -by (dtac reals_complete 1);
  33.217 -by (auto_tac (claset() addIs [isUbI,setleI],simpset()));
  33.218 -by (subgoal_tac "ALL m. x*(real(Suc m)) <= t" 1);
  33.219 -by (asm_full_simp_tac (simpset() addsimps 
  33.220 -                       [real_of_nat_Suc, right_distrib]) 1);
  33.221 -by (blast_tac (claset() addIs [isLubD2]) 2);
  33.222 -by (asm_full_simp_tac
  33.223 -    (simpset() addsimps [le_diff_eq RS sym, real_diff_def]) 1);
  33.224 -by (subgoal_tac "isUb (UNIV::real set) \
  33.225 -\                  {z. EX n. z = x*(real (Suc n))} (t + (-x))" 1);
  33.226 -by (blast_tac (claset() addSIs [isUbI,setleI]) 2);
  33.227 -by (dres_inst_tac [("y","t+(-x)")] isLub_le_isUb 1);
  33.228 -by (auto_tac (claset(), 
  33.229 -	      simpset() addsimps [real_of_nat_Suc,right_distrib]));
  33.230 -qed "reals_Archimedean";
  33.231 -
  33.232 -(*There must be other proofs, e.g. Suc of the largest integer in the
  33.233 -  cut representing x*)
  33.234 -Goal "EX n. (x::real) < real (n::nat)";
  33.235 -by (res_inst_tac [("R1.0","x"),("R2.0","0")] real_linear_less2 1);
  33.236 -by (res_inst_tac [("x","0")] exI 1);
  33.237 -by (res_inst_tac [("x","1")] exI 2);
  33.238 -by (auto_tac (claset() addEs [order_less_trans],
  33.239 -	      simpset() addsimps [real_of_nat_one]));
  33.240 -by (ftac (positive_imp_inverse_positive RS reals_Archimedean) 1);
  33.241 -by (Step_tac 1 THEN res_inst_tac [("x","Suc n")] exI 1);
  33.242 -by (forw_inst_tac [("b","inverse x")] mult_strict_right_mono 1);
  33.243 -by Auto_tac;  
  33.244 -qed "reals_Archimedean2";
  33.245 -
  33.246 -Goal "0 < x ==> ALL y. EX (n::nat). y < real n * x";
  33.247 -by (Step_tac 1);
  33.248 -by (cut_inst_tac [("x","y*inverse(x)")] reals_Archimedean2 1);
  33.249 -by (Step_tac 1);
  33.250 -by (forw_inst_tac [("a","y * inverse x")] (mult_strict_right_mono) 1);
  33.251 -by (auto_tac (claset(),simpset() addsimps [real_mult_assoc,real_of_nat_def]));
  33.252 -qed "reals_Archimedean3";
  33.253 -
    34.1 --- a/src/HOL/Real/RComplete.thy	Tue Jan 27 09:44:14 2004 +0100
    34.2 +++ b/src/HOL/Real/RComplete.thy	Tue Jan 27 15:39:51 2004 +0100
    34.3 @@ -6,5 +6,221 @@
    34.4                    reals and reals 
    34.5  *) 
    34.6  
    34.7 -RComplete = Lubs + RealArith
    34.8 +header{*Completeness Theorems for Positive Reals and Reals.*}
    34.9 +
   34.10 +theory RComplete = Lubs + RealArith:
   34.11 +
   34.12 +lemma real_sum_of_halves: "x/2 + x/2 = (x::real)"
   34.13 +apply (simp)
   34.14 +done
   34.15 +
   34.16 +
   34.17 +subsection{*Completeness of Reals by Supremum Property of type @{typ preal}*} 
   34.18 +
   34.19 + (*a few lemmas*)
   34.20 +lemma real_sup_lemma1:
   34.21 +     "\<forall>x \<in> P. 0 < x ==>   
   34.22 +      ((\<exists>x \<in> P. y < x) = (\<exists>X. real_of_preal X \<in> P & y < real_of_preal X))"
   34.23 +by (blast dest!: bspec real_gt_zero_preal_Ex [THEN iffD1])
   34.24 +
   34.25 +lemma real_sup_lemma2:
   34.26 +     "[| \<forall>x \<in> P. 0 < x;  a \<in> P;   \<forall>x \<in> P. x < y |]  
   34.27 +      ==> (\<exists>X. X\<in> {w. real_of_preal w \<in> P}) &  
   34.28 +          (\<exists>Y. \<forall>X\<in> {w. real_of_preal w \<in> P}. X < Y)"
   34.29 +apply (rule conjI)
   34.30 +apply (blast dest: bspec real_gt_zero_preal_Ex [THEN iffD1], auto)
   34.31 +apply (drule bspec, assumption)
   34.32 +apply (frule bspec, assumption)
   34.33 +apply (drule order_less_trans, assumption)
   34.34 +apply (drule real_gt_zero_preal_Ex [THEN iffD1])
   34.35 +apply (force) 
   34.36 +done
   34.37 +
   34.38 +(*-------------------------------------------------------------
   34.39 +            Completeness of Positive Reals
   34.40 + -------------------------------------------------------------*)
   34.41 +
   34.42 +(**
   34.43 + Supremum property for the set of positive reals
   34.44 + FIXME: long proof - should be improved
   34.45 +**)
   34.46 +
   34.47 +(*Let P be a non-empty set of positive reals, with an upper bound y.
   34.48 +  Then P has a least upper bound (written S).  
   34.49 +FIXME: Can the premise be weakened to \<forall>x \<in> P. x\<le> y ??*)
   34.50 +lemma posreal_complete: "[| \<forall>x \<in> P. (0::real) < x;  \<exists>x. x \<in> P;  \<exists>y. \<forall>x \<in> P. x<y |]  
   34.51 +      ==> (\<exists>S. \<forall>y. (\<exists>x \<in> P. y < x) = (y < S))"
   34.52 +apply (rule_tac x = "real_of_preal (psup ({w. real_of_preal w \<in> P}))" in exI)
   34.53 +apply clarify
   34.54 +apply (case_tac "0 < ya", auto)
   34.55 +apply (frule real_sup_lemma2, assumption+)
   34.56 +apply (drule real_gt_zero_preal_Ex [THEN iffD1])
   34.57 +apply (drule_tac [3] real_less_all_real2)
   34.58 +apply (auto)
   34.59 +apply (rule preal_complete [THEN iffD1])
   34.60 +apply (auto intro: order_less_imp_le)
   34.61 +apply (frule real_gt_preal_preal_Ex)
   34.62 +apply (force)
   34.63 +(* second part *)
   34.64 +apply (rule real_sup_lemma1 [THEN iffD2], assumption)
   34.65 +apply (auto dest!: real_less_all_real2 real_gt_zero_preal_Ex [THEN iffD1])
   34.66 +apply (frule_tac [2] real_sup_lemma2)
   34.67 +apply (frule real_sup_lemma2, assumption+, clarify) 
   34.68 +apply (rule preal_complete [THEN iffD2, THEN bexE])
   34.69 +prefer 3 apply blast
   34.70 +apply (blast intro!: order_less_imp_le)+
   34.71 +done
   34.72 +
   34.73 +(*--------------------------------------------------------
   34.74 +   Completeness properties using isUb, isLub etc.
   34.75 + -------------------------------------------------------*)
   34.76 +
   34.77 +lemma real_isLub_unique: "[| isLub R S x; isLub R S y |] ==> x = (y::real)"
   34.78 +apply (frule isLub_isUb)
   34.79 +apply (frule_tac x = y in isLub_isUb)
   34.80 +apply (blast intro!: real_le_anti_sym dest!: isLub_le_isUb)
   34.81 +done
   34.82 +
   34.83 +lemma real_order_restrict: "[| (x::real) <=* S'; S <= S' |] ==> x <=* S"
   34.84 +by (unfold setle_def setge_def, blast)
   34.85 +
   34.86 +(*----------------------------------------------------------------
   34.87 +           Completeness theorem for the positive reals(again)
   34.88 + ----------------------------------------------------------------*)
   34.89 +
   34.90 +lemma posreals_complete:
   34.91 +     "[| \<forall>x \<in>S. 0 < x;  
   34.92 +         \<exists>x. x \<in>S;  
   34.93 +         \<exists>u. isUb (UNIV::real set) S u  
   34.94 +      |] ==> \<exists>t. isLub (UNIV::real set) S t"
   34.95 +apply (rule_tac x = "real_of_preal (psup ({w. real_of_preal w \<in> S}))" in exI)
   34.96 +apply (auto simp add: isLub_def leastP_def isUb_def)
   34.97 +apply (auto intro!: setleI setgeI dest!: real_gt_zero_preal_Ex [THEN iffD1])
   34.98 +apply (frule_tac x = y in bspec, assumption)
   34.99 +apply (drule real_gt_zero_preal_Ex [THEN iffD1])
  34.100 +apply (auto simp add: real_of_preal_le_iff)
  34.101 +apply (frule_tac y = "real_of_preal ya" in setleD, assumption)
  34.102 +apply (frule real_ge_preal_preal_Ex, safe)
  34.103 +apply (blast intro!: preal_psup_le dest!: setleD intro: real_of_preal_le_iff [THEN iffD1])
  34.104 +apply (frule_tac x = x in bspec, assumption)
  34.105 +apply (frule isUbD2)
  34.106 +apply (drule real_gt_zero_preal_Ex [THEN iffD1])
  34.107 +apply (auto dest!: isUbD real_ge_preal_preal_Ex simp add: real_of_preal_le_iff)
  34.108 +apply (blast dest!: setleD intro!: psup_le_ub intro: real_of_preal_le_iff [THEN iffD1])
  34.109 +done
  34.110 +
  34.111  
  34.112 +(*-------------------------------
  34.113 +    Lemmas
  34.114 + -------------------------------*)
  34.115 +lemma real_sup_lemma3: "\<forall>y \<in> {z. \<exists>x \<in> P. z = x + (-xa) + 1} Int {x. 0 < x}. 0 < y"
  34.116 +by auto
  34.117 + 
  34.118 +lemma lemma_le_swap2: "(xa <= S + X + (-Z)) = (xa + (-X) + Z <= (S::real))"
  34.119 +by auto
  34.120 +
  34.121 +lemma lemma_real_complete2b: "[| (x::real) + (-X) + 1 <= S; xa <= x |] ==> xa <= S + X + (- 1)"
  34.122 +by arith
  34.123 +
  34.124 +(*----------------------------------------------------------
  34.125 +      reals Completeness (again!)
  34.126 + ----------------------------------------------------------*)
  34.127 +lemma reals_complete: "[| \<exists>X. X \<in>S;  \<exists>Y. isUb (UNIV::real set) S Y |]   
  34.128 +      ==> \<exists>t. isLub (UNIV :: real set) S t"
  34.129 +apply safe
  34.130 +apply (subgoal_tac "\<exists>u. u\<in> {z. \<exists>x \<in>S. z = x + (-X) + 1} Int {x. 0 < x}")
  34.131 +apply (subgoal_tac "isUb (UNIV::real set) ({z. \<exists>x \<in>S. z = x + (-X) + 1} Int {x. 0 < x}) (Y + (-X) + 1) ")
  34.132 +apply (cut_tac P = S and xa = X in real_sup_lemma3)
  34.133 +apply (frule posreals_complete [OF _ _ exI], blast, blast) 
  34.134 +apply safe
  34.135 +apply (rule_tac x = "t + X + (- 1) " in exI)
  34.136 +apply (rule isLubI2)
  34.137 +apply (rule_tac [2] setgeI, safe)
  34.138 +apply (subgoal_tac [2] "isUb (UNIV:: real set) ({z. \<exists>x \<in>S. z = x + (-X) + 1} Int {x. 0 < x}) (y + (-X) + 1) ")
  34.139 +apply (drule_tac [2] y = " (y + (- X) + 1) " in isLub_le_isUb)
  34.140 + prefer 2 apply assumption
  34.141 + prefer 2
  34.142 +apply arith
  34.143 +apply (rule setleI [THEN isUbI], safe)
  34.144 +apply (rule_tac x = x and y = y in linorder_cases)
  34.145 +apply (subst lemma_le_swap2)
  34.146 +apply (frule isLubD2)
  34.147 + prefer 2 apply assumption
  34.148 +apply safe
  34.149 +apply blast
  34.150 +apply arith
  34.151 +apply (subst lemma_le_swap2)
  34.152 +apply (frule isLubD2)
  34.153 + prefer 2 apply assumption
  34.154 +apply blast
  34.155 +apply (rule lemma_real_complete2b)
  34.156 +apply (erule_tac [2] order_less_imp_le)
  34.157 +apply (blast intro!: isLubD2, blast) 
  34.158 +apply (simp (no_asm_use) add: real_add_assoc)
  34.159 +apply (blast dest: isUbD intro!: setleI [THEN isUbI] intro: add_right_mono)
  34.160 +apply (blast dest: isUbD intro!: setleI [THEN isUbI] intro: add_right_mono, auto)
  34.161 +done
  34.162 +
  34.163 +
  34.164 +subsection{*Corollary: the Archimedean Property of the Reals*}
  34.165 +
  34.166 +lemma reals_Archimedean: "0 < x ==> \<exists>n. inverse (real(Suc n)) < x"
  34.167 +apply (rule ccontr)
  34.168 +apply (subgoal_tac "\<forall>n. x * real (Suc n) <= 1")
  34.169 + prefer 2
  34.170 +apply (simp add: linorder_not_less inverse_eq_divide, clarify) 
  34.171 +apply (drule_tac x = n in spec)
  34.172 +apply (drule_tac c = "real (Suc n)"  in mult_right_mono)
  34.173 +apply (rule real_of_nat_ge_zero)
  34.174 +apply (simp add: real_of_nat_Suc_gt_zero [THEN real_not_refl2, THEN not_sym] real_mult_commute)
  34.175 +apply (subgoal_tac "isUb (UNIV::real set) {z. \<exists>n. z = x* (real (Suc n))} 1")
  34.176 +apply (subgoal_tac "\<exists>X. X \<in> {z. \<exists>n. z = x* (real (Suc n))}")
  34.177 +apply (drule reals_complete)
  34.178 +apply (auto intro: isUbI setleI)
  34.179 +apply (subgoal_tac "\<forall>m. x* (real (Suc m)) <= t")
  34.180 +apply (simp add: real_of_nat_Suc right_distrib)
  34.181 +prefer 2 apply (blast intro: isLubD2)
  34.182 +apply (simp add: le_diff_eq [symmetric] real_diff_def)
  34.183 +apply (subgoal_tac "isUb (UNIV::real set) {z. \<exists>n. z = x* (real (Suc n))} (t + (-x))")
  34.184 +prefer 2 apply (blast intro!: isUbI setleI)
  34.185 +apply (drule_tac y = "t+ (-x) " in isLub_le_isUb)
  34.186 +apply (auto simp add: real_of_nat_Suc right_distrib)
  34.187 +done
  34.188 +
  34.189 +(*There must be other proofs, e.g. Suc of the largest integer in the
  34.190 +  cut representing x*)
  34.191 +lemma reals_Archimedean2: "\<exists>n. (x::real) < real (n::nat)"
  34.192 +apply (rule_tac x = x and y = 0 in linorder_cases)
  34.193 +apply (rule_tac x = 0 in exI)
  34.194 +apply (rule_tac [2] x = 1 in exI)
  34.195 +apply (auto elim: order_less_trans simp add: real_of_nat_one)
  34.196 +apply (frule positive_imp_inverse_positive [THEN reals_Archimedean], safe)
  34.197 +apply (rule_tac x = "Suc n" in exI)
  34.198 +apply (frule_tac b = "inverse x" in mult_strict_right_mono, auto)
  34.199 +done
  34.200 +
  34.201 +lemma reals_Archimedean3: "0 < x ==> \<forall>y. \<exists>(n::nat). y < real n * x"
  34.202 +apply safe
  34.203 +apply (cut_tac x = "y*inverse (x) " in reals_Archimedean2)
  34.204 +apply safe
  34.205 +apply (frule_tac a = "y * inverse x" in mult_strict_right_mono)
  34.206 +apply (auto simp add: mult_assoc real_of_nat_def)
  34.207 +done
  34.208 +
  34.209 +ML
  34.210 +{*
  34.211 +val real_sum_of_halves = thm "real_sum_of_halves";
  34.212 +val posreal_complete = thm "posreal_complete";
  34.213 +val real_isLub_unique = thm "real_isLub_unique";
  34.214 +val real_order_restrict = thm "real_order_restrict";
  34.215 +val posreals_complete = thm "posreals_complete";
  34.216 +val reals_complete = thm "reals_complete";
  34.217 +val reals_Archimedean = thm "reals_Archimedean";
  34.218 +val reals_Archimedean2 = thm "reals_Archimedean2";
  34.219 +val reals_Archimedean3 = thm "reals_Archimedean3";
  34.220 +*}
  34.221 +
  34.222 +end
  34.223 +
  34.224 +
  34.225 +
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/HOL/Real/RatArith.thy	Tue Jan 27 15:39:51 2004 +0100
    35.3 @@ -0,0 +1,162 @@
    35.4 +(*  Title:      HOL/RatArith.thy
    35.5 +    ID:         $Id$
    35.6 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    35.7 +    Copyright   2004  University of Cambridge
    35.8 +
    35.9 +Binary arithmetic and simplification for the rats
   35.10 +
   35.11 +This case is reduced to that for the integers
   35.12 +*)
   35.13 +
   35.14 +theory RatArith = Rational
   35.15 +files ("rat_arith.ML"):
   35.16 +
   35.17 +instance rat :: number ..
   35.18 +
   35.19 +defs
   35.20 +  rat_number_of_def:
   35.21 +    "number_of v == Fract (number_of v) 1"
   35.22 +     (*::bin=>rat         ::bin=>int*)
   35.23 +
   35.24 +theorem number_of_rat: "number_of b = rat (number_of b)"
   35.25 +  by (simp add: rat_number_of_def rat_def)
   35.26 +
   35.27 +declare number_of_rat [symmetric, simp]
   35.28 +
   35.29 +lemma rat_numeral_0_eq_0: "Numeral0 = (0::rat)"
   35.30 +by (simp add: rat_number_of_def zero_rat [symmetric])
   35.31 +
   35.32 +lemma rat_numeral_1_eq_1: "Numeral1 = (1::rat)"
   35.33 +by (simp add: rat_number_of_def one_rat [symmetric])
   35.34 +
   35.35 +
   35.36 +subsection{*Arithmetic Operations On Numerals*}
   35.37 +
   35.38 +lemma add_rat_number_of [simp]:
   35.39 +     "(number_of v :: rat) + number_of v' = number_of (bin_add v v')"
   35.40 +by (simp add: rat_number_of_def add_rat)
   35.41 +
   35.42 +lemma minus_rat_number_of [simp]:
   35.43 +     "- (number_of w :: rat) = number_of (bin_minus w)"
   35.44 +by (simp add: rat_number_of_def minus_rat)
   35.45 +
   35.46 +lemma diff_rat_number_of [simp]: 
   35.47 +   "(number_of v :: rat) - number_of w = number_of (bin_add v (bin_minus w))"
   35.48 +by (simp add: rat_number_of_def diff_rat)
   35.49 +
   35.50 +lemma mult_rat_number_of [simp]:
   35.51 +     "(number_of v :: rat) * number_of v' = number_of (bin_mult v v')"
   35.52 +by (simp add: rat_number_of_def mult_rat)
   35.53 +
   35.54 +text{*Lemmas for specialist use, NOT as default simprules*}
   35.55 +lemma rat_mult_2: "2 * z = (z+z::rat)"
   35.56 +proof -
   35.57 +  have eq: "(2::rat) = 1 + 1" by (simp add: rat_numeral_1_eq_1 [symmetric])
   35.58 +  thus ?thesis by (simp add: eq left_distrib)
   35.59 +qed
   35.60 +
   35.61 +lemma rat_mult_2_right: "z * 2 = (z+z::rat)"
   35.62 +by (subst mult_commute, rule rat_mult_2)
   35.63 +
   35.64 +
   35.65 +subsection{*Comparisons On Numerals*}
   35.66 +
   35.67 +lemma eq_rat_number_of [simp]:
   35.68 +     "((number_of v :: rat) = number_of v') =  
   35.69 +      iszero (number_of (bin_add v (bin_minus v')))"
   35.70 +by (simp add: rat_number_of_def eq_rat)
   35.71 +
   35.72 +text{*@{term neg} is used in rewrite rules for binary comparisons*}
   35.73 +lemma less_rat_number_of [simp]:
   35.74 +     "((number_of v :: rat) < number_of v') =  
   35.75 +      neg (number_of (bin_add v (bin_minus v')))"
   35.76 +by (simp add: rat_number_of_def less_rat)
   35.77 +
   35.78 +
   35.79 +text{*New versions of existing theorems involving 0, 1*}
   35.80 +
   35.81 +lemma rat_minus_1_eq_m1 [simp]: "- 1 = (-1::rat)"
   35.82 +by (simp add: rat_numeral_1_eq_1 [symmetric])
   35.83 +
   35.84 +lemma rat_mult_minus1 [simp]: "-1 * z = -(z::rat)"
   35.85 +proof -
   35.86 +  have  "-1 * z = (- 1) * z" by (simp add: rat_minus_1_eq_m1)
   35.87 +  also have "... = - (1 * z)" by (simp only: minus_mult_left) 
   35.88 +  also have "... = -z" by simp
   35.89 +  finally show ?thesis .
   35.90 +qed
   35.91 +
   35.92 +lemma rat_mult_minus1_right [simp]: "z * -1 = -(z::rat)"
   35.93 +by (subst mult_commute, rule rat_mult_minus1)
   35.94 +
   35.95 +
   35.96 +subsection{*Simplification of Arithmetic when Nested to the Right*}
   35.97 +
   35.98 +lemma rat_add_number_of_left [simp]:
   35.99 +     "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::rat)"
  35.100 +by (simp add: add_assoc [symmetric])
  35.101 +
  35.102 +lemma rat_mult_number_of_left [simp]:
  35.103 +     "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::rat)"
  35.104 +apply (simp add: mult_assoc [symmetric])
  35.105 +done
  35.106 +
  35.107 +lemma rat_add_number_of_diff1 [simp]: 
  35.108 +     "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::rat)"
  35.109 +apply (unfold diff_rat_def)
  35.110 +apply (rule rat_add_number_of_left)
  35.111 +done
  35.112 +
  35.113 +lemma rat_add_number_of_diff2 [simp]:
  35.114 +     "number_of v + (c - number_of w) =  
  35.115 +      number_of (bin_add v (bin_minus w)) + (c::rat)"
  35.116 +apply (subst diff_rat_number_of [symmetric])
  35.117 +apply (simp only: diff_rat_def add_ac)
  35.118 +done
  35.119 +
  35.120 +
  35.121 +declare rat_numeral_0_eq_0 [simp] rat_numeral_1_eq_1 [simp]
  35.122 +
  35.123 +lemmas rat_add_0_left = add_0 [where ?'a = rat]
  35.124 +lemmas rat_add_0_right = add_0_right [where ?'a = rat]
  35.125 +lemmas rat_mult_1_left = mult_1 [where ?'a = rat]
  35.126 +lemmas rat_mult_1_right = mult_1_right [where ?'a = rat]
  35.127 +
  35.128 +
  35.129 +declare diff_rat_def [symmetric]
  35.130 +
  35.131 +
  35.132 +use "rat_arith.ML"
  35.133 +
  35.134 +setup rat_arith_setup
  35.135 +
  35.136 +
  35.137 +subsubsection{*Division By @{term "-1"}*}
  35.138 +
  35.139 +lemma rat_divide_minus1 [simp]: "x/-1 = -(x::rat)" 
  35.140 +by simp
  35.141 +
  35.142 +lemma rat_minus1_divide [simp]: "-1/(x::rat) = - (1/x)"
  35.143 +by (simp add: divide_rat_def inverse_minus_eq)
  35.144 +
  35.145 +subsection{*Absolute Value Function for the Rats*}
  35.146 +
  35.147 +lemma abs_nat_number_of [simp]: 
  35.148 +     "abs (number_of v :: rat) =  
  35.149 +        (if neg (number_of v) then number_of (bin_minus v)  
  35.150 +         else number_of v)"
  35.151 +by (simp add: abs_if)
  35.152 +
  35.153 +lemma abs_minus_one [simp]: "abs (-1) = (1::rat)"
  35.154 +by (simp add: abs_if)
  35.155 +
  35.156 +
  35.157 +ML
  35.158 +{*
  35.159 +val rat_divide_minus1 = thm "rat_divide_minus1";
  35.160 +val rat_minus1_divide = thm "rat_minus1_divide";
  35.161 +val abs_nat_number_of = thm "abs_nat_number_of";
  35.162 +val abs_minus_one = thm "abs_minus_one";
  35.163 +*}
  35.164 +
  35.165 +end
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/HOL/Real/Rational.thy	Tue Jan 27 15:39:51 2004 +0100
    36.3 @@ -0,0 +1,736 @@
    36.4 +(*  Title: HOL/Library/Rational.thy
    36.5 +    ID:    $Id$
    36.6 +    Author: Markus Wenzel, TU Muenchen
    36.7 +    License: GPL (GNU GENERAL PUBLIC LICENSE)
    36.8 +*)
    36.9 +
   36.10 +header {*
   36.11 +  \title{Rational numbers}
   36.12 +  \author{Markus Wenzel}
   36.13 +*}
   36.14 +
   36.15 +theory Rational = Quotient + Ring_and_Field:
   36.16 +
   36.17 +subsection {* Fractions *}
   36.18 +
   36.19 +subsubsection {* The type of fractions *}
   36.20 +
   36.21 +typedef fraction = "{(a, b) :: int \<times> int | a b. b \<noteq> 0}"
   36.22 +proof
   36.23 +  show "(0, 1) \<in> ?fraction" by simp
   36.24 +qed
   36.25 +
   36.26 +constdefs
   36.27 +  fract :: "int => int => fraction"
   36.28 +  "fract a b == Abs_fraction (a, b)"
   36.29 +  num :: "fraction => int"
   36.30 +  "num Q == fst (Rep_fraction Q)"
   36.31 +  den :: "fraction => int"
   36.32 +  "den Q == snd (Rep_fraction Q)"
   36.33 +
   36.34 +lemma fract_num [simp]: "b \<noteq> 0 ==> num (fract a b) = a"
   36.35 +  by (simp add: fract_def num_def fraction_def Abs_fraction_inverse)
   36.36 +
   36.37 +lemma fract_den [simp]: "b \<noteq> 0 ==> den (fract a b) = b"
   36.38 +  by (simp add: fract_def den_def fraction_def Abs_fraction_inverse)
   36.39 +
   36.40 +lemma fraction_cases [case_names fract, cases type: fraction]:
   36.41 +  "(!!a b. Q = fract a b ==> b \<noteq> 0 ==> C) ==> C"
   36.42 +proof -
   36.43 +  assume r: "!!a b. Q = fract a b ==> b \<noteq> 0 ==> C"
   36.44 +  obtain a b where "Q = fract a b" and "b \<noteq> 0"
   36.45 +    by (cases Q) (auto simp add: fract_def fraction_def)
   36.46 +  thus C by (rule r)
   36.47 +qed
   36.48 +
   36.49 +lemma fraction_induct [case_names fract, induct type: fraction]:
   36.50 +    "(!!a b. b \<noteq> 0 ==> P (fract a b)) ==> P Q"
   36.51 +  by (cases Q) simp
   36.52 +
   36.53 +
   36.54 +subsubsection {* Equivalence of fractions *}
   36.55 +
   36.56 +instance fraction :: eqv ..
   36.57 +
   36.58 +defs (overloaded)
   36.59 +  equiv_fraction_def: "Q \<sim> R == num Q * den R = num R * den Q"
   36.60 +
   36.61 +lemma equiv_fraction_iff [iff]:
   36.62 +    "b \<noteq> 0 ==> b' \<noteq> 0 ==> (fract a b \<sim> fract a' b') = (a * b' = a' * b)"
   36.63 +  by (simp add: equiv_fraction_def)
   36.64 +
   36.65 +instance fraction :: equiv
   36.66 +proof
   36.67 +  fix Q R S :: fraction
   36.68 +  {
   36.69 +    show "Q \<sim> Q"
   36.70 +    proof (induct Q)
   36.71 +      fix a b :: int
   36.72 +      assume "b \<noteq> 0" and "b \<noteq> 0"
   36.73 +      with refl show "fract a b \<sim> fract a b" ..
   36.74 +    qed
   36.75 +  next
   36.76 +    assume "Q \<sim> R" and "R \<sim> S"
   36.77 +    show "Q \<sim> S"
   36.78 +    proof (insert prems, induct Q, induct R, induct S)
   36.79 +      fix a b a' b' a'' b'' :: int
   36.80 +      assume b: "b \<noteq> 0" and b': "b' \<noteq> 0" and b'': "b'' \<noteq> 0"
   36.81 +      assume "fract a b \<sim> fract a' b'" hence eq1: "a * b' = a' * b" ..
   36.82 +      assume "fract a' b' \<sim> fract a'' b''" hence eq2: "a' * b'' = a'' * b'" ..
   36.83 +      have "a * b'' = a'' * b"
   36.84 +      proof cases
   36.85 +        assume "a' = 0"
   36.86 +        with b' eq1 eq2 have "a = 0 \<and> a'' = 0" by auto
   36.87 +        thus ?thesis by simp
   36.88 +      next
   36.89 +        assume a': "a' \<noteq> 0"
   36.90 +        from eq1 eq2 have "(a * b') * (a' * b'') = (a' * b) * (a'' * b')" by simp
   36.91 +        hence "(a * b'') * (a' * b') = (a'' * b) * (a' * b')" by (simp only: mult_ac)
   36.92 +        with a' b' show ?thesis by simp
   36.93 +      qed
   36.94 +      thus "fract a b \<sim> fract a'' b''" ..
   36.95 +    qed
   36.96 +  next
   36.97 +    show "Q \<sim> R ==> R \<sim> Q"
   36.98 +    proof (induct Q, induct R)
   36.99 +      fix a b a' b' :: int
  36.100 +      assume b: "b \<noteq> 0" and b': "b' \<noteq> 0"
  36.101 +      assume "fract a b \<sim> fract a' b'"
  36.102 +      hence "a * b' = a' * b" ..
  36.103 +      hence "a' * b = a * b'" ..
  36.104 +      thus "fract a' b' \<sim> fract a b" ..
  36.105 +    qed
  36.106 +  }
  36.107 +qed
  36.108 +
  36.109 +lemma eq_fraction_iff [iff]:
  36.110 +    "b \<noteq> 0 ==> b' \<noteq> 0 ==> (\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>) = (a * b' = a' * b)"
  36.111 +  by (simp add: equiv_fraction_iff quot_equality)
  36.112 +
  36.113 +
  36.114 +subsubsection {* Operations on fractions *}
  36.115 +
  36.116 +text {*
  36.117 + We define the basic arithmetic operations on fractions and
  36.118 + demonstrate their ``well-definedness'', i.e.\ congruence with respect
  36.119 + to equivalence of fractions.
  36.120 +*}
  36.121 +
  36.122 +instance fraction :: zero ..
  36.123 +instance fraction :: one ..
  36.124 +instance fraction :: plus ..
  36.125 +instance fraction :: minus ..
  36.126 +instance fraction :: times ..
  36.127 +instance fraction :: inverse ..
  36.128 +instance fraction :: ord ..
  36.129 +
  36.130 +defs (overloaded)
  36.131 +  zero_fraction_def: "0 == fract 0 1"
  36.132 +  one_fraction_def: "1 == fract 1 1"
  36.133 +  add_fraction_def: "Q + R ==
  36.134 +    fract (num Q * den R + num R * den Q) (den Q * den R)"
  36.135 +  minus_fraction_def: "-Q == fract (-(num Q)) (den Q)"
  36.136 +  mult_fraction_def: "Q * R == fract (num Q * num R) (den Q * den R)"
  36.137 +  inverse_fraction_def: "inverse Q == fract (den Q) (num Q)"
  36.138 +  le_fraction_def: "Q \<le> R ==
  36.139 +    (num Q * den R) * (den Q * den R) \<le> (num R * den Q) * (den Q * den R)"
  36.140 +
  36.141 +lemma is_zero_fraction_iff: "b \<noteq> 0 ==> (\<lfloor>fract a b\<rfloor> = \<lfloor>0\<rfloor>) = (a = 0)"
  36.142 +  by (simp add: zero_fraction_def eq_fraction_iff)
  36.143 +
  36.144 +theorem add_fraction_cong:
  36.145 +  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>
  36.146 +    ==> b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0
  36.147 +    ==> \<lfloor>fract a b + fract c d\<rfloor> = \<lfloor>fract a' b' + fract c' d'\<rfloor>"
  36.148 +proof -
  36.149 +  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"  "d \<noteq> 0"  "d' \<noteq> 0"
  36.150 +  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>" hence eq1: "a * b' = a' * b" ..
  36.151 +  assume "\<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>" hence eq2: "c * d' = c' * d" ..
  36.152 +  have "\<lfloor>fract (a * d + c * b) (b * d)\<rfloor> = \<lfloor>fract (a' * d' + c' * b') (b' * d')\<rfloor>"
  36.153 +  proof
  36.154 +    show "(a * d + c * b) * (b' * d') = (a' * d' + c' * b') * (b * d)"
  36.155 +      (is "?lhs = ?rhs")
  36.156 +    proof -
  36.157 +      have "?lhs = (a * b') * (d * d') + (c * d') * (b * b')"
  36.158 +        by (simp add: int_distrib mult_ac)
  36.159 +      also have "... = (a' * b) * (d * d') + (c' * d) * (b * b')"
  36.160 +        by (simp only: eq1 eq2)
  36.161 +      also have "... = ?rhs"
  36.162 +        by (simp add: int_distrib mult_ac)
  36.163 +      finally show "?lhs = ?rhs" .
  36.164 +    qed
  36.165 +    from neq show "b * d \<noteq> 0" by simp
  36.166 +    from neq show "b' * d' \<noteq> 0" by simp
  36.167 +  qed
  36.168 +  with neq show ?thesis by (simp add: add_fraction_def)
  36.169 +qed
  36.170 +
  36.171 +theorem minus_fraction_cong:
  36.172 +  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> b \<noteq> 0 ==> b' \<noteq> 0
  36.173 +    ==> \<lfloor>-(fract a b)\<rfloor> = \<lfloor>-(fract a' b')\<rfloor>"
  36.174 +proof -
  36.175 +  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"
  36.176 +  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>"
  36.177 +  hence "a * b' = a' * b" ..
  36.178 +  hence "-a * b' = -a' * b" by simp
  36.179 +  hence "\<lfloor>fract (-a) b\<rfloor> = \<lfloor>fract (-a') b'\<rfloor>" ..
  36.180 +  with neq show ?thesis by (simp add: minus_fraction_def)
  36.181 +qed
  36.182 +
  36.183 +theorem mult_fraction_cong:
  36.184 +  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>
  36.185 +    ==> b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0
  36.186 +    ==> \<lfloor>fract a b * fract c d\<rfloor> = \<lfloor>fract a' b' * fract c' d'\<rfloor>"
  36.187 +proof -
  36.188 +  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"  "d \<noteq> 0"  "d' \<noteq> 0"
  36.189 +  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>" hence eq1: "a * b' = a' * b" ..
  36.190 +  assume "\<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>" hence eq2: "c * d' = c' * d" ..
  36.191 +  have "\<lfloor>fract (a * c) (b * d)\<rfloor> = \<lfloor>fract (a' * c') (b' * d')\<rfloor>"
  36.192 +  proof
  36.193 +    from eq1 eq2 have "(a * b') * (c * d') = (a' * b) * (c' * d)" by simp
  36.194 +    thus "(a * c) * (b' * d') = (a' * c') * (b * d)" by (simp add: mult_ac)
  36.195 +    from neq show "b * d \<noteq> 0" by simp
  36.196 +    from neq show "b' * d' \<noteq> 0" by simp
  36.197 +  qed
  36.198 +  with neq show "\<lfloor>fract a b * fract c d\<rfloor> = \<lfloor>fract a' b' * fract c' d'\<rfloor>"
  36.199 +    by (simp add: mult_fraction_def)
  36.200 +qed
  36.201 +
  36.202 +theorem inverse_fraction_cong:
  36.203 +  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract a b\<rfloor> \<noteq> \<lfloor>0\<rfloor> ==> \<lfloor>fract a' b'\<rfloor> \<noteq> \<lfloor>0\<rfloor>
  36.204 +    ==> b \<noteq> 0 ==> b' \<noteq> 0
  36.205 +    ==> \<lfloor>inverse (fract a b)\<rfloor> = \<lfloor>inverse (fract a' b')\<rfloor>"
  36.206 +proof -
  36.207 +  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"
  36.208 +  assume "\<lfloor>fract a b\<rfloor> \<noteq> \<lfloor>0\<rfloor>" and "\<lfloor>fract a' b'\<rfloor> \<noteq> \<lfloor>0\<rfloor>"
  36.209 +  with neq obtain "a \<noteq> 0" and "a' \<noteq> 0" by (simp add: is_zero_fraction_iff)
  36.210 +  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>"
  36.211 +  hence "a * b' = a' * b" ..
  36.212 +  hence "b * a' = b' * a" by (simp only: mult_ac)
  36.213 +  hence "\<lfloor>fract b a\<rfloor> = \<lfloor>fract b' a'\<rfloor>" ..
  36.214 +  with neq show ?thesis by (simp add: inverse_fraction_def)
  36.215 +qed
  36.216 +
  36.217 +theorem le_fraction_cong:
  36.218 +  "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>
  36.219 +    ==> b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0
  36.220 +    ==> (fract a b \<le> fract c d) = (fract a' b' \<le> fract c' d')"
  36.221 +proof -
  36.222 +  assume neq: "b \<noteq> 0"  "b' \<noteq> 0"  "d \<noteq> 0"  "d' \<noteq> 0"
  36.223 +  assume "\<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor>" hence eq1: "a * b' = a' * b" ..
  36.224 +  assume "\<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor>" hence eq2: "c * d' = c' * d" ..
  36.225 +
  36.226 +  let ?le = "\<lambda>a b c d. ((a * d) * (b * d) \<le> (c * b) * (b * d))"
  36.227 +  {
  36.228 +    fix a b c d x :: int assume x: "x \<noteq> 0"
  36.229 +    have "?le a b c d = ?le (a * x) (b * x) c d"
  36.230 +    proof -
  36.231 +      from x have "0 < x * x" by (auto simp add: zero_less_mult_iff)
  36.232 +      hence "?le a b c d =
  36.233 +          ((a * d) * (b * d) * (x * x) \<le> (c * b) * (b * d) * (x * x))"
  36.234 +        by (simp add: mult_le_cancel_right)
  36.235 +      also have "... = ?le (a * x) (b * x) c d"
  36.236 +        by (simp add: mult_ac)
  36.237 +      finally show ?thesis .
  36.238 +    qed
  36.239 +  } note le_factor = this
  36.240 +
  36.241 +  let ?D = "b * d" and ?D' = "b' * d'"
  36.242 +  from neq have D: "?D \<noteq> 0" by simp
  36.243 +  from neq have "?D' \<noteq> 0" by simp
  36.244 +  hence "?le a b c d = ?le (a * ?D') (b * ?D') c d"
  36.245 +    by (rule le_factor)
  36.246 +  also have "... = ((a * b') * ?D * ?D' * d * d' \<le> (c * d') * ?D * ?D' * b * b')"
  36.247 +    by (simp add: mult_ac)
  36.248 +  also have "... = ((a' * b) * ?D * ?D' * d * d' \<le> (c' * d) * ?D * ?D' * b * b')"
  36.249 +    by (simp only: eq1 eq2)
  36.250 +  also have "... = ?le (a' * ?D) (b' * ?D) c' d'"
  36.251 +    by (simp add: mult_ac)
  36.252 +  also from D have "... = ?le a' b' c' d'"
  36.253 +    by (rule le_factor [symmetric])
  36.254 +  finally have "?le a b c d = ?le a' b' c' d'" .
  36.255 +  with neq show ?thesis by (simp add: le_fraction_def)
  36.256 +qed
  36.257 +
  36.258 +
  36.259 +subsection {* Rational numbers *}
  36.260 +
  36.261 +subsubsection {* The type of rational numbers *}
  36.262 +
  36.263 +typedef (Rat)
  36.264 +  rat = "UNIV :: fraction quot set" ..
  36.265 +
  36.266 +lemma RatI [intro, simp]: "Q \<in> Rat"
  36.267 +  by (simp add: Rat_def)
  36.268 +
  36.269 +constdefs
  36.270 +  fraction_of :: "rat => fraction"
  36.271 +  "fraction_of q == pick (Rep_Rat q)"
  36.272 +  rat_of :: "fraction => rat"
  36.273 +  "rat_of Q == Abs_Rat \<lfloor>Q\<rfloor>"
  36.274 +
  36.275 +theorem rat_of_equality [iff?]: "(rat_of Q = rat_of Q') = (\<lfloor>Q\<rfloor> = \<lfloor>Q'\<rfloor>)"
  36.276 +  by (simp add: rat_of_def Abs_Rat_inject)
  36.277 +
  36.278 +lemma rat_of: "\<lfloor>Q\<rfloor> = \<lfloor>Q'\<rfloor> ==> rat_of Q = rat_of Q'" ..
  36.279 +
  36.280 +constdefs
  36.281 +  Fract :: "int => int => rat"
  36.282 +  "Fract a b == rat_of (fract a b)"
  36.283 +
  36.284 +theorem Fract_inverse: "\<lfloor>fraction_of (Fract a b)\<rfloor> = \<lfloor>fract a b\<rfloor>"
  36.285 +  by (simp add: fraction_of_def rat_of_def Fract_def Abs_Rat_inverse pick_inverse)
  36.286 +
  36.287 +theorem Fract_equality [iff?]:
  36.288 +    "(Fract a b = Fract c d) = (\<lfloor>fract a b\<rfloor> = \<lfloor>fract c d\<rfloor>)"
  36.289 +  by (simp add: Fract_def rat_of_equality)
  36.290 +
  36.291 +theorem eq_rat:
  36.292 +    "b \<noteq> 0 ==> d \<noteq> 0 ==> (Fract a b = Fract c d) = (a * d = c * b)"
  36.293 +  by (simp add: Fract_equality eq_fraction_iff)
  36.294 +
  36.295 +theorem Rat_cases [case_names Fract, cases type: rat]:
  36.296 +  "(!!a b. q = Fract a b ==> b \<noteq> 0 ==> C) ==> C"
  36.297 +proof -
  36.298 +  assume r: "!!a b. q = Fract a b ==> b \<noteq> 0 ==> C"
  36.299 +  obtain x where "q = Abs_Rat x" by (cases q)
  36.300 +  moreover obtain Q where "x = \<lfloor>Q\<rfloor>" by (cases x)
  36.301 +  moreover obtain a b where "Q = fract a b" and "b \<noteq> 0" by (cases Q)
  36.302 +  ultimately have "q = Fract a b" by (simp only: Fract_def rat_of_def)
  36.303 +  thus ?thesis by (rule r)
  36.304 +qed
  36.305 +
  36.306 +theorem Rat_induct [case_names Fract, induct type: rat]:
  36.307 +    "(!!a b. b \<noteq> 0 ==> P (Fract a b)) ==> P q"
  36.308 +  by (cases q) simp
  36.309 +
  36.310 +
  36.311 +subsubsection {* Canonical function definitions *}
  36.312 +
  36.313 +text {*
  36.314 +  Note that the unconditional version below is much easier to read.
  36.315 +*}
  36.316 +
  36.317 +theorem rat_cond_function:
  36.318 +  "(!!q r. P \<lfloor>fraction_of q\<rfloor> \<lfloor>fraction_of r\<rfloor> ==>
  36.319 +      f q r == g (fraction_of q) (fraction_of r)) ==>
  36.320 +    (!!a b a' b' c d c' d'.
  36.321 +      \<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor> ==>
  36.322 +      P \<lfloor>fract a b\<rfloor> \<lfloor>fract c d\<rfloor> ==> P \<lfloor>fract a' b'\<rfloor> \<lfloor>fract c' d'\<rfloor> ==>
  36.323 +      b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0 ==>
  36.324 +      g (fract a b) (fract c d) = g (fract a' b') (fract c' d')) ==>
  36.325 +    P \<lfloor>fract a b\<rfloor> \<lfloor>fract c d\<rfloor> ==>
  36.326 +      f (Fract a b) (Fract c d) = g (fract a b) (fract c d)"
  36.327 +  (is "PROP ?eq ==> PROP ?cong ==> ?P ==> _")
  36.328 +proof -
  36.329 +  assume eq: "PROP ?eq" and cong: "PROP ?cong" and P: ?P
  36.330 +  have "f (Abs_Rat \<lfloor>fract a b\<rfloor>) (Abs_Rat \<lfloor>fract c d\<rfloor>) = g (fract a b) (fract c d)"
  36.331 +  proof (rule quot_cond_function)
  36.332 +    fix X Y assume "P X Y"
  36.333 +    with eq show "f (Abs_Rat X) (Abs_Rat Y) == g (pick X) (pick Y)"
  36.334 +      by (simp add: fraction_of_def pick_inverse Abs_Rat_inverse)
  36.335 +  next
  36.336 +    fix Q Q' R R' :: fraction
  36.337 +    show "\<lfloor>Q\<rfloor> = \<lfloor>Q'\<rfloor> ==> \<lfloor>R\<rfloor> = \<lfloor>R'\<rfloor> ==>
  36.338 +        P \<lfloor>Q\<rfloor> \<lfloor>R\<rfloor> ==> P \<lfloor>Q'\<rfloor> \<lfloor>R'\<rfloor> ==> g Q R = g Q' R'"
  36.339 +      by (induct Q, induct Q', induct R, induct R') (rule cong)
  36.340 +  qed
  36.341 +  thus ?thesis by (unfold Fract_def rat_of_def)
  36.342 +qed
  36.343 +
  36.344 +theorem rat_function:
  36.345 +  "(!!q r. f q r == g (fraction_of q) (fraction_of r)) ==>
  36.346 +    (!!a b a' b' c d c' d'.
  36.347 +      \<lfloor>fract a b\<rfloor> = \<lfloor>fract a' b'\<rfloor> ==> \<lfloor>fract c d\<rfloor> = \<lfloor>fract c' d'\<rfloor> ==>
  36.348 +      b \<noteq> 0 ==> b' \<noteq> 0 ==> d \<noteq> 0 ==> d' \<noteq> 0 ==>
  36.349 +      g (fract a b) (fract c d) = g (fract a' b') (fract c' d')) ==>
  36.350 +    f (Fract a b) (Fract c d) = g (fract a b) (fract c d)"
  36.351 +proof -
  36.352 +  case rule_context from this TrueI
  36.353 +  show ?thesis by (rule rat_cond_function)
  36.354 +qed
  36.355 +
  36.356 +
  36.357 +subsubsection {* Standard operations on rational numbers *}
  36.358 +
  36.359 +instance rat :: zero ..
  36.360 +instance rat :: one ..
  36.361 +instance rat :: plus ..
  36.362 +instance rat :: minus ..
  36.363 +instance rat :: times ..
  36.364 +instance rat :: inverse ..
  36.365 +instance rat :: ord ..
  36.366 +
  36.367 +defs (overloaded)
  36.368 +  zero_rat_def: "0 == rat_of 0"
  36.369 +  one_rat_def: "1 == rat_of 1"
  36.370 +  add_rat_def: "q + r == rat_of (fraction_of q + fraction_of r)"
  36.371 +  minus_rat_def: "-q == rat_of (-(fraction_of q))"
  36.372 +  diff_rat_def: "q - r == q + (-(r::rat))"
  36.373 +  mult_rat_def: "q * r == rat_of (fraction_of q * fraction_of r)"
  36.374 +  inverse_rat_def: "inverse q == 
  36.375 +                    if q=0 then 0 else rat_of (inverse (fraction_of q))"
  36.376 +  divide_rat_def: "q / r == q * inverse (r::rat)"
  36.377 +  le_rat_def: "q \<le> r == fraction_of q \<le> fraction_of r"
  36.378 +  less_rat_def: "q < r == q \<le> r \<and> q \<noteq> (r::rat)"
  36.379 +  abs_rat_def: "\<bar>q\<bar> == if q < 0 then -q else (q::rat)"
  36.380 +
  36.381 +theorem zero_rat: "0 = Fract 0 1"
  36.382 +  by (simp add: zero_rat_def zero_fraction_def rat_of_def Fract_def)        
  36.383 +
  36.384 +theorem one_rat: "1 = Fract 1 1"
  36.385 +  by (simp add: one_rat_def one_fraction_def rat_of_def Fract_def)
  36.386 +
  36.387 +theorem add_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  36.388 +  Fract a b + Fract c d = Fract (a * d + c * b) (b * d)"
  36.389 +proof -
  36.390 +  have "Fract a b + Fract c d = rat_of (fract a b + fract c d)"
  36.391 +    by (rule rat_function, rule add_rat_def, rule rat_of, rule add_fraction_cong)
  36.392 +  also
  36.393 +  assume "b \<noteq> 0"  "d \<noteq> 0"
  36.394 +  hence "fract a b + fract c d = fract (a * d + c * b) (b * d)"
  36.395 +    by (simp add: add_fraction_def)
  36.396 +  finally show ?thesis by (unfold Fract_def)
  36.397 +qed
  36.398 +
  36.399 +theorem minus_rat: "b \<noteq> 0 ==> -(Fract a b) = Fract (-a) b"
  36.400 +proof -
  36.401 +  have "-(Fract a b) = rat_of (-(fract a b))"
  36.402 +    by (rule rat_function, rule minus_rat_def, rule rat_of, rule minus_fraction_cong)
  36.403 +  also assume "b \<noteq> 0" hence "-(fract a b) = fract (-a) b"
  36.404 +    by (simp add: minus_fraction_def)
  36.405 +  finally show ?thesis by (unfold Fract_def)
  36.406 +qed
  36.407 +
  36.408 +theorem diff_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  36.409 +    Fract a b - Fract c d = Fract (a * d - c * b) (b * d)"
  36.410 +  by (simp add: diff_rat_def add_rat minus_rat)
  36.411 +
  36.412 +theorem mult_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  36.413 +  Fract a b * Fract c d = Fract (a * c) (b * d)"
  36.414 +proof -
  36.415 +  have "Fract a b * Fract c d = rat_of (fract a b * fract c d)"
  36.416 +    by (rule rat_function, rule mult_rat_def, rule rat_of, rule mult_fraction_cong)
  36.417 +  also
  36.418 +  assume "b \<noteq> 0"  "d \<noteq> 0"
  36.419 +  hence "fract a b * fract c d = fract (a * c) (b * d)"
  36.420 +    by (simp add: mult_fraction_def)
  36.421 +  finally show ?thesis by (unfold Fract_def)
  36.422 +qed
  36.423 +
  36.424 +theorem inverse_rat: "Fract a b \<noteq> 0 ==> b \<noteq> 0 ==>
  36.425 +  inverse (Fract a b) = Fract b a"
  36.426 +proof -
  36.427 +  assume neq: "b \<noteq> 0" and nonzero: "Fract a b \<noteq> 0"
  36.428 +  hence "\<lfloor>fract a b\<rfloor> \<noteq> \<lfloor>0\<rfloor>"
  36.429 +    by (simp add: zero_rat eq_rat is_zero_fraction_iff)
  36.430 +  with _ inverse_fraction_cong [THEN rat_of]
  36.431 +  have "inverse (Fract a b) = rat_of (inverse (fract a b))"
  36.432 +  proof (rule rat_cond_function)
  36.433 +    fix q assume cond: "\<lfloor>fraction_of q\<rfloor> \<noteq> \<lfloor>0\<rfloor>"
  36.434 +    have "q \<noteq> 0"
  36.435 +    proof (cases q)
  36.436 +      fix a b assume "b \<noteq> 0" and "q = Fract a b"
  36.437 +      from this cond show ?thesis
  36.438 +        by (simp add: Fract_inverse is_zero_fraction_iff zero_rat eq_rat)
  36.439 +    qed
  36.440 +    thus "inverse q == rat_of (inverse (fraction_of q))"
  36.441 +      by (simp add: inverse_rat_def)
  36.442 +  qed
  36.443 +  also from neq nonzero have "inverse (fract a b) = fract b a"
  36.444 +    by (simp add: inverse_fraction_def)
  36.445 +  finally show ?thesis by (unfold Fract_def)
  36.446 +qed
  36.447 +
  36.448 +theorem divide_rat: "Fract c d \<noteq> 0 ==> b \<noteq> 0 ==> d \<noteq> 0 ==>
  36.449 +  Fract a b / Fract c d = Fract (a * d) (b * c)"
  36.450 +proof -
  36.451 +  assume neq: "b \<noteq> 0"  "d \<noteq> 0" and nonzero: "Fract c d \<noteq> 0"
  36.452 +  hence "c \<noteq> 0" by (simp add: zero_rat eq_rat)
  36.453 +  with neq nonzero show ?thesis
  36.454 +    by (simp add: divide_rat_def inverse_rat mult_rat)
  36.455 +qed
  36.456 +
  36.457 +theorem le_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  36.458 +  (Fract a b \<le> Fract c d) = ((a * d) * (b * d) \<le> (c * b) * (b * d))"
  36.459 +proof -
  36.460 +  have "(Fract a b \<le> Fract c d) = (fract a b \<le> fract c d)"
  36.461 +    by (rule rat_function, rule le_rat_def, rule le_fraction_cong)
  36.462 +  also
  36.463 +  assume "b \<noteq> 0"  "d \<noteq> 0"
  36.464 +  hence "(fract a b \<le> fract c d) = ((a * d) * (b * d) \<le> (c * b) * (b * d))"
  36.465 +    by (simp add: le_fraction_def)
  36.466 +  finally show ?thesis .
  36.467 +qed
  36.468 +
  36.469 +theorem less_rat: "b \<noteq> 0 ==> d \<noteq> 0 ==>
  36.470 +    (Fract a b < Fract c d) = ((a * d) * (b * d) < (c * b) * (b * d))"
  36.471 +  by (simp add: less_rat_def le_rat eq_rat int_less_le)
  36.472 +
  36.473 +theorem abs_rat: "b \<noteq> 0 ==> \<bar>Fract a b\<bar> = Fract \<bar>a\<bar> \<bar>b\<bar>"
  36.474 +  by (simp add: abs_rat_def minus_rat zero_rat less_rat eq_rat)
  36.475 +     (auto simp add: mult_less_0_iff zero_less_mult_iff int_le_less 
  36.476 +                split: abs_split)
  36.477 +
  36.478 +
  36.479 +subsubsection {* The ordered field of rational numbers *}
  36.480 +
  36.481 +lemma rat_add_assoc: "(q + r) + s = q + (r + (s::rat))"
  36.482 +  by (induct q, induct r, induct s) 
  36.483 +     (simp add: add_rat add_ac mult_ac int_distrib)
  36.484 +
  36.485 +lemma rat_add_0: "0 + q = (q::rat)"
  36.486 +  by (induct q) (simp add: zero_rat add_rat)
  36.487 +
  36.488 +lemma rat_left_minus: "(-q) + q = (0::rat)"
  36.489 +  by (induct q) (simp add: zero_rat minus_rat add_rat eq_rat)
  36.490 +
  36.491 +
  36.492 +instance rat :: field
  36.493 +proof
  36.494 +  fix q r s :: rat
  36.495 +  show "(q + r) + s = q + (r + s)"
  36.496 +    by (rule rat_add_assoc)
  36.497 +  show "q + r = r + q"
  36.498 +    by (induct q, induct r) (simp add: add_rat add_ac mult_ac)
  36.499 +  show "0 + q = q"
  36.500 +    by (induct q) (simp add: zero_rat add_rat)
  36.501 +  show "(-q) + q = 0"
  36.502 +    by (rule rat_left_minus)
  36.503 +  show "q - r = q + (-r)"
  36.504 +    by (induct q, induct r) (simp add: add_rat minus_rat diff_rat)
  36.505 +  show "(q * r) * s = q * (r * s)"
  36.506 +    by (induct q, induct r, induct s) (simp add: mult_rat mult_ac)
  36.507 +  show "q * r = r * q"
  36.508 +    by (induct q, induct r) (simp add: mult_rat mult_ac)
  36.509 +  show "1 * q = q"
  36.510 +    by (induct q) (simp add: one_rat mult_rat)
  36.511 +  show "(q + r) * s = q * s + r * s"
  36.512 +    by (induct q, induct r, induct s) 
  36.513 +       (simp add: add_rat mult_rat eq_rat int_distrib)
  36.514 +  show "q \<noteq> 0 ==> inverse q * q = 1"
  36.515 +    by (induct q) (simp add: inverse_rat mult_rat one_rat zero_rat eq_rat)
  36.516 +  show "r \<noteq> 0 ==> q / r = q * inverse r"
  36.517 +    by (induct q, induct r)
  36.518 +       (simp add: mult_rat divide_rat inverse_rat zero_rat eq_rat)
  36.519 +  show "0 \<noteq> (1::rat)"
  36.520 +    by (simp add: zero_rat one_rat eq_rat) 
  36.521 +  assume eq: "s+q = s+r" 
  36.522 +    hence "(-s + s) + q = (-s + s) + r" by (simp only: eq rat_add_assoc)
  36.523 +    thus "q = r" by (simp add: rat_left_minus rat_add_0)
  36.524 +qed
  36.525 +
  36.526 +instance rat :: linorder
  36.527 +proof
  36.528 +  fix q r s :: rat
  36.529 +  {
  36.530 +    assume "q \<le> r" and "r \<le> s"
  36.531 +    show "q \<le> s"
  36.532 +    proof (insert prems, induct q, induct r, induct s)
  36.533 +      fix a b c d e f :: int
  36.534 +      assume neq: "b \<noteq> 0"  "d \<noteq> 0"  "f \<noteq> 0"
  36.535 +      assume 1: "Fract a b \<le> Fract c d" and 2: "Fract c d \<le> Fract e f"
  36.536 +      show "Fract a b \<le> Fract e f"
  36.537 +      proof -
  36.538 +        from neq obtain bb: "0 < b * b" and dd: "0 < d * d" and ff: "0 < f * f"
  36.539 +          by (auto simp add: zero_less_mult_iff linorder_neq_iff)
  36.540 +        have "(a * d) * (b * d) * (f * f) \<le> (c * b) * (b * d) * (f * f)"
  36.541 +        proof -
  36.542 +          from neq 1 have "(a * d) * (b * d) \<le> (c * b) * (b * d)"
  36.543 +            by (simp add: le_rat)
  36.544 +          with ff show ?thesis by (simp add: mult_le_cancel_right)
  36.545 +        qed
  36.546 +        also have "... = (c * f) * (d * f) * (b * b)"
  36.547 +          by (simp only: mult_ac)
  36.548 +        also have "... \<le> (e * d) * (d * f) * (b * b)"
  36.549 +        proof -
  36.550 +          from neq 2 have "(c * f) * (d * f) \<le> (e * d) * (d * f)"
  36.551 +            by (simp add: le_rat)
  36.552 +          with bb show ?thesis by (simp add: mult_le_cancel_right)
  36.553 +        qed
  36.554 +        finally have "(a * f) * (b * f) * (d * d) \<le> e * b * (b * f) * (d * d)"
  36.555 +          by (simp only: mult_ac)
  36.556 +        with dd have "(a * f) * (b * f) \<le> (e * b) * (b * f)"
  36.557 +          by (simp add: mult_le_cancel_right)
  36.558 +        with neq show ?thesis by (simp add: le_rat)
  36.559 +      qed
  36.560 +    qed
  36.561 +  next
  36.562 +    assume "q \<le> r" and "r \<le> q"
  36.563 +    show "q = r"
  36.564 +    proof (insert prems, induct q, induct r)
  36.565 +      fix a b c d :: int
  36.566 +      assume neq: "b \<noteq> 0"  "d \<noteq> 0"
  36.567 +      assume 1: "Fract a b \<le> Fract c d" and 2: "Fract c d \<le> Fract a b"
  36.568 +      show "Fract a b = Fract c d"
  36.569 +      proof -
  36.570 +        from neq 1 have "(a * d) * (b * d) \<le> (c * b) * (b * d)"
  36.571 +          by (simp add: le_rat)
  36.572 +        also have "... \<le> (a * d) * (b * d)"
  36.573 +        proof -
  36.574 +          from neq 2 have "(c * b) * (d * b) \<le> (a * d) * (d * b)"
  36.575 +            by (simp add: le_rat)
  36.576 +          thus ?thesis by (simp only: mult_ac)
  36.577 +        qed
  36.578 +        finally have "(a * d) * (b * d) = (c * b) * (b * d)" .
  36.579 +        moreover from neq have "b * d \<noteq> 0" by simp
  36.580 +        ultimately have "a * d = c * b" by simp
  36.581 +        with neq show ?thesis by (simp add: eq_rat)
  36.582 +      qed
  36.583 +    qed
  36.584 +  next
  36.585 +    show "q \<le> q"
  36.586 +      by (induct q) (simp add: le_rat)
  36.587 +    show "(q < r) = (q \<le> r \<and> q \<noteq> r)"
  36.588 +      by (simp only: less_rat_def)
  36.589 +    show "q \<le> r \<or> r \<le> q"
  36.590 +      by (induct q, induct r) (simp add: le_rat mult_ac, arith)
  36.591 +  }
  36.592 +qed
  36.593 +
  36.594 +instance rat :: ordered_field
  36.595 +proof
  36.596 +  fix q r s :: rat
  36.597 +  show "0 < (1::rat)" 
  36.598 +    by (simp add: zero_rat one_rat less_rat) 
  36.599 +  show "q \<le> r ==> s + q \<le> s + r"
  36.600 +  proof (induct q, induct r, induct s)
  36.601 +    fix a b c d e f :: int
  36.602 +    assume neq: "b \<noteq> 0"  "d \<noteq> 0"  "f \<noteq> 0"
  36.603 +    assume le: "Fract a b \<le> Fract c d"
  36.604 +    show "Fract e f + Fract a b \<le> Fract e f + Fract c d"
  36.605 +    proof -
  36.606 +      let ?F = "f * f" from neq have F: "0 < ?F"
  36.607 +        by (auto simp add: zero_less_mult_iff)
  36.608 +      from neq le have "(a * d) * (b * d) \<le> (c * b) * (b * d)"
  36.609 +        by (simp add: le_rat)
  36.610 +      with F have "(a * d) * (b * d) * ?F * ?F \<le> (c * b) * (b * d) * ?F * ?F"
  36.611 +        by (simp add: mult_le_cancel_right)
  36.612 +      with neq show ?thesis by (simp add: add_rat le_rat mult_ac int_distrib)
  36.613 +    qed
  36.614 +  qed
  36.615 +  show "q < r ==> 0 < s ==> s * q < s * r"
  36.616 +  proof (induct q, induct r, induct s)
  36.617 +    fix a b c d e f :: int
  36.618 +    assume neq: "b \<noteq> 0"  "d \<noteq> 0"  "f \<noteq> 0"
  36.619 +    assume le: "Fract a b < Fract c d"
  36.620 +    assume gt: "0 < Fract e f"
  36.621 +    show "Fract e f * Fract a b < Fract e f * Fract c d"
  36.622 +    proof -
  36.623 +      let ?E = "e * f" and ?F = "f * f"
  36.624 +      from neq gt have "0 < ?E"
  36.625 +        by (auto simp add: zero_rat less_rat le_rat int_less_le eq_rat)
  36.626 +      moreover from neq have "0 < ?F"
  36.627 +        by (auto simp add: zero_less_mult_iff)
  36.628 +      moreover from neq le have "(a * d) * (b * d) < (c * b) * (b * d)"
  36.629 +        by (simp add: less_rat)
  36.630 +      ultimately have "(a * d) * (b * d) * ?E * ?F < (c * b) * (b * d) * ?E * ?F"
  36.631 +        by (simp add: mult_less_cancel_right)
  36.632 +      with neq show ?thesis
  36.633 +        by (simp add: less_rat mult_rat mult_ac)
  36.634 +    qed
  36.635 +  qed
  36.636 +  show "\<bar>q\<bar> = (if q < 0 then -q else q)"
  36.637 +    by (simp only: abs_rat_def)
  36.638 +qed
  36.639 +
  36.640 +instance rat :: division_by_zero
  36.641 +proof
  36.642 +  fix x :: rat
  36.643 +  show "inverse 0 = (0::rat)"  by (simp add: inverse_rat_def)
  36.644 +  show "x/0 = 0"   by (simp add: divide_rat_def inverse_rat_def)
  36.645 +qed
  36.646 +
  36.647 +
  36.648 +subsection {* Embedding integers: The Injection @{term rat} *}
  36.649 +
  36.650 +constdefs
  36.651 +  rat :: "int => rat"    (* FIXME generalize int to any numeric subtype (?) *)
  36.652 +  "rat z == Fract z 1"
  36.653 +  int_set :: "rat set"    ("\<int>")    (* FIXME generalize rat to any numeric supertype (?) *)
  36.654 +  "\<int> == range rat"
  36.655 +
  36.656 +lemma int_set_cases [case_names rat, cases set: int_set]:
  36.657 +  "q \<in> \<int> ==> (!!z. q = rat z ==> C) ==> C"
  36.658 +proof (unfold int_set_def)
  36.659 +  assume "!!z. q = rat z ==> C"
  36.660 +  assume "q \<in> range rat" thus C ..
  36.661 +qed
  36.662 +
  36.663 +lemma int_set_induct [case_names rat, induct set: int_set]:
  36.664 +  "q \<in> \<int> ==> (!!z. P (rat z)) ==> P q"
  36.665 +  by (rule int_set_cases) auto
  36.666 +
  36.667 +lemma rat_of_int_zero [simp]: "rat (0::int) = (0::rat)"
  36.668 +by (simp add: rat_def zero_rat [symmetric])
  36.669 +
  36.670 +lemma rat_of_int_one [simp]: "rat (1::int) = (1::rat)"
  36.671 +by (simp add: rat_def one_rat [symmetric])
  36.672 +
  36.673 +lemma rat_of_int_add_distrib [simp]: "rat (x + y) = rat (x::int) + rat y"
  36.674 +by (simp add: rat_def add_rat)
  36.675 +
  36.676 +lemma rat_of_int_minus_distrib [simp]: "rat (-x) = -rat (x::int)"
  36.677 +by (simp add: rat_def minus_rat)
  36.678 +
  36.679 +lemma rat_of_int_diff_distrib [simp]: "rat (x - y) = rat (x::int) - rat y"
  36.680 +by (simp add: rat_def diff_rat)
  36.681 +
  36.682 +lemma rat_of_int_mult_distrib [simp]: "rat (x * y) = rat (x::int) * rat y"
  36.683 +by (simp add: rat_def mult_rat)
  36.684 +
  36.685 +lemma rat_inject [simp]: "(rat z = rat w) = (z = w)"
  36.686 +proof
  36.687 +  assume "rat z = rat w"
  36.688 +  hence "Fract z 1 = Fract w 1" by (unfold rat_def)
  36.689 +  hence "\<lfloor>fract z 1\<rfloor> = \<lfloor>fract w 1\<rfloor>" ..
  36.690 +  thus "z = w" by auto
  36.691 +next
  36.692 +  assume "z = w"
  36.693 +  thus "rat z = rat w" by simp
  36.694 +qed
  36.695 +
  36.696 +
  36.697 +lemma rat_of_int_zero_cancel [simp]: "(rat x = 0) = (x = 0)"
  36.698 +proof -
  36.699 +  have "(rat x = 0) = (rat x = rat 0)" by simp
  36.700 +  also have "... = (x = 0)" by (rule rat_inject)
  36.701 +  finally show ?thesis .
  36.702 +qed
  36.703 +
  36.704 +lemma rat_of_int_less_iff [simp]: "rat (x::int) < rat y = (x < y)"
  36.705 +by (simp add: rat_def less_rat) 
  36.706 +
  36.707 +lemma rat_of_int_le_iff [simp]: "(rat (x::int) \<le> rat y) = (x \<le> y)"
  36.708 +by (simp add: linorder_not_less [symmetric])
  36.709 +
  36.710 +lemma zero_less_rat_of_int_iff [simp]: "(0 < rat y) = (0 < y)"
  36.711 +by (insert rat_of_int_less_iff [of 0 y], simp)
  36.712 +
  36.713 +
  36.714 +subsection {* Various Other Results *}
  36.715 +
  36.716 +lemma minus_rat_cancel [simp]: "b \<noteq> 0 ==> Fract (-a) (-b) = Fract a b"
  36.717 +by (simp add: Fract_equality eq_fraction_iff) 
  36.718 +
  36.719 +theorem Rat_induct_pos [case_names Fract, induct type: rat]:
  36.720 +  assumes step: "!!a b. 0 < b ==> P (Fract a b)"
  36.721 +    shows "P q"
  36.722 +proof (cases q)
  36.723 +  have step': "!!a b. b < 0 ==> P (Fract a b)"
  36.724 +  proof -
  36.725 +    fix a::int and b::int
  36.726 +    assume b: "b < 0"
  36.727 +    hence "0 < -b" by simp
  36.728 +    hence "P (Fract (-a) (-b))" by (rule step)
  36.729 +    thus "P (Fract a b)" by (simp add: order_less_imp_not_eq [OF b])
  36.730 +  qed
  36.731 +  case (Fract a b)
  36.732 +  thus "P q" by (force simp add: linorder_neq_iff step step')
  36.733 +qed
  36.734 +
  36.735 +lemma zero_less_Fract_iff:
  36.736 +     "0 < b ==> (0 < Fract a b) = (0 < a)"
  36.737 +by (simp add: zero_rat less_rat order_less_imp_not_eq2 zero_less_mult_iff) 
  36.738 +
  36.739 +end
    37.1 --- a/src/HOL/Real/RealArith.thy	Tue Jan 27 09:44:14 2004 +0100
    37.2 +++ b/src/HOL/Real/RealArith.thy	Tue Jan 27 15:39:51 2004 +0100
    37.3 @@ -1,6 +1,159 @@
    37.4 -theory RealArith = RealBin
    37.5 +(*  Title:      HOL/RealArith.thy
    37.6 +    ID:         $Id$
    37.7 +    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    37.8 +    Copyright   1999  University of Cambridge
    37.9 +
   37.10 +Binary arithmetic and simplification for the reals
   37.11 +
   37.12 +This case is reduced to that for the integers
   37.13 +*)
   37.14 +
   37.15 +theory RealArith = RealDef
   37.16  files ("real_arith.ML"):
   37.17  
   37.18 +instance real :: number ..
   37.19 +
   37.20 +defs
   37.21 +  real_number_of_def:
   37.22 +    "number_of v == real (number_of v :: int)"
   37.23 +     (*::bin=>real           ::bin=>int*)
   37.24 +
   37.25 +text{*Collapse applications of @{term real} to @{term number_of}*}
   37.26 +declare real_number_of_def [symmetric, simp]
   37.27 +
   37.28 +lemma real_numeral_0_eq_0: "Numeral0 = (0::real)"
   37.29 +by (simp add: real_number_of_def)
   37.30 +
   37.31 +lemma real_numeral_1_eq_1: "Numeral1 = (1::real)"
   37.32 +apply (unfold real_number_of_def)
   37.33 +apply (subst real_of_one [symmetric], simp)
   37.34 +done
   37.35 +
   37.36 +
   37.37 +subsection{*Arithmetic Operations On Numerals*}
   37.38 +
   37.39 +lemma add_real_number_of [simp]:
   37.40 +     "(number_of v :: real) + number_of v' = number_of (bin_add v v')"
   37.41 +by (simp only: real_number_of_def real_of_int_add number_of_add)
   37.42 +
   37.43 +lemma minus_real_number_of [simp]:
   37.44 +     "- (number_of w :: real) = number_of (bin_minus w)"
   37.45 +by (simp only: real_number_of_def number_of_minus real_of_int_minus)
   37.46 +
   37.47 +lemma diff_real_number_of [simp]: 
   37.48 +   "(number_of v :: real) - number_of w = number_of (bin_add v (bin_minus w))"
   37.49 +by (simp only: real_number_of_def diff_number_of_eq real_of_int_diff)
   37.50 +
   37.51 +lemma mult_real_number_of [simp]:
   37.52 +     "(number_of v :: real) * number_of v' = number_of (bin_mult v v')"
   37.53 +by (simp only: real_number_of_def real_of_int_mult number_of_mult)
   37.54 +
   37.55 +
   37.56 +text{*Lemmas for specialist use, NOT as default simprules*}
   37.57 +lemma real_mult_2: "2 * z = (z+z::real)"
   37.58 +proof -
   37.59 +  have eq: "(2::real) = 1 + 1" by (simp add: real_numeral_1_eq_1 [symmetric])
   37.60 +  thus ?thesis by (simp add: eq left_distrib)
   37.61 +qed
   37.62 +
   37.63 +lemma real_mult_2_right: "z * 2 = (z+z::real)"
   37.64 +by (subst mult_commute, rule real_mult_2)
   37.65 +
   37.66 +
   37.67 +subsection{*Comparisons On Numerals*}
   37.68 +
   37.69 +lemma eq_real_number_of [simp]:
   37.70 +     "((number_of v :: real) = number_of v') =  
   37.71 +      iszero (number_of (bin_add v (bin_minus v')))"
   37.72 +by (simp only: real_number_of_def real_of_int_inject eq_number_of_eq)
   37.73 +
   37.74 +text{*@{term neg} is used in rewrite rules for binary comparisons*}
   37.75 +lemma less_real_number_of [simp]:
   37.76 +     "((number_of v :: real) < number_of v') =  
   37.77 +      neg (number_of (bin_add v (bin_minus v')))"
   37.78 +by (simp only: real_number_of_def real_of_int_less_iff less_number_of_eq_neg)
   37.79 +
   37.80 +
   37.81 +text{*New versions of existing theorems involving 0, 1*}
   37.82 +
   37.83 +lemma real_minus_1_eq_m1 [simp]: "- 1 = (-1::real)"
   37.84 +by (simp add: real_numeral_1_eq_1 [symmetric])
   37.85 +
   37.86 +lemma real_mult_minus1 [simp]: "-1 * z = -(z::real)"
   37.87 +proof -
   37.88 +  have  "-1 * z = (- 1) * z" by (simp add: real_minus_1_eq_m1)
   37.89 +  also have "... = - (1 * z)" by (simp only: minus_mult_left) 
   37.90 +  also have "... = -z" by simp
   37.91 +  finally show ?thesis .
   37.92 +qed
   37.93 +
   37.94 +lemma real_mult_minus1_right [simp]: "z * -1 = -(z::real)"
   37.95 +by (subst mult_commute, rule real_mult_minus1)
   37.96 +
   37.97 +
   37.98 +
   37.99 +(** real from type "nat" **)
  37.100 +
  37.101 +lemma zero_less_real_of_nat_iff [iff]: "(0 < real (n::nat)) = (0<n)"
  37.102 +by (simp only: real_of_nat_less_iff real_of_nat_zero [symmetric])
  37.103 +
  37.104 +lemma zero_le_real_of_nat_iff [iff]: "(0 <= real (n::nat)) = (0<=n)"
  37.105 +by (simp only: real_of_nat_le_iff real_of_nat_zero [symmetric])
  37.106 +
  37.107 +
  37.108 +(*Like the ones above, for "equals"*)
  37.109 +declare real_of_nat_zero_iff [iff]
  37.110 +
  37.111 +
  37.112 +subsection{*Simplification of Arithmetic when Nested to the Right*}
  37.113 +
  37.114 +lemma real_add_number_of_left [simp]:
  37.115 +     "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::real)"
  37.116 +by (simp add: add_assoc [symmetric])
  37.117 +
  37.118 +lemma real_mult_number_of_left [simp]:
  37.119 +     "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::real)"
  37.120 +apply (simp (no_asm) add: mult_assoc [symmetric])
  37.121 +done
  37.122 +
  37.123 +lemma real_add_number_of_diff1 [simp]: 
  37.124 +     "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::real)"
  37.125 +apply (unfold real_diff_def)
  37.126 +apply (rule real_add_number_of_left)
  37.127 +done
  37.128 +
  37.129 +lemma real_add_number_of_diff2 [simp]:
  37.130 +     "number_of v + (c - number_of w) =  
  37.131 +      number_of (bin_add v (bin_minus w)) + (c::real)"
  37.132 +apply (subst diff_real_number_of [symmetric])
  37.133 +apply (simp only: real_diff_def add_ac)
  37.134 +done
  37.135 +
  37.136 +
  37.137 +text{*The constant @{term neg} is used in rewrite rules for binary
  37.138 +comparisons. A complication in this proof is that both @{term real} and @{term
  37.139 +number_of} are polymorphic, so that it's difficult to know what types subterms
  37.140 +have. *}
  37.141 +lemma real_of_nat_number_of [simp]:
  37.142 +     "real (number_of v :: nat) =  
  37.143 +        (if neg (number_of v) then 0  
  37.144 +         else (number_of v :: real))"
  37.145 +proof cases
  37.146 +  assume "neg (number_of v)" thus ?thesis by simp
  37.147 +next
  37.148 +  assume neg: "~ neg (number_of v)"
  37.149 +  thus ?thesis
  37.150 +    by (simp only: nat_number_of_def real_of_nat_real_of_int [OF neg], simp) 
  37.151 +qed
  37.152 +
  37.153 +declare real_numeral_0_eq_0 [simp] real_numeral_1_eq_1 [simp]
  37.154 +
  37.155 +(*Simplification of  x-y < 0, etc.*)
  37.156 +declare less_iff_diff_less_0 [symmetric, iff]
  37.157 +declare eq_iff_diff_eq_0 [symmetric, iff]
  37.158 +declare le_iff_diff_le_0 [symmetric, iff]
  37.159 +
  37.160 +
  37.161  use "real_arith.ML"
  37.162  
  37.163  setup real_arith_setup
  37.164 @@ -79,13 +232,7 @@
  37.165          (if neg (number_of v) then number_of (bin_minus v)  
  37.166           else number_of v)"
  37.167  by (simp add: real_abs_def bin_arith_simps minus_real_number_of
  37.168 -       le_real_number_of_eq_not_less less_real_number_of real_of_int_le_iff)
  37.169 -
  37.170 -
  37.171 -(*----------------------------------------------------------------------------
  37.172 -       Properties of the absolute value function over the reals
  37.173 -       (adapted version of previously proved theorems about abs)
  37.174 - ----------------------------------------------------------------------------*)
  37.175 +       less_real_number_of real_of_int_le_iff)
  37.176  
  37.177  text{*FIXME: these should go!*}
  37.178  lemma abs_eqI1: "(0::real)\<le>x ==> abs x = x"
  37.179 @@ -95,7 +242,7 @@
  37.180  by (unfold real_abs_def, simp)
  37.181  
  37.182  lemma abs_minus_eqI2: "x < (0::real) ==> abs x = -x"
  37.183 -by (unfold real_abs_def real_le_def, simp)
  37.184 +by (simp add: real_abs_def linorder_not_less [symmetric])
  37.185  
  37.186  lemma abs_minus_add_cancel: "abs(x + (-y)) = abs (y + (-(x::real)))"
  37.187  by (unfold real_abs_def, simp)
    38.1 --- a/src/HOL/Real/RealBin.ML	Tue Jan 27 09:44:14 2004 +0100
    38.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.3 @@ -1,590 +0,0 @@
    38.4 -(*  Title:      HOL/Real/RealBin.ML
    38.5 -    ID:         $Id$
    38.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    38.7 -    Copyright   1999  University of Cambridge
    38.8 -
    38.9 -Binary arithmetic for the reals (integer literals only).
   38.10 -*)
   38.11 -
   38.12 -(** real (coercion from int to real) **)
   38.13 -
   38.14 -Goal "real (number_of w :: int) = number_of w";
   38.15 -by (simp_tac (simpset() addsimps [real_number_of_def]) 1);
   38.16 -qed "real_number_of";
   38.17 -Addsimps [real_number_of];
   38.18 -
   38.19 -Goalw [real_number_of_def] "Numeral0 = (0::real)";
   38.20 -by (simp_tac (simpset() addsimps [real_of_int_zero RS sym]) 1);
   38.21 -qed "real_numeral_0_eq_0";
   38.22 -
   38.23 -Goalw [real_number_of_def] "Numeral1 = (1::real)";
   38.24 -by (stac (real_of_one RS sym) 1);
   38.25 -by (Simp_tac 1);
   38.26 -qed "real_numeral_1_eq_1";
   38.27 -
   38.28 -(** Addition **)
   38.29 -
   38.30 -Goal "(number_of v :: real) + number_of v' = number_of (bin_add v v')";
   38.31 -by (simp_tac
   38.32 -    (HOL_ss addsimps [real_number_of_def,
   38.33 -                                  real_of_int_add, number_of_add]) 1);
   38.34 -qed "add_real_number_of";
   38.35 -
   38.36 -Addsimps [add_real_number_of];
   38.37 -
   38.38 -
   38.39 -(** Subtraction **)
   38.40 -
   38.41 -Goalw [real_number_of_def] "- (number_of w :: real) = number_of (bin_minus w)";
   38.42 -by (simp_tac
   38.43 -    (HOL_ss addsimps [number_of_minus, real_of_int_minus]) 1);
   38.44 -qed "minus_real_number_of";
   38.45 -
   38.46 -Goalw [real_number_of_def]
   38.47 -   "(number_of v :: real) - number_of w = number_of (bin_add v (bin_minus w))";
   38.48 -by (simp_tac
   38.49 -    (HOL_ss addsimps [diff_number_of_eq, real_of_int_diff]) 1);
   38.50 -qed "diff_real_number_of";
   38.51 -
   38.52 -Addsimps [minus_real_number_of, diff_real_number_of];
   38.53 -
   38.54 -
   38.55 -(** Multiplication **)
   38.56 -
   38.57 -Goal "(number_of v :: real) * number_of v' = number_of (bin_mult v v')";
   38.58 -by (simp_tac
   38.59 -    (HOL_ss addsimps [real_number_of_def, real_of_int_mult,
   38.60 -                      number_of_mult]) 1);
   38.61 -qed "mult_real_number_of";
   38.62 -
   38.63 -Addsimps [mult_real_number_of];
   38.64 -
   38.65 -Goal "(2::real) = 1 + 1";
   38.66 -by (simp_tac (simpset() addsimps [real_numeral_1_eq_1 RS sym]) 1);
   38.67 -val lemma = result();
   38.68 -
   38.69 -(*For specialist use: NOT as default simprules*)
   38.70 -Goal "2 * z = (z+z::real)";
   38.71 -by (simp_tac (simpset () addsimps [lemma, left_distrib]) 1);
   38.72 -qed "real_mult_2";
   38.73 -
   38.74 -Goal "z * 2 = (z+z::real)";
   38.75 -by (stac real_mult_commute 1 THEN rtac real_mult_2 1);
   38.76 -qed "real_mult_2_right";
   38.77 -
   38.78 -
   38.79 -(*** Comparisons ***)
   38.80 -
   38.81 -(** Equals (=) **)
   38.82 -
   38.83 -Goal "((number_of v :: real) = number_of v') = \
   38.84 -\     iszero (number_of (bin_add v (bin_minus v')))";
   38.85 -by (simp_tac
   38.86 -    (HOL_ss addsimps [real_number_of_def,
   38.87 -                      real_of_int_inject, eq_number_of_eq]) 1);
   38.88 -qed "eq_real_number_of";
   38.89 -
   38.90 -Addsimps [eq_real_number_of];
   38.91 -
   38.92 -(** Less-than (<) **)
   38.93 -
   38.94 -(*"neg" is used in rewrite rules for binary comparisons*)
   38.95 -Goal "((number_of v :: real) < number_of v') = \
   38.96 -\     neg (number_of (bin_add v (bin_minus v')))";
   38.97 -by (simp_tac
   38.98 -    (HOL_ss addsimps [real_number_of_def, real_of_int_less_iff,
   38.99 -                                  less_number_of_eq_neg]) 1);
  38.100 -qed "less_real_number_of";
  38.101 -
  38.102 -Addsimps [less_real_number_of];
  38.103 -
  38.104 -
  38.105 -(** Less-than-or-equals (<=) **)
  38.106 -
  38.107 -Goal "(number_of x <= (number_of y::real)) = \
  38.108 -\     (~ number_of y < (number_of x::real))";
  38.109 -by (rtac (linorder_not_less RS sym) 1);
  38.110 -qed "le_real_number_of_eq_not_less";
  38.111 -
  38.112 -Addsimps [le_real_number_of_eq_not_less];
  38.113 -
  38.114 -(*** New versions of existing theorems involving 0, 1 ***)
  38.115 -
  38.116 -Goal "- 1 = (-1::real)";
  38.117 -by (simp_tac (simpset() addsimps [real_numeral_1_eq_1 RS sym]) 1);
  38.118 -qed "real_minus_1_eq_m1";
  38.119 -
  38.120 -Goal "-1 * z = -(z::real)";
  38.121 -by (simp_tac (simpset() addsimps [real_minus_1_eq_m1 RS sym]) 1);
  38.122 -qed "real_mult_minus1";
  38.123 -
  38.124 -Goal "z * -1 = -(z::real)";
  38.125 -by (stac real_mult_commute 1 THEN rtac real_mult_minus1 1);
  38.126 -qed "real_mult_minus1_right";
  38.127 -
  38.128 -Addsimps [real_mult_minus1, real_mult_minus1_right];
  38.129 -
  38.130 -
  38.131 -(*Maps 0 to Numeral0 and 1 to Numeral1 and -(Numeral1) to -1*)
  38.132 -val real_numeral_ss =
  38.133 -    HOL_ss addsimps [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym,
  38.134 -                     real_minus_1_eq_m1];
  38.135 -
  38.136 -fun rename_numerals th =
  38.137 -    asm_full_simplify real_numeral_ss (Thm.transfer (the_context ()) th);
  38.138 -
  38.139 -
  38.140 -(** real from type "nat" **)
  38.141 -
  38.142 -Goal "(0 < real (n::nat)) = (0<n)";
  38.143 -by (simp_tac (HOL_ss addsimps [real_of_nat_less_iff,
  38.144 -                               real_of_nat_zero RS sym]) 1);
  38.145 -qed "zero_less_real_of_nat_iff";
  38.146 -AddIffs [zero_less_real_of_nat_iff];
  38.147 -
  38.148 -Goal "(0 <= real (n::nat)) = (0<=n)";
  38.149 -by (simp_tac (HOL_ss addsimps [real_of_nat_le_iff,
  38.150 -                               real_of_nat_zero RS sym]) 1);
  38.151 -qed "zero_le_real_of_nat_iff";
  38.152 -AddIffs [zero_le_real_of_nat_iff];
  38.153 -
  38.154 -
  38.155 -(*Like the ones above, for "equals"*)
  38.156 -AddIffs [real_of_nat_zero_iff];
  38.157 -
  38.158 -(** Simplification of arithmetic when nested to the right **)
  38.159 -
  38.160 -Goal "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::real)";
  38.161 -by (asm_full_simp_tac (simpset() addsimps [add_assoc RS sym]) 1); 
  38.162 -qed "real_add_number_of_left";
  38.163 -
  38.164 -Goal "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::real)";
  38.165 -by (simp_tac (simpset() addsimps [mult_assoc RS sym]) 1);
  38.166 -qed "real_mult_number_of_left";
  38.167 -
  38.168 -Goalw [real_diff_def]
  38.169 -     "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::real)";
  38.170 -by (rtac real_add_number_of_left 1);
  38.171 -qed "real_add_number_of_diff1";
  38.172 -
  38.173 -Goal "number_of v + (c - number_of w) = \
  38.174 -\     number_of (bin_add v (bin_minus w)) + (c::real)";
  38.175 -by (stac (diff_real_number_of RS sym) 1);
  38.176 -by (asm_full_simp_tac (HOL_ss addsimps [real_diff_def]@add_ac) 1); 
  38.177 -qed "real_add_number_of_diff2";
  38.178 -
  38.179 -Addsimps [real_add_number_of_left, real_mult_number_of_left,
  38.180 -          real_add_number_of_diff1, real_add_number_of_diff2];
  38.181 -
  38.182 -
  38.183 -(*"neg" is used in rewrite rules for binary comparisons*)
  38.184 -Goal "real (number_of v :: nat) = \
  38.185 -\       (if neg (number_of v) then 0 \
  38.186 -\        else (number_of v :: real))";
  38.187 -by (simp_tac
  38.188 -    (HOL_ss addsimps [nat_number_of_def, real_of_nat_real_of_int,
  38.189 -                      real_of_nat_neg_int, real_number_of,
  38.190 -                      real_numeral_0_eq_0 RS sym]) 1);
  38.191 -qed "real_of_nat_number_of";
  38.192 -Addsimps [real_of_nat_number_of];
  38.193 -
  38.194 -
  38.195 -(**** Simprocs for numeric literals ****)
  38.196 -
  38.197 -(** For combine_numerals **)
  38.198 -
  38.199 -Goal "i*u + (j*u + k) = (i+j)*u + (k::real)";
  38.200 -by (asm_simp_tac (simpset() addsimps [left_distrib] @ add_ac) 1);
  38.201 -qed "left_real_add_mult_distrib";
  38.202 -
  38.203 -
  38.204 -(** For cancel_numerals **)
  38.205 -
  38.206 -val rel_iff_rel_0_rls = map (inst "b" "?u+?v")
  38.207 -                   [less_iff_diff_less_0, eq_iff_diff_eq_0, le_iff_diff_le_0] @
  38.208 -                 map (inst "b" "n")
  38.209 -                   [less_iff_diff_less_0, eq_iff_diff_eq_0, le_iff_diff_le_0];
  38.210 -
  38.211 -Goal "!!i::real. (i*u + m = j*u + n) = ((i-j)*u + m = n)";
  38.212 -by (asm_simp_tac (simpset() addsimps [real_diff_def, left_distrib]@
  38.213 -                                     add_ac@rel_iff_rel_0_rls) 1);
  38.214 -qed "real_eq_add_iff1";
  38.215 -
  38.216 -Goal "!!i::real. (i*u + m = j*u + n) = (m = (j-i)*u + n)";
  38.217 -by (asm_simp_tac (simpset() addsimps [real_diff_def, left_distrib]@
  38.218 -                                     add_ac@rel_iff_rel_0_rls) 1);
  38.219 -qed "real_eq_add_iff2";
  38.220 -
  38.221 -Goal "!!i::real. (i*u + m < j*u + n) = ((i-j)*u + m < n)";
  38.222 -by (asm_simp_tac (simpset() addsimps [real_diff_def, left_distrib]@
  38.223 -                                     add_ac@rel_iff_rel_0_rls) 1);
  38.224 -qed "real_less_add_iff1";
  38.225 -
  38.226 -Goal "!!i::real. (i*u + m < j*u + n) = (m < (j