src/HOL/Real/Hyperreal/Star.ML
changeset 10715 c838477b5c18
parent 10690 cd80241125b0
child 10720 1ce5a189f672
equal deleted inserted replaced
10714:07f75bf77a33 10715:c838477b5c18
   210  ------------------------------------------*)
   210  ------------------------------------------*)
   211 Goal "(*f* f) xa * (*f* g) xa = (*f* (%x. f x * g x)) xa";
   211 Goal "(*f* f) xa * (*f* g) xa = (*f* (%x. f x * g x)) xa";
   212 by (res_inst_tac [("z","xa")] eq_Abs_hypreal 1);
   212 by (res_inst_tac [("z","xa")] eq_Abs_hypreal 1);
   213 by (auto_tac (claset(),simpset() addsimps [starfun,hypreal_mult]));
   213 by (auto_tac (claset(),simpset() addsimps [starfun,hypreal_mult]));
   214 qed "starfun_mult";
   214 qed "starfun_mult";
       
   215 Addsimps [starfun_mult RS sym];
   215 
   216 
   216 (*---------------------------------------
   217 (*---------------------------------------
   217   addition: ( *f ) + ( *g ) = *(f + g)  
   218   addition: ( *f ) + ( *g ) = *(f + g)  
   218  ---------------------------------------*)
   219  ---------------------------------------*)
   219 Goal "(*f* f) xa + (*f* g) xa = (*f* (%x. f x + g x)) xa";
   220 Goal "(*f* f) xa + (*f* g) xa = (*f* (%x. f x + g x)) xa";
   220 by (res_inst_tac [("z","xa")] eq_Abs_hypreal 1);
   221 by (res_inst_tac [("z","xa")] eq_Abs_hypreal 1);
   221 by (auto_tac (claset(),simpset() addsimps [starfun,hypreal_add]));
   222 by (auto_tac (claset(),simpset() addsimps [starfun,hypreal_add]));
   222 qed "starfun_add";
   223 qed "starfun_add";
       
   224 Addsimps [starfun_add RS sym];
   223 
   225 
   224 (*--------------------------------------------
   226 (*--------------------------------------------
   225   subtraction: ( *f ) + -( *g ) = *(f + -g)  
   227   subtraction: ( *f ) + -( *g ) = *(f + -g)  
   226  -------------------------------------------*)
   228  -------------------------------------------*)
   227 
   229 
   228 Goal "- (*f* f) x = (*f* (%x. - f x)) x";
   230 Goal "- (*f* f) x = (*f* (%x. - f x)) x";
   229 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   231 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   230 by (auto_tac (claset(),simpset() addsimps [starfun, hypreal_minus]));
   232 by (auto_tac (claset(),simpset() addsimps [starfun, hypreal_minus]));
   231 qed "starfun_minus";
   233 qed "starfun_minus";
   232 
   234 Addsimps [starfun_minus RS sym];
       
   235 
       
   236 (*FIXME: delete*)
   233 Goal "(*f* f) xa + -(*f* g) xa = (*f* (%x. f x + -g x)) xa";
   237 Goal "(*f* f) xa + -(*f* g) xa = (*f* (%x. f x + -g x)) xa";
   234 by (simp_tac (simpset() addsimps [starfun_minus, starfun_add]) 1);
   238 by (Simp_tac 1);
   235 qed "starfun_add_minus";
   239 qed "starfun_add_minus";
       
   240 Addsimps [starfun_add_minus RS sym];
   236 
   241 
   237 Goalw [hypreal_diff_def,real_diff_def]
   242 Goalw [hypreal_diff_def,real_diff_def]
   238   "(*f* f) xa  - (*f* g) xa = (*f* (%x. f x - g x)) xa";
   243   "(*f* f) xa  - (*f* g) xa = (*f* (%x. f x - g x)) xa";
   239 by (rtac starfun_add_minus 1);
   244 by (rtac starfun_add_minus 1);
   240 qed "starfun_diff";
   245 qed "starfun_diff";
       
   246 Addsimps [starfun_diff RS sym];
   241 
   247 
   242 (*--------------------------------------
   248 (*--------------------------------------
   243   composition: ( *f ) o ( *g ) = *(f o g)  
   249   composition: ( *f ) o ( *g ) = *(f o g)  
   244  ---------------------------------------*)
   250  ---------------------------------------*)
   245 
   251 
   246 Goal "(%x. (*f* f) ((*f* g) x)) = *f* (%x. f (g x))";
   252 Goal "(%x. (*f* f) ((*f* g) x)) = *f* (%x. f (g x))"; 
   247 by (rtac ext 1);
   253 by (rtac ext 1);
   248 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   254 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   249 by (auto_tac (claset(),simpset() addsimps [starfun]));
   255 by (auto_tac (claset(),simpset() addsimps [starfun]));
   250 qed "starfun_o2";
   256 qed "starfun_o2";
   251 
   257 
   341 \                 l: HFinite; m: HFinite  \
   347 \                 l: HFinite; m: HFinite  \
   342 \              |] ==>  (*f* (%x. f x * g x)) xa @= l * m";
   348 \              |] ==>  (*f* (%x. f x * g x)) xa @= l * m";
   343 by (dtac inf_close_mult_HFinite 1);
   349 by (dtac inf_close_mult_HFinite 1);
   344 by (REPEAT(assume_tac 1));
   350 by (REPEAT(assume_tac 1));
   345 by (auto_tac (claset() addIs [inf_close_sym RSN (2,inf_close_HFinite)],
   351 by (auto_tac (claset() addIs [inf_close_sym RSN (2,inf_close_HFinite)],
   346               simpset() addsimps [starfun_mult]));
   352               simpset()));
   347 qed "starfun_mult_HFinite_inf_close";
   353 qed "starfun_mult_HFinite_inf_close";
   348 
   354 
   349 Goal "[| (*f* f) xa @= l; (*f* g) xa @= m \
   355 Goal "[| (*f* f) xa @= l; (*f* g) xa @= m \
   350 \              |] ==>  (*f* (%x. f x + g x)) xa @= l + m";
   356 \              |] ==>  (*f* (%x. f x + g x)) xa @= l + m";
   351 by (auto_tac (claset() addIs [inf_close_add],
   357 by (auto_tac (claset() addIs [inf_close_add], simpset()));
   352               simpset() addsimps [starfun_add RS sym]));
       
   353 qed "starfun_add_inf_close";
   358 qed "starfun_add_inf_close";
   354 
   359 
   355 (*----------------------------------------------------
   360 (*----------------------------------------------------
   356     Examples: hrabs is nonstandard extension of rabs 
   361     Examples: hrabs is nonstandard extension of rabs 
   357               inverse is nonstandard extension of inverse
   362               inverse is nonstandard extension of inverse
   361 (* properties of ultrafilter as for inverse below we  *)
   366 (* properties of ultrafilter as for inverse below we  *)
   362 (* use the theorem we proved above instead          *)
   367 (* use the theorem we proved above instead          *)
   363 
   368 
   364 Goal "*f* abs = abs";
   369 Goal "*f* abs = abs";
   365 by (rtac (hrabs_is_starext_rabs RS 
   370 by (rtac (hrabs_is_starext_rabs RS 
   366     (is_starext_starfun_iff RS iffD1) RS sym) 1);
   371           (is_starext_starfun_iff RS iffD1) RS sym) 1);
   367 qed "starfun_rabs_hrabs";
   372 qed "starfun_rabs_hrabs";
   368 
   373 
   369 Goal "(*f* inverse) x = inverse(x)";
   374 Goal "(*f* inverse) x = inverse(x)";
   370 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   375 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   371 by (auto_tac (claset(),
   376 by (auto_tac (claset(),
   380 Goal "inverse ((*f* f) x) = (*f* (%x. inverse (f x))) x";
   385 Goal "inverse ((*f* f) x) = (*f* (%x. inverse (f x))) x";
   381 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   386 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   382 by (auto_tac (claset(),
   387 by (auto_tac (claset(),
   383               simpset() addsimps [starfun, hypreal_inverse]));
   388               simpset() addsimps [starfun, hypreal_inverse]));
   384 qed "starfun_inverse";
   389 qed "starfun_inverse";
       
   390 Addsimps [starfun_inverse RS sym];
   385 
   391 
   386 Goalw [hypreal_divide_def,real_divide_def]
   392 Goalw [hypreal_divide_def,real_divide_def]
   387   "(*f* f) xa  / (*f* g) xa = (*f* (%x. f x / g x)) xa";
   393   "(*f* f) xa  / (*f* g) xa = (*f* (%x. f x / g x)) xa";
   388 by (simp_tac (simpset() addsimps [starfun_inverse, starfun_mult]) 1);
   394 by Auto_tac;
   389 qed "starfun_divide";
   395 qed "starfun_divide";
       
   396 Addsimps [starfun_divide RS sym];
   390 
   397 
   391 Goal "inverse ((*f* f) x) = (*f* (%x. inverse (f x))) x";
   398 Goal "inverse ((*f* f) x) = (*f* (%x. inverse (f x))) x";
   392 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   399 by (res_inst_tac [("z","x")] eq_Abs_hypreal 1);
   393 by (auto_tac (claset() addIs [FreeUltrafilterNat_subset]
   400 by (auto_tac (claset() addIs [FreeUltrafilterNat_subset]
   394                        addSDs [FreeUltrafilterNat_Compl_mem],
   401                        addSDs [FreeUltrafilterNat_Compl_mem],
   422    of rabs function i.e hrabs. A more general result should be 
   429    of rabs function i.e hrabs. A more general result should be 
   423    where we replace rabs by some arbitrary function f and hrabs
   430    where we replace rabs by some arbitrary function f and hrabs
   424    by its NS extenson ( *f* f). See second NS set extension below.
   431    by its NS extenson ( *f* f). See second NS set extension below.
   425  ----------------------------------------------------------------*)
   432  ----------------------------------------------------------------*)
   426 Goalw [starset_def]
   433 Goalw [starset_def]
   427    "*s* {x. abs (x + - y) < r} = {x. abs(x + -hypreal_of_real y) < hypreal_of_real r}";
   434    "*s* {x. abs (x + - y) < r} = \
       
   435 \    {x. abs(x + -hypreal_of_real y) < hypreal_of_real r}";
   428 by (Step_tac 1);
   436 by (Step_tac 1);
   429 by (ALLGOALS(res_inst_tac [("z","x")] eq_Abs_hypreal));
   437 by (ALLGOALS(res_inst_tac [("z","x")] eq_Abs_hypreal));
   430 by (auto_tac (claset() addSIs [exI] addSDs [bspec],
   438 by (auto_tac (claset() addSIs [exI] addSDs [bspec],
   431     simpset() addsimps [hypreal_minus, hypreal_of_real_def,hypreal_add,
   439           simpset() addsimps [hypreal_minus, hypreal_of_real_def,hypreal_add,
   432     hypreal_hrabs,hypreal_less_def]));
   440                               hypreal_hrabs,hypreal_less_def]));
   433 by (Fuf_tac 1);
   441 by (Fuf_tac 1);
   434 qed "STAR_rabs_add_minus";
   442 qed "STAR_rabs_add_minus";
   435 
   443 
   436 Goalw [starset_def]
   444 Goalw [starset_def]
   437   "*s* {x. abs (f x + - y) < r} = \
   445   "*s* {x. abs (f x + - y) < r} = \