src/HOL/Nonstandard_Analysis/HTranscendental.thy
changeset 70209 ab29bd01b8b2
parent 70208 65b3bfc565b5
child 70210 1ececb77b27a
equal deleted inserted replaced
70208:65b3bfc565b5 70209:ab29bd01b8b2
   163     unfolding exphr_def
   163     unfolding exphr_def
   164     using sumhr_split_add [OF hypnat_one_less_hypnat_omega] st_unique by auto
   164     using sumhr_split_add [OF hypnat_one_less_hypnat_omega] st_unique by auto
   165 qed
   165 qed
   166 
   166 
   167 lemma coshr_zero [simp]: "coshr 0 = 1"
   167 lemma coshr_zero [simp]: "coshr 0 = 1"
   168 apply (simp add: coshr_def sumhr_split_add
   168   proof -
   169                    [OF hypnat_one_less_hypnat_omega, symmetric]) 
   169   have "\<forall>x>1. 1 = sumhr (0, 1, \<lambda>n. cos_coeff n * 0 ^ n) + sumhr (1, x, \<lambda>n. cos_coeff n * 0 ^ n)"
   170 apply (rule st_unique, simp)
   170     unfolding sumhr_app by transfer (simp add: power_0_left)
   171 apply (rule subst [where P="\<lambda>x. 1 \<approx> x", OF _ approx_refl])
   171   then have "sumhr (0, 1, \<lambda>n. cos_coeff n * 0 ^ n) + sumhr (1, whn, \<lambda>n. cos_coeff n * 0 ^ n) \<approx> 1"
   172 apply (rule rev_mp [OF hypnat_one_less_hypnat_omega])
   172     by auto
   173 apply (rule_tac x="whn" in spec)
   173   then show ?thesis
   174 apply (unfold sumhr_app, transfer, simp add: cos_coeff_def power_0_left)
   174     unfolding coshr_def
   175 done
   175     using sumhr_split_add [OF hypnat_one_less_hypnat_omega] st_unique by auto
       
   176 qed
   176 
   177 
   177 lemma STAR_exp_zero_approx_one [simp]: "( *f* exp) (0::hypreal) \<approx> 1"
   178 lemma STAR_exp_zero_approx_one [simp]: "( *f* exp) (0::hypreal) \<approx> 1"
   178 apply (subgoal_tac "( *f* exp) (0::hypreal) = 1", simp)
   179   proof -
   179 apply (transfer, simp)
   180   have "(*f* exp) (0::real star) = 1"
   180 done
   181     by transfer simp
   181 
   182   then show ?thesis
   182 lemma STAR_exp_Infinitesimal: "x \<in> Infinitesimal \<Longrightarrow> ( *f* exp) (x::hypreal) \<approx> 1"
   183     by auto
   183 apply (case_tac "x = 0")
   184 qed
   184 apply (cut_tac [2] x = 0 in DERIV_exp)
   185 
   185 apply (auto simp add: NSDERIV_DERIV_iff [symmetric] nsderiv_def)
   186 lemma STAR_exp_Infinitesimal: 
   186 apply (drule_tac x = x in bspec, auto)
   187   assumes "x \<in> Infinitesimal" shows "( *f* exp) (x::hypreal) \<approx> 1"
   187 apply (drule_tac c = x in approx_mult1)
   188 proof (cases "x = 0")
   188 apply (auto intro: Infinitesimal_subset_HFinite [THEN subsetD] 
   189   case False
   189             simp add: mult.assoc)
   190   have "NSDERIV exp 0 :> 1"
   190 apply (rule approx_add_right_cancel [where d="-1"])
   191     by (metis DERIV_exp NSDERIV_DERIV_iff exp_zero)
   191 apply (rule approx_sym [THEN [2] approx_trans2])
   192   then have "((*f* exp) x - 1) / x \<approx> 1"
   192 apply (auto simp add: mem_infmal_iff)
   193     using nsderiv_def False NSDERIVD2 assms by fastforce
   193 done
   194   then have "(*f* exp) x - 1 \<approx> x"
       
   195     using NSDERIVD4 \<open>NSDERIV exp 0 :> 1\<close> assms by fastforce
       
   196   then show ?thesis
       
   197     by (meson Infinitesimal_approx approx_minus_iff approx_trans2 assms not_Infinitesimal_not_zero)
       
   198 qed auto
   194 
   199 
   195 lemma STAR_exp_epsilon [simp]: "( *f* exp) \<epsilon> \<approx> 1"
   200 lemma STAR_exp_epsilon [simp]: "( *f* exp) \<epsilon> \<approx> 1"
   196 by (auto intro: STAR_exp_Infinitesimal)
   201   by (auto intro: STAR_exp_Infinitesimal)
   197 
   202 
   198 lemma STAR_exp_add:
   203 lemma STAR_exp_add:
   199   "!!(x::'a:: {banach,real_normed_field} star) y. ( *f* exp)(x + y) = ( *f* exp) x * ( *f* exp) y"
   204   "\<And>(x::'a:: {banach,real_normed_field} star) y. ( *f* exp)(x + y) = ( *f* exp) x * ( *f* exp) y"
   200 by transfer (rule exp_add)
   205   by transfer (rule exp_add)
   201 
   206 
   202 lemma exphr_hypreal_of_real_exp_eq: "exphr x = hypreal_of_real (exp x)"
   207 lemma exphr_hypreal_of_real_exp_eq: "exphr x = hypreal_of_real (exp x)"
   203 apply (simp add: exphr_def)
   208 proof -
   204 apply (rule st_unique, simp)
   209   have "(\<lambda>n. inverse (fact n) * x ^ n) sums exp x"
   205 apply (subst starfunNat_sumr [symmetric])
   210     using exp_converges [of x] by simp
   206 unfolding atLeast0LessThan
   211   then have "(\<lambda>n. \<Sum>n<n. inverse (fact n) * x ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S exp x"
   207 apply (rule NSLIMSEQ_D [THEN approx_sym])
   212     using NSsums_def sums_NSsums_iff by blast
   208 apply (rule LIMSEQ_NSLIMSEQ)
   213   then have "hypreal_of_real (exp x) \<approx> sumhr (0, whn, \<lambda>n. inverse (fact n) * x ^ n)"
   209 apply (subst sums_def [symmetric])
   214     unfolding starfunNat_sumr [symmetric] atLeast0LessThan
   210 apply (cut_tac exp_converges [where x=x], simp)
   215     using HNatInfinite_whn NSLIMSEQ_iff approx_sym by blast
   211 apply (rule HNatInfinite_whn)
   216   then show ?thesis
   212 done
   217     unfolding exphr_def using st_eq_approx_iff by auto
       
   218 qed
   213 
   219 
   214 lemma starfun_exp_ge_add_one_self [simp]: "\<And>x::hypreal. 0 \<le> x \<Longrightarrow> (1 + x) \<le> ( *f* exp) x"
   220 lemma starfun_exp_ge_add_one_self [simp]: "\<And>x::hypreal. 0 \<le> x \<Longrightarrow> (1 + x) \<le> ( *f* exp) x"
   215 by transfer (rule exp_ge_add_one_self_aux)
   221   by transfer (rule exp_ge_add_one_self_aux)
   216 
   222 
   217 (* exp (oo) is infinite *)
   223 text\<open>exp maps infinities to infinities\<close>
   218 lemma starfun_exp_HInfinite:
   224 lemma starfun_exp_HInfinite:
   219      "\<lbrakk>x \<in> HInfinite; 0 \<le> x\<rbrakk> \<Longrightarrow> ( *f* exp) (x::hypreal) \<in> HInfinite"
   225   fixes x :: hypreal
   220 apply (frule starfun_exp_ge_add_one_self)
   226   assumes "x \<in> HInfinite" "0 \<le> x"
   221 apply (rule HInfinite_ge_HInfinite, assumption)
   227   shows "( *f* exp) x \<in> HInfinite"
   222 apply (rule order_trans [of _ "1+x"], auto) 
   228 proof -
   223 done
   229   have "x \<le> 1 + x"
       
   230     by simp
       
   231   also have "\<dots> \<le> (*f* exp) x"
       
   232     by (simp add: \<open>0 \<le> x\<close>)
       
   233   finally show ?thesis
       
   234     using HInfinite_ge_HInfinite assms by blast
       
   235 qed
   224 
   236 
   225 lemma starfun_exp_minus:
   237 lemma starfun_exp_minus:
   226   "\<And>x::'a:: {banach,real_normed_field} star. ( *f* exp) (-x) = inverse(( *f* exp) x)"
   238   "\<And>x::'a:: {banach,real_normed_field} star. ( *f* exp) (-x) = inverse(( *f* exp) x)"
   227 by transfer (rule exp_minus)
   239   by transfer (rule exp_minus)
   228 
   240 
   229 (* exp (-oo) is infinitesimal *)
   241 text\<open>exp maps infinitesimals to infinitesimals\<close>
   230 lemma starfun_exp_Infinitesimal:
   242 lemma starfun_exp_Infinitesimal:
   231      "\<lbrakk>x \<in> HInfinite; x \<le> 0\<rbrakk> \<Longrightarrow> ( *f* exp) (x::hypreal) \<in> Infinitesimal"
   243   fixes x :: hypreal
   232 apply (subgoal_tac "\<exists>y. x = - y")
   244   assumes "x \<in> HInfinite" "x \<le> 0"
   233 apply (rule_tac [2] x = "- x" in exI)
   245   shows "( *f* exp) x \<in> Infinitesimal"
   234 apply (auto intro!: HInfinite_inverse_Infinitesimal starfun_exp_HInfinite
   246 proof -
   235             simp add: starfun_exp_minus HInfinite_minus_iff)
   247   obtain y where "x = -y" "y \<ge> 0"
   236 done
   248     by (metis abs_of_nonpos assms(2) eq_abs_iff')
       
   249   then have "( *f* exp) y \<in> HInfinite"
       
   250     using HInfinite_minus_iff assms(1) starfun_exp_HInfinite by blast
       
   251   then show ?thesis
       
   252     by (simp add: HInfinite_inverse_Infinitesimal \<open>x = - y\<close> starfun_exp_minus)
       
   253 qed
   237 
   254 
   238 lemma starfun_exp_gt_one [simp]: "\<And>x::hypreal. 0 < x \<Longrightarrow> 1 < ( *f* exp) x"
   255 lemma starfun_exp_gt_one [simp]: "\<And>x::hypreal. 0 < x \<Longrightarrow> 1 < ( *f* exp) x"
   239 by transfer (rule exp_gt_one)
   256   by transfer (rule exp_gt_one)
   240 
   257 
   241 abbreviation real_ln :: "real \<Rightarrow> real" where 
   258 abbreviation real_ln :: "real \<Rightarrow> real" where 
   242   "real_ln \<equiv> ln"
   259   "real_ln \<equiv> ln"
   243 
   260 
   244 lemma starfun_ln_exp [simp]: "\<And>x. ( *f* real_ln) (( *f* exp) x) = x"
   261 lemma starfun_ln_exp [simp]: "\<And>x. ( *f* real_ln) (( *f* exp) x) = x"
   245 by transfer (rule ln_exp)
   262   by transfer (rule ln_exp)
   246 
   263 
   247 lemma starfun_exp_ln_iff [simp]: "\<And>x. (( *f* exp)(( *f* real_ln) x) = x) = (0 < x)"
   264 lemma starfun_exp_ln_iff [simp]: "\<And>x. (( *f* exp)(( *f* real_ln) x) = x) = (0 < x)"
   248 by transfer (rule exp_ln_iff)
   265   by transfer (rule exp_ln_iff)
   249 
   266 
   250 lemma starfun_exp_ln_eq: "!!u x. ( *f* exp) u = x \<Longrightarrow> ( *f* real_ln) x = u"
   267 lemma starfun_exp_ln_eq: "\<And>u x. ( *f* exp) u = x \<Longrightarrow> ( *f* real_ln) x = u"
   251 by transfer (rule ln_unique)
   268   by transfer (rule ln_unique)
   252 
   269 
   253 lemma starfun_ln_less_self [simp]: "\<And>x. 0 < x \<Longrightarrow> ( *f* real_ln) x < x"
   270 lemma starfun_ln_less_self [simp]: "\<And>x. 0 < x \<Longrightarrow> ( *f* real_ln) x < x"
   254 by transfer (rule ln_less_self)
   271   by transfer (rule ln_less_self)
   255 
   272 
   256 lemma starfun_ln_ge_zero [simp]: "\<And>x. 1 \<le> x \<Longrightarrow> 0 \<le> ( *f* real_ln) x"
   273 lemma starfun_ln_ge_zero [simp]: "\<And>x. 1 \<le> x \<Longrightarrow> 0 \<le> ( *f* real_ln) x"
   257 by transfer (rule ln_ge_zero)
   274   by transfer (rule ln_ge_zero)
   258 
   275 
   259 lemma starfun_ln_gt_zero [simp]: "\<And>x .1 < x \<Longrightarrow> 0 < ( *f* real_ln) x"
   276 lemma starfun_ln_gt_zero [simp]: "\<And>x .1 < x \<Longrightarrow> 0 < ( *f* real_ln) x"
   260 by transfer (rule ln_gt_zero)
   277   by transfer (rule ln_gt_zero)
   261 
   278 
   262 lemma starfun_ln_not_eq_zero [simp]: "\<And>x. \<lbrakk>0 < x; x \<noteq> 1\<rbrakk> \<Longrightarrow> ( *f* real_ln) x \<noteq> 0"
   279 lemma starfun_ln_not_eq_zero [simp]: "\<And>x. \<lbrakk>0 < x; x \<noteq> 1\<rbrakk> \<Longrightarrow> ( *f* real_ln) x \<noteq> 0"
   263 by transfer simp
   280   by transfer simp
   264 
   281 
   265 lemma starfun_ln_HFinite: "\<lbrakk>x \<in> HFinite; 1 \<le> x\<rbrakk> \<Longrightarrow> ( *f* real_ln) x \<in> HFinite"
   282 lemma starfun_ln_HFinite: "\<lbrakk>x \<in> HFinite; 1 \<le> x\<rbrakk> \<Longrightarrow> ( *f* real_ln) x \<in> HFinite"
   266 apply (rule HFinite_bounded)
   283   by (metis HFinite_HInfinite_iff less_le_trans starfun_exp_HInfinite starfun_exp_ln_iff starfun_ln_ge_zero zero_less_one)
   267 apply assumption 
       
   268 apply (simp_all add: starfun_ln_less_self order_less_imp_le)
       
   269 done
       
   270 
   284 
   271 lemma starfun_ln_inverse: "\<And>x. 0 < x \<Longrightarrow> ( *f* real_ln) (inverse x) = -( *f* ln) x"
   285 lemma starfun_ln_inverse: "\<And>x. 0 < x \<Longrightarrow> ( *f* real_ln) (inverse x) = -( *f* ln) x"
   272 by transfer (rule ln_inverse)
   286   by transfer (rule ln_inverse)
   273 
   287 
   274 lemma starfun_abs_exp_cancel: "\<And>x. \<bar>( *f* exp) (x::hypreal)\<bar> = ( *f* exp) x"
   288 lemma starfun_abs_exp_cancel: "\<And>x. \<bar>( *f* exp) (x::hypreal)\<bar> = ( *f* exp) x"
   275 by transfer (rule abs_exp_cancel)
   289   by transfer (rule abs_exp_cancel)
   276 
   290 
   277 lemma starfun_exp_less_mono: "\<And>x y::hypreal. x < y \<Longrightarrow> ( *f* exp) x < ( *f* exp) y"
   291 lemma starfun_exp_less_mono: "\<And>x y::hypreal. x < y \<Longrightarrow> ( *f* exp) x < ( *f* exp) y"
   278 by transfer (rule exp_less_mono)
   292   by transfer (rule exp_less_mono)
   279 
   293 
   280 lemma starfun_exp_HFinite: "x \<in> HFinite \<Longrightarrow> ( *f* exp) (x::hypreal) \<in> HFinite"
   294 lemma starfun_exp_HFinite: 
   281 apply (auto simp add: HFinite_def, rename_tac u)
   295   fixes x :: hypreal
   282 apply (rule_tac x="( *f* exp) u" in rev_bexI)
   296   assumes "x \<in> HFinite"
   283 apply (simp add: Reals_eq_Standard)
   297   shows "( *f* exp) x \<in> HFinite"
   284 apply (simp add: starfun_abs_exp_cancel)
   298 proof -
   285 apply (simp add: starfun_exp_less_mono)
   299   obtain u where "u \<in> \<real>" "\<bar>x\<bar> < u"
   286 done
   300     using HFiniteD assms by force
       
   301   with assms have "\<bar>(*f* exp) x\<bar> < (*f* exp) u" 
       
   302     using starfun_abs_exp_cancel starfun_exp_less_mono by auto
       
   303   with \<open>u \<in> \<real>\<close> show ?thesis
       
   304     by (force simp: HFinite_def Reals_eq_Standard)
       
   305 qed
   287 
   306 
   288 lemma starfun_exp_add_HFinite_Infinitesimal_approx:
   307 lemma starfun_exp_add_HFinite_Infinitesimal_approx:
   289      "\<lbrakk>x \<in> Infinitesimal; z \<in> HFinite\<rbrakk> \<Longrightarrow> ( *f* exp) (z + x::hypreal) \<approx> ( *f* exp) z"
   308      "\<lbrakk>x \<in> Infinitesimal; z \<in> HFinite\<rbrakk> \<Longrightarrow> ( *f* exp) (z + x::hypreal) \<approx> ( *f* exp) z"
   290 apply (simp add: STAR_exp_add)
   309 apply (simp add: STAR_exp_add)
   291 apply (frule STAR_exp_Infinitesimal)
   310 apply (frule STAR_exp_Infinitesimal)
   305  "x \<in> HInfinite \<Longrightarrow> ( *f* exp) x \<in> HInfinite \<or> ( *f* exp) (x::hypreal) \<in> Infinitesimal"
   324  "x \<in> HInfinite \<Longrightarrow> ( *f* exp) x \<in> HInfinite \<or> ( *f* exp) (x::hypreal) \<in> Infinitesimal"
   306 apply (insert linorder_linear [of x 0]) 
   325 apply (insert linorder_linear [of x 0]) 
   307 apply (auto intro: starfun_exp_HInfinite starfun_exp_Infinitesimal)
   326 apply (auto intro: starfun_exp_HInfinite starfun_exp_Infinitesimal)
   308 done
   327 done
   309 
   328 
   310 (* check out this proof!!! *)
   329 (* check out this proof\<And>! *)
   311 lemma starfun_ln_HFinite_not_Infinitesimal:
   330 lemma starfun_ln_HFinite_not_Infinitesimal:
   312      "\<lbrakk>x \<in> HFinite - Infinitesimal; 0 < x\<rbrakk> \<Longrightarrow> ( *f* real_ln) x \<in> HFinite"
   331      "\<lbrakk>x \<in> HFinite - Infinitesimal; 0 < x\<rbrakk> \<Longrightarrow> ( *f* real_ln) x \<in> HFinite"
   313 apply (rule ccontr, drule HInfinite_HFinite_iff [THEN iffD2])
   332 apply (rule ccontr, drule HInfinite_HFinite_iff [THEN iffD2])
   314 apply (drule starfun_exp_HInfinite_Infinitesimal_disj)
   333 apply (drule starfun_exp_HInfinite_Infinitesimal_disj)
   315 apply (simp add: starfun_exp_ln_iff [symmetric] HInfinite_HFinite_iff
   334 apply (simp add: starfun_exp_ln_iff [symmetric] HInfinite_HFinite_iff