src/HOL/Hyperreal/HyperDef.thy
author wenzelm
Fri Nov 17 02:20:03 2006 +0100 (2006-11-17)
changeset 21404 eb85850d3eb7
parent 21210 c17fd2df4e9e
child 21588 cd0dc678a205
permissions -rw-r--r--
more robust syntax for definition/abbreviation/notation;
     1 (*  Title       : HOL/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 StarClasses "../Real/Real"
    12 uses ("fuf.ML")  (*Warning: file fuf.ML refers to the name Hyperdef!*)
    13 begin
    14 
    15 types hypreal = "real star"
    16 
    17 abbreviation
    18   hypreal_of_real :: "real => real star" where
    19   "hypreal_of_real == star_of"
    20 
    21 definition
    22   omega :: hypreal where   -- {*an infinite number @{text "= [<1,2,3,...>]"} *}
    23   "omega = star_n (%n. real (Suc n))"
    24 
    25 definition
    26   epsilon :: hypreal where   -- {*an infinitesimal number @{text "= [<1,1/2,1/3,...>]"} *}
    27   "epsilon = star_n (%n. inverse (real (Suc n)))"
    28 
    29 notation (xsymbols)
    30   omega  ("\<omega>") and
    31   epsilon  ("\<epsilon>")
    32 
    33 notation (HTML output)
    34   omega  ("\<omega>") and
    35   epsilon  ("\<epsilon>")
    36 
    37 
    38 subsection {* Real vector class instances *}
    39 
    40 instance star :: (scaleR) scaleR ..
    41 
    42 defs (overloaded)
    43   star_scaleR_def [transfer_unfold]: "scaleR r \<equiv> *f* (scaleR r)"
    44 
    45 lemma Standard_scaleR [simp]: "x \<in> Standard \<Longrightarrow> r *# x \<in> Standard"
    46 by (simp add: star_scaleR_def)
    47 
    48 lemma star_of_scaleR [simp]: "star_of (r *# x) = r *# star_of x"
    49 by transfer (rule refl)
    50 
    51 instance star :: (real_vector) real_vector
    52 proof
    53   fix a b :: real
    54   show "\<And>x y::'a star. a *# (x + y) = a *# x + a *# y"
    55     by transfer (rule scaleR_right_distrib)
    56   show "\<And>x::'a star. (a + b) *# x = a *# x + b *# x"
    57     by transfer (rule scaleR_left_distrib)
    58   show "\<And>x::'a star. a *# b *# x = (a * b) *# x"
    59     by transfer (rule scaleR_scaleR)
    60   show "\<And>x::'a star. 1 *# x = x"
    61     by transfer (rule scaleR_one)
    62 qed
    63 
    64 instance star :: (real_algebra) real_algebra
    65 proof
    66   fix a :: real
    67   show "\<And>x y::'a star. a *# x * y = a *# (x * y)"
    68     by transfer (rule mult_scaleR_left)
    69   show "\<And>x y::'a star. x * a *# y = a *# (x * y)"
    70     by transfer (rule mult_scaleR_right)
    71 qed
    72 
    73 instance star :: (real_algebra_1) real_algebra_1 ..
    74 
    75 instance star :: (real_div_algebra) real_div_algebra ..
    76 
    77 instance star :: (real_field) real_field ..
    78 
    79 lemma star_of_real_def [transfer_unfold]: "of_real r = star_of (of_real r)"
    80 by (unfold of_real_def, transfer, rule refl)
    81 
    82 lemma Standard_of_real [simp]: "of_real r \<in> Standard"
    83 by (simp add: star_of_real_def)
    84 
    85 lemma star_of_of_real [simp]: "star_of (of_real r) = of_real r"
    86 by transfer (rule refl)
    87 
    88 lemma of_real_eq_star_of [simp]: "of_real = star_of"
    89 proof
    90   fix r :: real
    91   show "of_real r = star_of r"
    92     by transfer simp
    93 qed
    94 
    95 lemma Reals_eq_Standard: "(Reals :: hypreal set) = Standard"
    96 by (simp add: Reals_def Standard_def)
    97 
    98 
    99 subsection{*Existence of Free Ultrafilter over the Naturals*}
   100 
   101 text{*Also, proof of various properties of @{term FreeUltrafilterNat}: 
   102 an arbitrary free ultrafilter*}
   103 
   104 lemma FreeUltrafilterNat_Ex: "\<exists>U::nat set set. freeultrafilter U"
   105 by (rule nat_infinite [THEN freeultrafilter_Ex])
   106 
   107 lemma FreeUltrafilterNat_mem: "freeultrafilter FreeUltrafilterNat"
   108 apply (unfold FreeUltrafilterNat_def)
   109 apply (rule someI_ex)
   110 apply (rule FreeUltrafilterNat_Ex)
   111 done
   112 
   113 lemma UltrafilterNat_mem: "ultrafilter FreeUltrafilterNat"
   114 by (rule FreeUltrafilterNat_mem [THEN freeultrafilter.ultrafilter])
   115 
   116 lemma FilterNat_mem: "filter FreeUltrafilterNat"
   117 by (rule FreeUltrafilterNat_mem [THEN freeultrafilter.filter])
   118 
   119 lemma FreeUltrafilterNat_finite: "finite x ==> x \<notin> FreeUltrafilterNat"
   120 by (rule FreeUltrafilterNat_mem [THEN freeultrafilter.finite])
   121 
   122 lemma FreeUltrafilterNat_not_finite: "x \<in> FreeUltrafilterNat ==> ~ finite x"
   123 thm FreeUltrafilterNat_mem
   124 thm freeultrafilter.infinite
   125 thm FreeUltrafilterNat_mem [THEN freeultrafilter.infinite]
   126 by (rule FreeUltrafilterNat_mem [THEN freeultrafilter.infinite])
   127 
   128 lemma FreeUltrafilterNat_empty [simp]: "{} \<notin> FreeUltrafilterNat"
   129 by (rule FilterNat_mem [THEN filter.empty])
   130 
   131 lemma FreeUltrafilterNat_Int:
   132      "[| X \<in> FreeUltrafilterNat;  Y \<in> FreeUltrafilterNat |]   
   133       ==> X Int Y \<in> FreeUltrafilterNat"
   134 by (rule FilterNat_mem [THEN filter.Int])
   135 
   136 lemma FreeUltrafilterNat_subset:
   137      "[| X \<in> FreeUltrafilterNat;  X \<subseteq> Y |]  
   138       ==> Y \<in> FreeUltrafilterNat"
   139 by (rule FilterNat_mem [THEN filter.subset])
   140 
   141 lemma FreeUltrafilterNat_Compl:
   142      "X \<in> FreeUltrafilterNat ==> -X \<notin> FreeUltrafilterNat"
   143 apply (erule contrapos_pn)
   144 apply (erule UltrafilterNat_mem [THEN ultrafilter.not_mem_iff, THEN iffD2])
   145 done
   146 
   147 lemma FreeUltrafilterNat_Compl_mem:
   148      "X\<notin> FreeUltrafilterNat ==> -X \<in> FreeUltrafilterNat"
   149 by (rule UltrafilterNat_mem [THEN ultrafilter.not_mem_iff, THEN iffD1])
   150 
   151 lemma FreeUltrafilterNat_Compl_iff1:
   152      "(X \<notin> FreeUltrafilterNat) = (-X \<in> FreeUltrafilterNat)"
   153 by (rule UltrafilterNat_mem [THEN ultrafilter.not_mem_iff])
   154 
   155 lemma FreeUltrafilterNat_Compl_iff2:
   156      "(X \<in> FreeUltrafilterNat) = (-X \<notin> FreeUltrafilterNat)"
   157 by (auto simp add: FreeUltrafilterNat_Compl_iff1 [symmetric])
   158 
   159 lemma cofinite_mem_FreeUltrafilterNat: "finite (-X) ==> X \<in> FreeUltrafilterNat"
   160 apply (drule FreeUltrafilterNat_finite)  
   161 apply (simp add: FreeUltrafilterNat_Compl_iff2 [symmetric])
   162 done
   163 
   164 lemma FreeUltrafilterNat_UNIV [iff]: "UNIV \<in> FreeUltrafilterNat"
   165 by (rule FilterNat_mem [THEN filter.UNIV])
   166 
   167 lemma FreeUltrafilterNat_Nat_set_refl [intro]:
   168      "{n. P(n) = P(n)} \<in> FreeUltrafilterNat"
   169 by simp
   170 
   171 lemma FreeUltrafilterNat_P: "{n::nat. P} \<in> FreeUltrafilterNat ==> P"
   172 by (rule ccontr, simp)
   173 
   174 lemma FreeUltrafilterNat_Ex_P: "{n. P(n)} \<in> FreeUltrafilterNat ==> \<exists>n. P(n)"
   175 by (rule ccontr, simp)
   176 
   177 lemma FreeUltrafilterNat_all: "\<forall>n. P(n) ==> {n. P(n)} \<in> FreeUltrafilterNat"
   178 by (auto)
   179 
   180 
   181 text{*Define and use Ultrafilter tactics*}
   182 use "fuf.ML"
   183 
   184 method_setup fuf = {*
   185     Method.ctxt_args (fn ctxt =>
   186         Method.METHOD (fn facts =>
   187             fuf_tac (local_clasimpset_of ctxt) 1)) *}
   188     "free ultrafilter tactic"
   189 
   190 method_setup ultra = {*
   191     Method.ctxt_args (fn ctxt =>
   192         Method.METHOD (fn facts =>
   193             ultra_tac (local_clasimpset_of ctxt) 1)) *}
   194     "ultrafilter tactic"
   195 
   196 
   197 text{*One further property of our free ultrafilter*}
   198 lemma FreeUltrafilterNat_Un:
   199      "X Un Y \<in> FreeUltrafilterNat  
   200       ==> X \<in> FreeUltrafilterNat | Y \<in> FreeUltrafilterNat"
   201 by (auto, ultra)
   202 
   203 
   204 subsection{*Properties of @{term starrel}*}
   205 
   206 text{*Proving that @{term starrel} is an equivalence relation*}
   207 
   208 lemma starrel_iff: "((X,Y) \<in> starrel) = ({n. X n = Y n} \<in> FreeUltrafilterNat)"
   209 by (rule StarDef.starrel_iff)
   210 
   211 lemma starrel_refl: "(x,x) \<in> starrel"
   212 by (simp add: starrel_def)
   213 
   214 lemma starrel_sym [rule_format (no_asm)]: "(x,y) \<in> starrel --> (y,x) \<in> starrel"
   215 by (simp add: starrel_def eq_commute)
   216 
   217 lemma starrel_trans: 
   218       "[|(x,y) \<in> starrel; (y,z) \<in> starrel|] ==> (x,z) \<in> starrel"
   219 by (simp add: starrel_def, ultra)
   220 
   221 lemma equiv_starrel: "equiv UNIV starrel"
   222 by (rule StarDef.equiv_starrel)
   223 
   224 (* (starrel `` {x} = starrel `` {y}) = ((x,y) \<in> starrel) *)
   225 lemmas equiv_starrel_iff =
   226     eq_equiv_class_iff [OF equiv_starrel UNIV_I UNIV_I, simp] 
   227 
   228 lemma starrel_in_hypreal [simp]: "starrel``{x}:star"
   229 by (simp add: star_def starrel_def quotient_def, blast)
   230 
   231 declare Abs_star_inject [simp] Abs_star_inverse [simp]
   232 declare equiv_starrel [THEN eq_equiv_class_iff, simp]
   233 
   234 lemmas eq_starrelD = eq_equiv_class [OF _ equiv_starrel]
   235 
   236 lemma lemma_starrel_refl [simp]: "x \<in> starrel `` {x}"
   237 by (simp add: starrel_def)
   238 
   239 lemma hypreal_empty_not_mem [simp]: "{} \<notin> star"
   240 apply (simp add: star_def)
   241 apply (auto elim!: quotientE equalityCE)
   242 done
   243 
   244 lemma Rep_hypreal_nonempty [simp]: "Rep_star x \<noteq> {}"
   245 by (insert Rep_star [of x], auto)
   246 
   247 subsection{*@{term hypreal_of_real}: 
   248             the Injection from @{typ real} to @{typ hypreal}*}
   249 
   250 lemma inj_hypreal_of_real: "inj(hypreal_of_real)"
   251 by (rule inj_onI, simp)
   252 
   253 lemma mem_Rep_star_iff: "(X \<in> Rep_star x) = (x = star_n X)"
   254 by (cases x, simp add: star_n_def)
   255 
   256 lemma Rep_star_star_n_iff [simp]:
   257   "(X \<in> Rep_star (star_n Y)) = ({n. Y n = X n} \<in> \<U>)"
   258 by (simp add: star_n_def)
   259 
   260 lemma Rep_star_star_n: "X \<in> Rep_star (star_n X)"
   261 by simp
   262 
   263 subsection{* Properties of @{term star_n} *}
   264 
   265 lemma star_n_add:
   266   "star_n X + star_n Y = star_n (%n. X n + Y n)"
   267 by (simp only: star_add_def starfun2_star_n)
   268 
   269 lemma star_n_minus:
   270    "- star_n X = star_n (%n. -(X n))"
   271 by (simp only: star_minus_def starfun_star_n)
   272 
   273 lemma star_n_diff:
   274      "star_n X - star_n Y = star_n (%n. X n - Y n)"
   275 by (simp only: star_diff_def starfun2_star_n)
   276 
   277 lemma star_n_mult:
   278   "star_n X * star_n Y = star_n (%n. X n * Y n)"
   279 by (simp only: star_mult_def starfun2_star_n)
   280 
   281 lemma star_n_inverse:
   282       "inverse (star_n X) = star_n (%n. inverse(X n))"
   283 by (simp only: star_inverse_def starfun_star_n)
   284 
   285 lemma star_n_le:
   286       "star_n X \<le> star_n Y =  
   287        ({n. X n \<le> Y n} \<in> FreeUltrafilterNat)"
   288 by (simp only: star_le_def starP2_star_n)
   289 
   290 lemma star_n_less:
   291       "star_n X < star_n Y = ({n. X n < Y n} \<in> FreeUltrafilterNat)"
   292 by (simp only: star_less_def starP2_star_n)
   293 
   294 lemma star_n_zero_num: "0 = star_n (%n. 0)"
   295 by (simp only: star_zero_def star_of_def)
   296 
   297 lemma star_n_one_num: "1 = star_n (%n. 1)"
   298 by (simp only: star_one_def star_of_def)
   299 
   300 lemma star_n_abs:
   301      "abs (star_n X) = star_n (%n. abs (X n))"
   302 by (simp only: star_abs_def starfun_star_n)
   303 
   304 subsection{*Misc Others*}
   305 
   306 lemma hypreal_not_refl2: "!!(x::hypreal). x < y ==> x \<noteq> y"
   307 by (auto)
   308 
   309 lemma hypreal_eq_minus_iff: "((x::hypreal) = y) = (x + - y = 0)"
   310 by auto
   311 
   312 lemma hypreal_mult_left_cancel: "(c::hypreal) \<noteq> 0 ==> (c*a=c*b) = (a=b)"
   313 by auto
   314     
   315 lemma hypreal_mult_right_cancel: "(c::hypreal) \<noteq> 0 ==> (a*c=b*c) = (a=b)"
   316 by auto
   317 
   318 lemma hypreal_omega_gt_zero [simp]: "0 < omega"
   319 by (simp add: omega_def star_n_zero_num star_n_less)
   320 
   321 subsection{*Existence of Infinite Hyperreal Number*}
   322 
   323 text{*Existence of infinite number not corresponding to any real number.
   324 Use assumption that member @{term FreeUltrafilterNat} is not finite.*}
   325 
   326 
   327 text{*A few lemmas first*}
   328 
   329 lemma lemma_omega_empty_singleton_disj: "{n::nat. x = real n} = {} |  
   330       (\<exists>y. {n::nat. x = real n} = {y})"
   331 by force
   332 
   333 lemma lemma_finite_omega_set: "finite {n::nat. x = real n}"
   334 by (cut_tac x = x in lemma_omega_empty_singleton_disj, auto)
   335 
   336 lemma not_ex_hypreal_of_real_eq_omega: 
   337       "~ (\<exists>x. hypreal_of_real x = omega)"
   338 apply (simp add: omega_def)
   339 apply (simp add: star_of_def star_n_eq_iff)
   340 apply (auto simp add: real_of_nat_Suc diff_eq_eq [symmetric] 
   341             lemma_finite_omega_set [THEN FreeUltrafilterNat_finite])
   342 done
   343 
   344 lemma hypreal_of_real_not_eq_omega: "hypreal_of_real x \<noteq> omega"
   345 by (insert not_ex_hypreal_of_real_eq_omega, auto)
   346 
   347 text{*Existence of infinitesimal number also not corresponding to any
   348  real number*}
   349 
   350 lemma lemma_epsilon_empty_singleton_disj:
   351      "{n::nat. x = inverse(real(Suc n))} = {} |  
   352       (\<exists>y. {n::nat. x = inverse(real(Suc n))} = {y})"
   353 by auto
   354 
   355 lemma lemma_finite_epsilon_set: "finite {n. x = inverse(real(Suc n))}"
   356 by (cut_tac x = x in lemma_epsilon_empty_singleton_disj, auto)
   357 
   358 lemma not_ex_hypreal_of_real_eq_epsilon: "~ (\<exists>x. hypreal_of_real x = epsilon)"
   359 by (auto simp add: epsilon_def star_of_def star_n_eq_iff
   360                    lemma_finite_epsilon_set [THEN FreeUltrafilterNat_finite])
   361 
   362 lemma hypreal_of_real_not_eq_epsilon: "hypreal_of_real x \<noteq> epsilon"
   363 by (insert not_ex_hypreal_of_real_eq_epsilon, auto)
   364 
   365 lemma hypreal_epsilon_not_zero: "epsilon \<noteq> 0"
   366 by (simp add: epsilon_def star_zero_def star_of_def star_n_eq_iff
   367          del: star_of_zero)
   368 
   369 lemma hypreal_epsilon_inverse_omega: "epsilon = inverse(omega)"
   370 by (simp add: epsilon_def omega_def star_n_inverse)
   371 
   372 lemma hypreal_epsilon_gt_zero: "0 < epsilon"
   373 by (simp add: hypreal_epsilon_inverse_omega)
   374 
   375 end