src/HOL/Hyperreal/HyperDef.thy
author nipkow
Wed Aug 18 11:09:40 2004 +0200 (2004-08-18)
changeset 15140 322485b816ac
parent 15131 c69542757a4d
child 15169 2b5da07a0b89
permissions -rw-r--r--
import -> imports
     1 (*  Title       : HOL/Real/Hyperreal/HyperDef.thy
     2     ID          : $Id$
     3     Author      : Jacques D. Fleuriot
     4     Copyright   : 1998  University of Cambridge
     5     Conversion to Isar and new proofs by Lawrence C Paulson, 2004
     6 *)
     7 
     8 header{*Construction of Hyperreals Using Ultrafilters*}
     9 
    10 theory HyperDef
    11 imports Filter "../Real/Real"
    12 files ("fuf.ML")  (*Warning: file fuf.ML refers to the name Hyperdef!*)
    13 begin
    14 
    15 constdefs
    16 
    17   FreeUltrafilterNat   :: "nat set set"    ("\<U>")
    18     "FreeUltrafilterNat == (SOME U. U \<in> FreeUltrafilter (UNIV:: nat set))"
    19 
    20   hyprel :: "((nat=>real)*(nat=>real)) set"
    21     "hyprel == {p. \<exists>X Y. p = ((X::nat=>real),Y) &
    22                    {n::nat. X(n) = Y(n)} \<in> FreeUltrafilterNat}"
    23 
    24 typedef hypreal = "UNIV//hyprel" 
    25     by (auto simp add: quotient_def) 
    26 
    27 instance hypreal :: "{ord, zero, one, plus, times, minus, inverse}" ..
    28 
    29 defs (overloaded)
    30 
    31   hypreal_zero_def:
    32   "0 == Abs_hypreal(hyprel``{%n. 0})"
    33 
    34   hypreal_one_def:
    35   "1 == Abs_hypreal(hyprel``{%n. 1})"
    36 
    37   hypreal_minus_def:
    38   "- P == Abs_hypreal(\<Union>X \<in> Rep_hypreal(P). hyprel``{%n. - (X n)})"
    39 
    40   hypreal_diff_def:
    41   "x - y == x + -(y::hypreal)"
    42 
    43   hypreal_inverse_def:
    44   "inverse P == Abs_hypreal(\<Union>X \<in> Rep_hypreal(P).
    45                     hyprel``{%n. if X n = 0 then 0 else inverse (X n)})"
    46 
    47   hypreal_divide_def:
    48   "P / Q::hypreal == P * inverse Q"
    49 
    50 constdefs
    51 
    52   hypreal_of_real  :: "real => hypreal"
    53   "hypreal_of_real r         == Abs_hypreal(hyprel``{%n. r})"
    54 
    55   omega   :: hypreal   -- {*an infinite number @{text "= [<1,2,3,...>]"} *}
    56   "omega == Abs_hypreal(hyprel``{%n. real (Suc n)})"
    57 
    58   epsilon :: hypreal   -- {*an infinitesimal number @{text "= [<1,1/2,1/3,...>]"} *}
    59   "epsilon == Abs_hypreal(hyprel``{%n. inverse (real (Suc n))})"
    60 
    61 syntax (xsymbols)
    62   omega   :: hypreal   ("\<omega>")
    63   epsilon :: hypreal   ("\<epsilon>")
    64 
    65 syntax (HTML output)
    66   omega   :: hypreal   ("\<omega>")
    67   epsilon :: hypreal   ("\<epsilon>")
    68 
    69 
    70 defs (overloaded)
    71 
    72   hypreal_add_def:
    73   "P + Q == Abs_hypreal(\<Union>X \<in> Rep_hypreal(P). \<Union>Y \<in> Rep_hypreal(Q).
    74                 hyprel``{%n. X n + Y n})"
    75 
    76   hypreal_mult_def:
    77   "P * Q == Abs_hypreal(\<Union>X \<in> Rep_hypreal(P). \<Union>Y \<in> Rep_hypreal(Q).
    78                 hyprel``{%n. X n * Y n})"
    79 
    80   hypreal_le_def:
    81   "P \<le> (Q::hypreal) == \<exists>X Y. X \<in> Rep_hypreal(P) &
    82                                Y \<in> Rep_hypreal(Q) &
    83                                {n. X n \<le> Y n} \<in> FreeUltrafilterNat"
    84 
    85   hypreal_less_def: "(x < (y::hypreal)) == (x \<le> y & x \<noteq> y)"
    86 
    87   hrabs_def:  "abs (r::hypreal) == (if 0 \<le> r then r else -r)"
    88 
    89 
    90 subsection{*The Set of Naturals is not Finite*}
    91 
    92 (*** based on James' proof that the set of naturals is not finite ***)
    93 lemma finite_exhausts [rule_format]:
    94      "finite (A::nat set) --> (\<exists>n. \<forall>m. Suc (n + m) \<notin> A)"
    95 apply (rule impI)
    96 apply (erule_tac F = A in finite_induct)
    97 apply (blast, erule exE)
    98 apply (rule_tac x = "n + x" in exI)
    99 apply (rule allI, erule_tac x = "x + m" in allE)
   100 apply (auto simp add: add_ac)
   101 done
   102 
   103 lemma finite_not_covers [rule_format (no_asm)]:
   104      "finite (A :: nat set) --> (\<exists>n. n \<notin>A)"
   105 by (rule impI, drule finite_exhausts, blast)
   106 
   107 lemma not_finite_nat: "~ finite(UNIV:: nat set)"
   108 by (fast dest!: finite_exhausts)
   109 
   110 
   111 subsection{*Existence of Free Ultrafilter over the Naturals*}
   112 
   113 text{*Also, proof of various properties of @{term FreeUltrafilterNat}: 
   114 an arbitrary free ultrafilter*}
   115 
   116 lemma FreeUltrafilterNat_Ex: "\<exists>U. U \<in> FreeUltrafilter (UNIV::nat set)"
   117 by (rule not_finite_nat [THEN FreeUltrafilter_Ex])
   118 
   119 lemma FreeUltrafilterNat_mem [simp]: 
   120      "FreeUltrafilterNat \<in> FreeUltrafilter(UNIV:: nat set)"
   121 apply (unfold FreeUltrafilterNat_def)
   122 apply (rule FreeUltrafilterNat_Ex [THEN exE])
   123 apply (rule someI2, assumption+)
   124 done
   125 
   126 lemma FreeUltrafilterNat_finite: "finite x ==> x \<notin> FreeUltrafilterNat"
   127 apply (unfold FreeUltrafilterNat_def)
   128 apply (rule FreeUltrafilterNat_Ex [THEN exE])
   129 apply (rule someI2, assumption)
   130 apply (blast dest: mem_FreeUltrafiltersetD1)
   131 done
   132 
   133 lemma FreeUltrafilterNat_not_finite: "x \<in> FreeUltrafilterNat ==> ~ finite x"
   134 by (blast dest: FreeUltrafilterNat_finite)
   135 
   136 lemma FreeUltrafilterNat_empty [simp]: "{} \<notin> FreeUltrafilterNat"
   137 apply (unfold FreeUltrafilterNat_def)
   138 apply (rule FreeUltrafilterNat_Ex [THEN exE])
   139 apply (rule someI2, assumption)
   140 apply (blast dest: FreeUltrafilter_Ultrafilter Ultrafilter_Filter 
   141                    Filter_empty_not_mem)
   142 done
   143 
   144 lemma FreeUltrafilterNat_Int:
   145      "[| X \<in> FreeUltrafilterNat;  Y \<in> FreeUltrafilterNat |]   
   146       ==> X Int Y \<in> FreeUltrafilterNat"
   147 apply (insert FreeUltrafilterNat_mem)
   148 apply (blast dest: FreeUltrafilter_Ultrafilter Ultrafilter_Filter mem_FiltersetD1)
   149 done
   150 
   151 lemma FreeUltrafilterNat_subset:
   152      "[| X \<in> FreeUltrafilterNat;  X \<subseteq> Y |]  
   153       ==> Y \<in> FreeUltrafilterNat"
   154 apply (insert FreeUltrafilterNat_mem)
   155 apply (blast dest: FreeUltrafilter_Ultrafilter Ultrafilter_Filter mem_FiltersetD2)
   156 done
   157 
   158 lemma FreeUltrafilterNat_Compl:
   159      "X \<in> FreeUltrafilterNat ==> -X \<notin> FreeUltrafilterNat"
   160 proof
   161   assume "X \<in> \<U>" and "- X \<in> \<U>"
   162   hence "X Int - X \<in> \<U>" by (rule FreeUltrafilterNat_Int) 
   163   thus False by force
   164 qed
   165 
   166 lemma FreeUltrafilterNat_Compl_mem:
   167      "X\<notin> FreeUltrafilterNat ==> -X \<in> FreeUltrafilterNat"
   168 apply (cut_tac FreeUltrafilterNat_mem [THEN FreeUltrafilter_iff [THEN iffD1]])
   169 apply (safe, drule_tac x = X in bspec)
   170 apply (auto simp add: UNIV_diff_Compl)
   171 done
   172 
   173 lemma FreeUltrafilterNat_Compl_iff1:
   174      "(X \<notin> FreeUltrafilterNat) = (-X \<in> FreeUltrafilterNat)"
   175 by (blast dest: FreeUltrafilterNat_Compl FreeUltrafilterNat_Compl_mem)
   176 
   177 lemma FreeUltrafilterNat_Compl_iff2:
   178      "(X \<in> FreeUltrafilterNat) = (-X \<notin> FreeUltrafilterNat)"
   179 by (auto simp add: FreeUltrafilterNat_Compl_iff1 [symmetric])
   180 
   181 lemma cofinite_mem_FreeUltrafilterNat: "finite (-X) ==> X \<in> FreeUltrafilterNat"
   182 apply (drule FreeUltrafilterNat_finite)  
   183 apply (simp add: FreeUltrafilterNat_Compl_iff2 [symmetric])
   184 done
   185 
   186 lemma FreeUltrafilterNat_UNIV [simp]: "(UNIV::nat set) \<in> FreeUltrafilterNat"
   187 by (rule FreeUltrafilterNat_mem [THEN FreeUltrafilter_Ultrafilter, THEN Ultrafilter_Filter, THEN mem_FiltersetD4])
   188 
   189 lemma FreeUltrafilterNat_Nat_set [simp]: "UNIV \<in> FreeUltrafilterNat"
   190 by auto
   191 
   192 lemma FreeUltrafilterNat_Nat_set_refl [intro]:
   193      "{n. P(n) = P(n)} \<in> FreeUltrafilterNat"
   194 by simp
   195 
   196 lemma FreeUltrafilterNat_P: "{n::nat. P} \<in> FreeUltrafilterNat ==> P"
   197 by (rule ccontr, simp)
   198 
   199 lemma FreeUltrafilterNat_Ex_P: "{n. P(n)} \<in> FreeUltrafilterNat ==> \<exists>n. P(n)"
   200 by (rule ccontr, simp)
   201 
   202 lemma FreeUltrafilterNat_all: "\<forall>n. P(n) ==> {n. P(n)} \<in> FreeUltrafilterNat"
   203 by (auto intro: FreeUltrafilterNat_Nat_set)
   204 
   205 
   206 text{*Define and use Ultrafilter tactics*}
   207 use "fuf.ML"
   208 
   209 method_setup fuf = {*
   210     Method.ctxt_args (fn ctxt =>
   211         Method.METHOD (fn facts =>
   212             fuf_tac (local_clasimpset_of ctxt) 1)) *}
   213     "free ultrafilter tactic"
   214 
   215 method_setup ultra = {*
   216     Method.ctxt_args (fn ctxt =>
   217         Method.METHOD (fn facts =>
   218             ultra_tac (local_clasimpset_of ctxt) 1)) *}
   219     "ultrafilter tactic"
   220 
   221 
   222 text{*One further property of our free ultrafilter*}
   223 lemma FreeUltrafilterNat_Un:
   224      "X Un Y \<in> FreeUltrafilterNat  
   225       ==> X \<in> FreeUltrafilterNat | Y \<in> FreeUltrafilterNat"
   226 by (auto, ultra)
   227 
   228 
   229 subsection{*Properties of @{term hyprel}*}
   230 
   231 text{*Proving that @{term hyprel} is an equivalence relation*}
   232 
   233 lemma hyprel_iff: "((X,Y) \<in> hyprel) = ({n. X n = Y n} \<in> FreeUltrafilterNat)"
   234 by (simp add: hyprel_def)
   235 
   236 lemma hyprel_refl: "(x,x) \<in> hyprel"
   237 by (simp add: hyprel_def)
   238 
   239 lemma hyprel_sym [rule_format (no_asm)]: "(x,y) \<in> hyprel --> (y,x) \<in> hyprel"
   240 by (simp add: hyprel_def eq_commute)
   241 
   242 lemma hyprel_trans: 
   243       "[|(x,y) \<in> hyprel; (y,z) \<in> hyprel|] ==> (x,z) \<in> hyprel"
   244 by (simp add: hyprel_def, ultra)
   245 
   246 lemma equiv_hyprel: "equiv UNIV hyprel"
   247 apply (simp add: equiv_def refl_def sym_def trans_def hyprel_refl)
   248 apply (blast intro: hyprel_sym hyprel_trans) 
   249 done
   250 
   251 (* (hyprel `` {x} = hyprel `` {y}) = ((x,y) \<in> hyprel) *)
   252 lemmas equiv_hyprel_iff =
   253     eq_equiv_class_iff [OF equiv_hyprel UNIV_I UNIV_I, simp] 
   254 
   255 lemma hyprel_in_hypreal [simp]: "hyprel``{x}:hypreal"
   256 by (simp add: hypreal_def hyprel_def quotient_def, blast)
   257 
   258 lemma inj_on_Abs_hypreal: "inj_on Abs_hypreal hypreal"
   259 apply (rule inj_on_inverseI)
   260 apply (erule Abs_hypreal_inverse)
   261 done
   262 
   263 declare inj_on_Abs_hypreal [THEN inj_on_iff, simp] 
   264         Abs_hypreal_inverse [simp]
   265 
   266 declare equiv_hyprel [THEN eq_equiv_class_iff, simp]
   267 
   268 declare hyprel_iff [iff]
   269 
   270 lemmas eq_hyprelD = eq_equiv_class [OF _ equiv_hyprel]
   271 
   272 lemma inj_Rep_hypreal: "inj(Rep_hypreal)"
   273 apply (rule inj_on_inverseI)
   274 apply (rule Rep_hypreal_inverse)
   275 done
   276 
   277 lemma lemma_hyprel_refl [simp]: "x \<in> hyprel `` {x}"
   278 by (simp add: hyprel_def)
   279 
   280 lemma hypreal_empty_not_mem [simp]: "{} \<notin> hypreal"
   281 apply (simp add: hypreal_def)
   282 apply (auto elim!: quotientE equalityCE)
   283 done
   284 
   285 lemma Rep_hypreal_nonempty [simp]: "Rep_hypreal x \<noteq> {}"
   286 by (insert Rep_hypreal [of x], auto)
   287 
   288 
   289 subsection{*@{term hypreal_of_real}: 
   290             the Injection from @{typ real} to @{typ hypreal}*}
   291 
   292 lemma inj_hypreal_of_real: "inj(hypreal_of_real)"
   293 apply (rule inj_onI)
   294 apply (simp add: hypreal_of_real_def split: split_if_asm)
   295 done
   296 
   297 lemma eq_Abs_hypreal:
   298     "(!!x. z = Abs_hypreal(hyprel``{x}) ==> P) ==> P"
   299 apply (rule_tac x1=z in Rep_hypreal [unfolded hypreal_def, THEN quotientE])
   300 apply (drule_tac f = Abs_hypreal in arg_cong)
   301 apply (force simp add: Rep_hypreal_inverse)
   302 done
   303 
   304 theorem hypreal_cases [case_names Abs_hypreal, cases type: hypreal]:
   305     "(!!x. z = Abs_hypreal(hyprel``{x}) ==> P) ==> P"
   306 by (rule eq_Abs_hypreal [of z], blast)
   307 
   308 
   309 subsection{*Hyperreal Addition*}
   310 
   311 lemma hypreal_add_congruent2: 
   312     "congruent2 hyprel hyprel (%X Y. hyprel``{%n. X n + Y n})"
   313 by (simp add: congruent2_def, auto, ultra)
   314 
   315 lemma hypreal_add: 
   316   "Abs_hypreal(hyprel``{%n. X n}) + Abs_hypreal(hyprel``{%n. Y n}) =  
   317    Abs_hypreal(hyprel``{%n. X n + Y n})"
   318 by (simp add: hypreal_add_def 
   319          UN_equiv_class2 [OF equiv_hyprel equiv_hyprel hypreal_add_congruent2])
   320 
   321 lemma hypreal_add_commute: "(z::hypreal) + w = w + z"
   322 apply (cases z, cases w)
   323 apply (simp add: add_ac hypreal_add)
   324 done
   325 
   326 lemma hypreal_add_assoc: "((z1::hypreal) + z2) + z3 = z1 + (z2 + z3)"
   327 apply (cases z1, cases z2, cases z3)
   328 apply (simp add: hypreal_add real_add_assoc)
   329 done
   330 
   331 lemma hypreal_add_zero_left: "(0::hypreal) + z = z"
   332 by (cases z, simp add: hypreal_zero_def hypreal_add)
   333 
   334 instance hypreal :: comm_monoid_add
   335   by intro_classes
   336     (assumption | 
   337       rule hypreal_add_commute hypreal_add_assoc hypreal_add_zero_left)+
   338 
   339 lemma hypreal_add_zero_right [simp]: "z + (0::hypreal) = z"
   340 by (simp add: hypreal_add_zero_left hypreal_add_commute)
   341 
   342 
   343 subsection{*Additive inverse on @{typ hypreal}*}
   344 
   345 lemma hypreal_minus_congruent: 
   346   "congruent hyprel (%X. hyprel``{%n. - (X n)})"
   347 by (force simp add: congruent_def)
   348 
   349 lemma hypreal_minus: 
   350    "- (Abs_hypreal(hyprel``{%n. X n})) = Abs_hypreal(hyprel `` {%n. -(X n)})"
   351 by (simp add: hypreal_minus_def Abs_hypreal_inject 
   352               hyprel_in_hypreal [THEN Abs_hypreal_inverse] 
   353               UN_equiv_class [OF equiv_hyprel hypreal_minus_congruent])
   354 
   355 lemma hypreal_diff:
   356      "Abs_hypreal(hyprel``{%n. X n}) - Abs_hypreal(hyprel``{%n. Y n}) =  
   357       Abs_hypreal(hyprel``{%n. X n - Y n})"
   358 by (simp add: hypreal_diff_def hypreal_minus hypreal_add)
   359 
   360 lemma hypreal_add_minus [simp]: "z + -z = (0::hypreal)"
   361 by (cases z, simp add: hypreal_zero_def hypreal_minus hypreal_add)
   362 
   363 lemma hypreal_add_minus_left: "-z + z = (0::hypreal)"
   364 by (simp add: hypreal_add_commute hypreal_add_minus)
   365 
   366 
   367 subsection{*Hyperreal Multiplication*}
   368 
   369 lemma hypreal_mult_congruent2: 
   370     "congruent2 hyprel hyprel (%X Y. hyprel``{%n. X n * Y n})"
   371 by (simp add: congruent2_def, auto, ultra)
   372 
   373 lemma hypreal_mult: 
   374   "Abs_hypreal(hyprel``{%n. X n}) * Abs_hypreal(hyprel``{%n. Y n}) =  
   375    Abs_hypreal(hyprel``{%n. X n * Y n})"
   376 by (simp add: hypreal_mult_def
   377         UN_equiv_class2 [OF equiv_hyprel equiv_hyprel hypreal_mult_congruent2])
   378 
   379 lemma hypreal_mult_commute: "(z::hypreal) * w = w * z"
   380 by (cases z, cases w, simp add: hypreal_mult mult_ac)
   381 
   382 lemma hypreal_mult_assoc: "((z1::hypreal) * z2) * z3 = z1 * (z2 * z3)"
   383 by (cases z1, cases z2, cases z3, simp add: hypreal_mult mult_assoc)
   384 
   385 lemma hypreal_mult_1: "(1::hypreal) * z = z"
   386 by (cases z, simp add: hypreal_one_def hypreal_mult)
   387 
   388 lemma hypreal_add_mult_distrib:
   389      "((z1::hypreal) + z2) * w = (z1 * w) + (z2 * w)"
   390 by (cases z1, cases z2, cases w, simp add: hypreal_mult hypreal_add left_distrib)
   391 
   392 text{*one and zero are distinct*}
   393 lemma hypreal_zero_not_eq_one: "0 \<noteq> (1::hypreal)"
   394 by (simp add: hypreal_zero_def hypreal_one_def)
   395 
   396 
   397 subsection{*Multiplicative Inverse on @{typ hypreal} *}
   398 
   399 lemma hypreal_inverse_congruent: 
   400   "congruent hyprel (%X. hyprel``{%n. if X n = 0 then 0 else inverse(X n)})"
   401 by (auto simp add: congruent_def, ultra)
   402 
   403 lemma hypreal_inverse: 
   404       "inverse (Abs_hypreal(hyprel``{%n. X n})) =  
   405        Abs_hypreal(hyprel `` {%n. if X n = 0 then 0 else inverse(X n)})"
   406 by (simp add: hypreal_inverse_def Abs_hypreal_inject 
   407               hyprel_in_hypreal [THEN Abs_hypreal_inverse] 
   408               UN_equiv_class [OF equiv_hyprel hypreal_inverse_congruent])
   409 
   410 lemma hypreal_mult_inverse: 
   411      "x \<noteq> 0 ==> x*inverse(x) = (1::hypreal)"
   412 apply (cases x)
   413 apply (simp add: hypreal_one_def hypreal_zero_def hypreal_inverse hypreal_mult)
   414 apply (drule FreeUltrafilterNat_Compl_mem)
   415 apply (blast intro!: right_inverse FreeUltrafilterNat_subset)
   416 done
   417 
   418 lemma hypreal_mult_inverse_left:
   419      "x \<noteq> 0 ==> inverse(x)*x = (1::hypreal)"
   420 by (simp add: hypreal_mult_inverse hypreal_mult_commute)
   421 
   422 instance hypreal :: field
   423 proof
   424   fix x y z :: hypreal
   425   show "- x + x = 0" by (simp add: hypreal_add_minus_left)
   426   show "x - y = x + (-y)" by (simp add: hypreal_diff_def)
   427   show "(x * y) * z = x * (y * z)" by (rule hypreal_mult_assoc)
   428   show "x * y = y * x" by (rule hypreal_mult_commute)
   429   show "1 * x = x" by (simp add: hypreal_mult_1)
   430   show "(x + y) * z = x * z + y * z" by (simp add: hypreal_add_mult_distrib)
   431   show "0 \<noteq> (1::hypreal)" by (rule hypreal_zero_not_eq_one)
   432   show "x \<noteq> 0 ==> inverse x * x = 1" by (simp add: hypreal_mult_inverse_left)
   433   show "x / y = x * inverse y" by (simp add: hypreal_divide_def)
   434 qed
   435 
   436 
   437 instance hypreal :: division_by_zero
   438 proof
   439   show "inverse 0 = (0::hypreal)" 
   440     by (simp add: hypreal_inverse hypreal_zero_def)
   441 qed
   442 
   443 
   444 subsection{*Properties of The @{text "\<le>"} Relation*}
   445 
   446 lemma hypreal_le: 
   447       "(Abs_hypreal(hyprel``{%n. X n}) \<le> Abs_hypreal(hyprel``{%n. Y n})) =  
   448        ({n. X n \<le> Y n} \<in> FreeUltrafilterNat)"
   449 apply (simp add: hypreal_le_def)
   450 apply (auto intro!: lemma_hyprel_refl, ultra)
   451 done
   452 
   453 lemma hypreal_le_refl: "w \<le> (w::hypreal)"
   454 by (cases w, simp add: hypreal_le)
   455 
   456 lemma hypreal_le_trans: "[| i \<le> j; j \<le> k |] ==> i \<le> (k::hypreal)"
   457 by (cases i, cases j, cases k, simp add: hypreal_le, ultra)
   458 
   459 lemma hypreal_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::hypreal)"
   460 by (cases z, cases w, simp add: hypreal_le, ultra)
   461 
   462 (* Axiom 'order_less_le' of class 'order': *)
   463 lemma hypreal_less_le: "((w::hypreal) < z) = (w \<le> z & w \<noteq> z)"
   464 by (simp add: hypreal_less_def)
   465 
   466 instance hypreal :: order
   467   by intro_classes
   468     (assumption |
   469       rule hypreal_le_refl hypreal_le_trans hypreal_le_anti_sym hypreal_less_le)+
   470 
   471 
   472 (* Axiom 'linorder_linear' of class 'linorder': *)
   473 lemma hypreal_le_linear: "(z::hypreal) \<le> w | w \<le> z"
   474 apply (cases z, cases w)
   475 apply (auto simp add: hypreal_le, ultra)
   476 done
   477 
   478 instance hypreal :: linorder 
   479   by intro_classes (rule hypreal_le_linear)
   480 
   481 lemma hypreal_not_refl2: "!!(x::hypreal). x < y ==> x \<noteq> y"
   482 by (auto simp add: order_less_irrefl)
   483 
   484 lemma hypreal_add_left_mono: "x \<le> y ==> z + x \<le> z + (y::hypreal)"
   485 apply (cases x, cases y, cases z)
   486 apply (auto simp add: hypreal_le hypreal_add) 
   487 done
   488 
   489 lemma hypreal_mult_less_mono2: "[| (0::hypreal)<z; x<y |] ==> z*x<z*y"
   490 apply (cases x, cases y, cases z)
   491 apply (auto simp add: hypreal_zero_def hypreal_le hypreal_mult 
   492                       linorder_not_le [symmetric], ultra) 
   493 done
   494 
   495 
   496 subsection{*The Hyperreals Form an Ordered Field*}
   497 
   498 instance hypreal :: ordered_field
   499 proof
   500   fix x y z :: hypreal
   501   show "x \<le> y ==> z + x \<le> z + y" 
   502     by (rule hypreal_add_left_mono)
   503   show "x < y ==> 0 < z ==> z * x < z * y" 
   504     by (simp add: hypreal_mult_less_mono2)
   505   show "\<bar>x\<bar> = (if x < 0 then -x else x)"
   506     by (auto dest: order_le_less_trans simp add: hrabs_def linorder_not_le)
   507 qed
   508 
   509 lemma hypreal_eq_minus_iff: "((x::hypreal) = y) = (x + - y = 0)"
   510 apply auto
   511 apply (rule OrderedGroup.add_right_cancel [of _ "-y", THEN iffD1], auto)
   512 done
   513 
   514 lemma hypreal_mult_left_cancel: "(c::hypreal) \<noteq> 0 ==> (c*a=c*b) = (a=b)"
   515 by auto
   516     
   517 lemma hypreal_mult_right_cancel: "(c::hypreal) \<noteq> 0 ==> (a*c=b*c) = (a=b)"
   518 by auto
   519 
   520 
   521 subsection{*The Embedding @{term hypreal_of_real} Preserves Field and 
   522       Order Properties*}
   523 
   524 lemma hypreal_of_real_add [simp]: 
   525      "hypreal_of_real (w + z) = hypreal_of_real w + hypreal_of_real z"
   526 by (simp add: hypreal_of_real_def, simp add: hypreal_add left_distrib)
   527 
   528 lemma hypreal_of_real_minus [simp]:
   529      "hypreal_of_real (-r) = - hypreal_of_real  r"
   530 by (auto simp add: hypreal_of_real_def hypreal_minus)
   531 
   532 lemma hypreal_of_real_diff [simp]: 
   533      "hypreal_of_real (w - z) = hypreal_of_real w - hypreal_of_real z"
   534 by (simp add: diff_minus) 
   535 
   536 lemma hypreal_of_real_mult [simp]: 
   537      "hypreal_of_real (w * z) = hypreal_of_real w * hypreal_of_real z"
   538 by (simp add: hypreal_of_real_def, simp add: hypreal_mult right_distrib)
   539 
   540 lemma hypreal_of_real_one [simp]: "hypreal_of_real 1 = (1::hypreal)"
   541 by (simp add: hypreal_of_real_def hypreal_one_def)
   542 
   543 lemma hypreal_of_real_zero [simp]: "hypreal_of_real 0 = 0"
   544 by (simp add: hypreal_of_real_def hypreal_zero_def)
   545 
   546 lemma hypreal_of_real_le_iff [simp]: 
   547      "(hypreal_of_real w \<le> hypreal_of_real z) = (w \<le> z)"
   548 apply (simp add: hypreal_le_def hypreal_of_real_def, auto)
   549 apply (rule_tac [2] x = "%n. w" in exI, safe)
   550 apply (rule_tac [3] x = "%n. z" in exI, auto)
   551 apply (rule FreeUltrafilterNat_P, ultra)
   552 done
   553 
   554 lemma hypreal_of_real_less_iff [simp]: 
   555      "(hypreal_of_real w < hypreal_of_real z) = (w < z)"
   556 by (simp add: linorder_not_le [symmetric]) 
   557 
   558 lemma hypreal_of_real_eq_iff [simp]:
   559      "(hypreal_of_real w = hypreal_of_real z) = (w = z)"
   560 by (force intro: order_antisym hypreal_of_real_le_iff [THEN iffD1])
   561 
   562 text{*As above, for 0*}
   563 
   564 declare hypreal_of_real_less_iff [of 0, simplified, simp]
   565 declare hypreal_of_real_le_iff   [of 0, simplified, simp]
   566 declare hypreal_of_real_eq_iff   [of 0, simplified, simp]
   567 
   568 declare hypreal_of_real_less_iff [of _ 0, simplified, simp]
   569 declare hypreal_of_real_le_iff   [of _ 0, simplified, simp]
   570 declare hypreal_of_real_eq_iff   [of _ 0, simplified, simp]
   571 
   572 text{*As above, for 1*}
   573 
   574 declare hypreal_of_real_less_iff [of 1, simplified, simp]
   575 declare hypreal_of_real_le_iff   [of 1, simplified, simp]
   576 declare hypreal_of_real_eq_iff   [of 1, simplified, simp]
   577 
   578 declare hypreal_of_real_less_iff [of _ 1, simplified, simp]
   579 declare hypreal_of_real_le_iff   [of _ 1, simplified, simp]
   580 declare hypreal_of_real_eq_iff   [of _ 1, simplified, simp]
   581 
   582 lemma hypreal_of_real_inverse [simp]:
   583      "hypreal_of_real (inverse r) = inverse (hypreal_of_real r)"
   584 apply (case_tac "r=0", simp)
   585 apply (rule_tac c1 = "hypreal_of_real r" in hypreal_mult_left_cancel [THEN iffD1])
   586 apply (auto simp add: hypreal_of_real_mult [symmetric])
   587 done
   588 
   589 lemma hypreal_of_real_divide [simp]:
   590      "hypreal_of_real (w / z) = hypreal_of_real w / hypreal_of_real z"
   591 by (simp add: hypreal_divide_def real_divide_def)
   592 
   593 lemma hypreal_of_real_of_nat [simp]: "hypreal_of_real (of_nat n) = of_nat n"
   594 by (induct n, simp_all) 
   595 
   596 lemma hypreal_of_real_of_int [simp]:  "hypreal_of_real (of_int z) = of_int z"
   597 proof (cases z)
   598   case (1 n)
   599     thus ?thesis  by simp
   600 next
   601   case (2 n)
   602     thus ?thesis
   603       by (simp only: of_int_minus hypreal_of_real_minus, simp)
   604 qed
   605 
   606 
   607 subsection{*Misc Others*}
   608 
   609 lemma hypreal_less: 
   610       "(Abs_hypreal(hyprel``{%n. X n}) < Abs_hypreal(hyprel``{%n. Y n})) =  
   611        ({n. X n < Y n} \<in> FreeUltrafilterNat)"
   612 by (auto simp add: hypreal_le linorder_not_le [symmetric], ultra+)
   613 
   614 lemma hypreal_zero_num: "0 = Abs_hypreal (hyprel `` {%n. 0})"
   615 by (simp add: hypreal_zero_def [THEN meta_eq_to_obj_eq, symmetric])
   616 
   617 lemma hypreal_one_num: "1 = Abs_hypreal (hyprel `` {%n. 1})"
   618 by (simp add: hypreal_one_def [THEN meta_eq_to_obj_eq, symmetric])
   619 
   620 lemma hypreal_omega_gt_zero [simp]: "0 < omega"
   621 by (auto simp add: omega_def hypreal_less hypreal_zero_num)
   622 
   623 lemma hypreal_hrabs:
   624      "abs (Abs_hypreal (hyprel `` {X})) = 
   625       Abs_hypreal(hyprel `` {%n. abs (X n)})"
   626 apply (auto simp add: hrabs_def hypreal_zero_def hypreal_le hypreal_minus)
   627 apply (ultra, arith)+
   628 done
   629 
   630 
   631 
   632 lemma hypreal_add_zero_less_le_mono: "[|r < x; (0::hypreal) \<le> y|] ==> r < x+y"
   633 by (auto dest: add_less_le_mono)
   634 
   635 text{*The precondition could be weakened to @{term "0\<le>x"}*}
   636 lemma hypreal_mult_less_mono:
   637      "[| u<v;  x<y;  (0::hypreal) < v;  0 < x |] ==> u*x < v* y"
   638  by (simp add: Ring_and_Field.mult_strict_mono order_less_imp_le)
   639 
   640 
   641 subsection{*Existence of Infinite Hyperreal Number*}
   642 
   643 lemma Rep_hypreal_omega: "Rep_hypreal(omega) \<in> hypreal"
   644 by (simp add: omega_def)
   645 
   646 text{*Existence of infinite number not corresponding to any real number.
   647 Use assumption that member @{term FreeUltrafilterNat} is not finite.*}
   648 
   649 
   650 text{*A few lemmas first*}
   651 
   652 lemma lemma_omega_empty_singleton_disj: "{n::nat. x = real n} = {} |  
   653       (\<exists>y. {n::nat. x = real n} = {y})"
   654 by force
   655 
   656 lemma lemma_finite_omega_set: "finite {n::nat. x = real n}"
   657 by (cut_tac x = x in lemma_omega_empty_singleton_disj, auto)
   658 
   659 lemma not_ex_hypreal_of_real_eq_omega: 
   660       "~ (\<exists>x. hypreal_of_real x = omega)"
   661 apply (simp add: omega_def hypreal_of_real_def)
   662 apply (auto simp add: real_of_nat_Suc diff_eq_eq [symmetric] 
   663             lemma_finite_omega_set [THEN FreeUltrafilterNat_finite])
   664 done
   665 
   666 lemma hypreal_of_real_not_eq_omega: "hypreal_of_real x \<noteq> omega"
   667 by (insert not_ex_hypreal_of_real_eq_omega, auto)
   668 
   669 text{*Existence of infinitesimal number also not corresponding to any
   670  real number*}
   671 
   672 lemma lemma_epsilon_empty_singleton_disj:
   673      "{n::nat. x = inverse(real(Suc n))} = {} |  
   674       (\<exists>y. {n::nat. x = inverse(real(Suc n))} = {y})"
   675 by auto
   676 
   677 lemma lemma_finite_epsilon_set: "finite {n. x = inverse(real(Suc n))}"
   678 by (cut_tac x = x in lemma_epsilon_empty_singleton_disj, auto)
   679 
   680 lemma not_ex_hypreal_of_real_eq_epsilon: "~ (\<exists>x. hypreal_of_real x = epsilon)"
   681 by (auto simp add: epsilon_def hypreal_of_real_def 
   682                    lemma_finite_epsilon_set [THEN FreeUltrafilterNat_finite])
   683 
   684 lemma hypreal_of_real_not_eq_epsilon: "hypreal_of_real x \<noteq> epsilon"
   685 by (insert not_ex_hypreal_of_real_eq_epsilon, auto)
   686 
   687 lemma hypreal_epsilon_not_zero: "epsilon \<noteq> 0"
   688 by (simp add: epsilon_def hypreal_zero_def)
   689 
   690 lemma hypreal_epsilon_inverse_omega: "epsilon = inverse(omega)"
   691 by (simp add: hypreal_inverse omega_def epsilon_def)
   692 
   693 
   694 ML
   695 {*
   696 val hrabs_def = thm "hrabs_def";
   697 val hypreal_hrabs = thm "hypreal_hrabs";
   698 
   699 val hypreal_zero_def = thm "hypreal_zero_def";
   700 val hypreal_one_def = thm "hypreal_one_def";
   701 val hypreal_minus_def = thm "hypreal_minus_def";
   702 val hypreal_diff_def = thm "hypreal_diff_def";
   703 val hypreal_inverse_def = thm "hypreal_inverse_def";
   704 val hypreal_divide_def = thm "hypreal_divide_def";
   705 val hypreal_of_real_def = thm "hypreal_of_real_def";
   706 val omega_def = thm "omega_def";
   707 val epsilon_def = thm "epsilon_def";
   708 val hypreal_add_def = thm "hypreal_add_def";
   709 val hypreal_mult_def = thm "hypreal_mult_def";
   710 val hypreal_less_def = thm "hypreal_less_def";
   711 val hypreal_le_def = thm "hypreal_le_def";
   712 
   713 val finite_exhausts = thm "finite_exhausts";
   714 val finite_not_covers = thm "finite_not_covers";
   715 val not_finite_nat = thm "not_finite_nat";
   716 val FreeUltrafilterNat_Ex = thm "FreeUltrafilterNat_Ex";
   717 val FreeUltrafilterNat_mem = thm "FreeUltrafilterNat_mem";
   718 val FreeUltrafilterNat_finite = thm "FreeUltrafilterNat_finite";
   719 val FreeUltrafilterNat_not_finite = thm "FreeUltrafilterNat_not_finite";
   720 val FreeUltrafilterNat_empty = thm "FreeUltrafilterNat_empty";
   721 val FreeUltrafilterNat_Int = thm "FreeUltrafilterNat_Int";
   722 val FreeUltrafilterNat_subset = thm "FreeUltrafilterNat_subset";
   723 val FreeUltrafilterNat_Compl = thm "FreeUltrafilterNat_Compl";
   724 val FreeUltrafilterNat_Compl_mem = thm "FreeUltrafilterNat_Compl_mem";
   725 val FreeUltrafilterNat_Compl_iff1 = thm "FreeUltrafilterNat_Compl_iff1";
   726 val FreeUltrafilterNat_Compl_iff2 = thm "FreeUltrafilterNat_Compl_iff2";
   727 val FreeUltrafilterNat_UNIV = thm "FreeUltrafilterNat_UNIV";
   728 val FreeUltrafilterNat_Nat_set = thm "FreeUltrafilterNat_Nat_set";
   729 val FreeUltrafilterNat_Nat_set_refl = thm "FreeUltrafilterNat_Nat_set_refl";
   730 val FreeUltrafilterNat_P = thm "FreeUltrafilterNat_P";
   731 val FreeUltrafilterNat_Ex_P = thm "FreeUltrafilterNat_Ex_P";
   732 val FreeUltrafilterNat_all = thm "FreeUltrafilterNat_all";
   733 val FreeUltrafilterNat_Un = thm "FreeUltrafilterNat_Un";
   734 val hyprel_iff = thm "hyprel_iff";
   735 val hyprel_in_hypreal = thm "hyprel_in_hypreal";
   736 val Abs_hypreal_inverse = thm "Abs_hypreal_inverse";
   737 val inj_on_Abs_hypreal = thm "inj_on_Abs_hypreal";
   738 val inj_Rep_hypreal = thm "inj_Rep_hypreal";
   739 val lemma_hyprel_refl = thm "lemma_hyprel_refl";
   740 val hypreal_empty_not_mem = thm "hypreal_empty_not_mem";
   741 val Rep_hypreal_nonempty = thm "Rep_hypreal_nonempty";
   742 val inj_hypreal_of_real = thm "inj_hypreal_of_real";
   743 val eq_Abs_hypreal = thm "eq_Abs_hypreal";
   744 val hypreal_minus_congruent = thm "hypreal_minus_congruent";
   745 val hypreal_minus = thm "hypreal_minus";
   746 val hypreal_add = thm "hypreal_add";
   747 val hypreal_diff = thm "hypreal_diff";
   748 val hypreal_add_commute = thm "hypreal_add_commute";
   749 val hypreal_add_assoc = thm "hypreal_add_assoc";
   750 val hypreal_add_zero_left = thm "hypreal_add_zero_left";
   751 val hypreal_add_zero_right = thm "hypreal_add_zero_right";
   752 val hypreal_add_minus = thm "hypreal_add_minus";
   753 val hypreal_add_minus_left = thm "hypreal_add_minus_left";
   754 val hypreal_mult = thm "hypreal_mult";
   755 val hypreal_mult_commute = thm "hypreal_mult_commute";
   756 val hypreal_mult_assoc = thm "hypreal_mult_assoc";
   757 val hypreal_mult_1 = thm "hypreal_mult_1";
   758 val hypreal_zero_not_eq_one = thm "hypreal_zero_not_eq_one";
   759 val hypreal_inverse_congruent = thm "hypreal_inverse_congruent";
   760 val hypreal_inverse = thm "hypreal_inverse";
   761 val hypreal_mult_inverse = thm "hypreal_mult_inverse";
   762 val hypreal_mult_inverse_left = thm "hypreal_mult_inverse_left";
   763 val hypreal_mult_left_cancel = thm "hypreal_mult_left_cancel";
   764 val hypreal_mult_right_cancel = thm "hypreal_mult_right_cancel";
   765 val hypreal_not_refl2 = thm "hypreal_not_refl2";
   766 val hypreal_less = thm "hypreal_less";
   767 val hypreal_eq_minus_iff = thm "hypreal_eq_minus_iff";
   768 val hypreal_le = thm "hypreal_le";
   769 val hypreal_le_refl = thm "hypreal_le_refl";
   770 val hypreal_le_linear = thm "hypreal_le_linear";
   771 val hypreal_le_trans = thm "hypreal_le_trans";
   772 val hypreal_le_anti_sym = thm "hypreal_le_anti_sym";
   773 val hypreal_less_le = thm "hypreal_less_le";
   774 val hypreal_of_real_add = thm "hypreal_of_real_add";
   775 val hypreal_of_real_mult = thm "hypreal_of_real_mult";
   776 val hypreal_of_real_less_iff = thm "hypreal_of_real_less_iff";
   777 val hypreal_of_real_le_iff = thm "hypreal_of_real_le_iff";
   778 val hypreal_of_real_eq_iff = thm "hypreal_of_real_eq_iff";
   779 val hypreal_of_real_minus = thm "hypreal_of_real_minus";
   780 val hypreal_of_real_one = thm "hypreal_of_real_one";
   781 val hypreal_of_real_zero = thm "hypreal_of_real_zero";
   782 val hypreal_of_real_inverse = thm "hypreal_of_real_inverse";
   783 val hypreal_of_real_divide = thm "hypreal_of_real_divide";
   784 val hypreal_zero_num = thm "hypreal_zero_num";
   785 val hypreal_one_num = thm "hypreal_one_num";
   786 val hypreal_omega_gt_zero = thm "hypreal_omega_gt_zero";
   787 
   788 val hypreal_add_zero_less_le_mono = thm"hypreal_add_zero_less_le_mono";
   789 val Rep_hypreal_omega = thm"Rep_hypreal_omega";
   790 val lemma_omega_empty_singleton_disj = thm"lemma_omega_empty_singleton_disj";
   791 val lemma_finite_omega_set = thm"lemma_finite_omega_set";
   792 val not_ex_hypreal_of_real_eq_omega = thm"not_ex_hypreal_of_real_eq_omega";
   793 val hypreal_of_real_not_eq_omega = thm"hypreal_of_real_not_eq_omega";
   794 val not_ex_hypreal_of_real_eq_epsilon = thm"not_ex_hypreal_of_real_eq_epsilon";
   795 val hypreal_of_real_not_eq_epsilon = thm"hypreal_of_real_not_eq_epsilon";
   796 val hypreal_epsilon_not_zero = thm"hypreal_epsilon_not_zero";
   797 val hypreal_epsilon_inverse_omega = thm"hypreal_epsilon_inverse_omega";
   798 *}
   799 
   800 end