src/HOL/Transcendental.thy
author paulson <lp15@cam.ac.uk>
Wed Mar 18 17:23:22 2015 +0000 (2015-03-18)
changeset 59746 ddae5727c5a9
parent 59741 5b762cd73a8e
child 59751 916c0f6c83e3
permissions -rw-r--r--
new HOL Light material about exp, sin, cos
     1 (*  Title:      HOL/Transcendental.thy
     2     Author:     Jacques D. Fleuriot, University of Cambridge, University of Edinburgh
     3     Author:     Lawrence C Paulson
     4     Author:     Jeremy Avigad
     5 *)
     6 
     7 section{*Power Series, Transcendental Functions etc.*}
     8 
     9 theory Transcendental
    10 imports Binomial Series Deriv NthRoot
    11 begin
    12 
    13 lemma of_real_fact [simp]: "of_real (fact n) = fact n"
    14   by (metis of_nat_fact of_real_of_nat_eq)
    15 
    16 lemma real_fact_nat [simp]: "real (fact n :: nat) = fact n"
    17   by (simp add: real_of_nat_def)
    18 
    19 lemma real_fact_int [simp]: "real (fact n :: int) = fact n"
    20   by (metis of_int_of_nat_eq of_nat_fact real_of_int_def)
    21 
    22 lemma root_test_convergence:
    23   fixes f :: "nat \<Rightarrow> 'a::banach"
    24   assumes f: "(\<lambda>n. root n (norm (f n))) ----> x" -- "could be weakened to lim sup"
    25   assumes "x < 1"
    26   shows "summable f"
    27 proof -
    28   have "0 \<le> x"
    29     by (rule LIMSEQ_le[OF tendsto_const f]) (auto intro!: exI[of _ 1])
    30   from `x < 1` obtain z where z: "x < z" "z < 1"
    31     by (metis dense)
    32   from f `x < z`
    33   have "eventually (\<lambda>n. root n (norm (f n)) < z) sequentially"
    34     by (rule order_tendstoD)
    35   then have "eventually (\<lambda>n. norm (f n) \<le> z^n) sequentially"
    36     using eventually_ge_at_top
    37   proof eventually_elim
    38     fix n assume less: "root n (norm (f n)) < z" and n: "1 \<le> n"
    39     from power_strict_mono[OF less, of n] n
    40     show "norm (f n) \<le> z ^ n"
    41       by simp
    42   qed
    43   then show "summable f"
    44     unfolding eventually_sequentially
    45     using z `0 \<le> x` by (auto intro!: summable_comparison_test[OF _  summable_geometric])
    46 qed
    47 
    48 subsection {* Properties of Power Series *}
    49 
    50 lemma lemma_realpow_diff:
    51   fixes y :: "'a::monoid_mult"
    52   shows "p \<le> n \<Longrightarrow> y ^ (Suc n - p) = (y ^ (n - p)) * y"
    53 proof -
    54   assume "p \<le> n"
    55   hence "Suc n - p = Suc (n - p)" by (rule Suc_diff_le)
    56   thus ?thesis by (simp add: power_commutes)
    57 qed
    58 
    59 lemma lemma_realpow_diff_sumr2:
    60   fixes y :: "'a::{comm_ring,monoid_mult}"
    61   shows
    62     "x ^ (Suc n) - y ^ (Suc n) =
    63       (x - y) * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))"
    64 proof (induct n)
    65   case (Suc n)
    66   have "x ^ Suc (Suc n) - y ^ Suc (Suc n) = x * (x * x^n) - y * (y * y ^ n)"
    67     by simp
    68   also have "... = y * (x ^ (Suc n) - y ^ (Suc n)) + (x - y) * (x * x^n)"
    69     by (simp add: algebra_simps)
    70   also have "... = y * ((x - y) * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))) + (x - y) * (x * x^n)"
    71     by (simp only: Suc)
    72   also have "... = (x - y) * (y * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))) + (x - y) * (x * x^n)"
    73     by (simp only: mult.left_commute)
    74   also have "... = (x - y) * (\<Sum>p<Suc (Suc n). x ^ p * y ^ (Suc n - p))"
    75     by (simp add: field_simps Suc_diff_le setsum_left_distrib setsum_right_distrib)
    76   finally show ?case .
    77 qed simp
    78 
    79 corollary power_diff_sumr2: --{* @{text COMPLEX_POLYFUN} in HOL Light *}
    80   fixes x :: "'a::{comm_ring,monoid_mult}"
    81   shows   "x^n - y^n = (x - y) * (\<Sum>i<n. y^(n - Suc i) * x^i)"
    82 using lemma_realpow_diff_sumr2[of x "n - 1" y]
    83 by (cases "n = 0") (simp_all add: field_simps)
    84 
    85 lemma lemma_realpow_rev_sumr:
    86    "(\<Sum>p<Suc n. (x ^ p) * (y ^ (n - p))) =
    87     (\<Sum>p<Suc n. (x ^ (n - p)) * (y ^ p))"
    88   by (subst nat_diff_setsum_reindex[symmetric]) simp
    89 
    90 lemma power_diff_1_eq:
    91   fixes x :: "'a::{comm_ring,monoid_mult}"
    92   shows "n \<noteq> 0 \<Longrightarrow> x^n - 1 = (x - 1) * (\<Sum>i<n. (x^i))"
    93 using lemma_realpow_diff_sumr2 [of x _ 1]
    94   by (cases n) auto
    95 
    96 lemma one_diff_power_eq':
    97   fixes x :: "'a::{comm_ring,monoid_mult}"
    98   shows "n \<noteq> 0 \<Longrightarrow> 1 - x^n = (1 - x) * (\<Sum>i<n. x^(n - Suc i))"
    99 using lemma_realpow_diff_sumr2 [of 1 _ x]
   100   by (cases n) auto
   101 
   102 lemma one_diff_power_eq:
   103   fixes x :: "'a::{comm_ring,monoid_mult}"
   104   shows "n \<noteq> 0 \<Longrightarrow> 1 - x^n = (1 - x) * (\<Sum>i<n. x^i)"
   105 by (metis one_diff_power_eq' [of n x] nat_diff_setsum_reindex)
   106 
   107 text{*Power series has a `circle` of convergence, i.e. if it sums for @{term
   108   x}, then it sums absolutely for @{term z} with @{term "\<bar>z\<bar> < \<bar>x\<bar>"}.*}
   109 
   110 lemma powser_insidea:
   111   fixes x z :: "'a::real_normed_div_algebra"
   112   assumes 1: "summable (\<lambda>n. f n * x^n)"
   113     and 2: "norm z < norm x"
   114   shows "summable (\<lambda>n. norm (f n * z ^ n))"
   115 proof -
   116   from 2 have x_neq_0: "x \<noteq> 0" by clarsimp
   117   from 1 have "(\<lambda>n. f n * x^n) ----> 0"
   118     by (rule summable_LIMSEQ_zero)
   119   hence "convergent (\<lambda>n. f n * x^n)"
   120     by (rule convergentI)
   121   hence "Cauchy (\<lambda>n. f n * x^n)"
   122     by (rule convergent_Cauchy)
   123   hence "Bseq (\<lambda>n. f n * x^n)"
   124     by (rule Cauchy_Bseq)
   125   then obtain K where 3: "0 < K" and 4: "\<forall>n. norm (f n * x^n) \<le> K"
   126     by (simp add: Bseq_def, safe)
   127   have "\<exists>N. \<forall>n\<ge>N. norm (norm (f n * z ^ n)) \<le>
   128                    K * norm (z ^ n) * inverse (norm (x^n))"
   129   proof (intro exI allI impI)
   130     fix n::nat
   131     assume "0 \<le> n"
   132     have "norm (norm (f n * z ^ n)) * norm (x^n) =
   133           norm (f n * x^n) * norm (z ^ n)"
   134       by (simp add: norm_mult abs_mult)
   135     also have "\<dots> \<le> K * norm (z ^ n)"
   136       by (simp only: mult_right_mono 4 norm_ge_zero)
   137     also have "\<dots> = K * norm (z ^ n) * (inverse (norm (x^n)) * norm (x^n))"
   138       by (simp add: x_neq_0)
   139     also have "\<dots> = K * norm (z ^ n) * inverse (norm (x^n)) * norm (x^n)"
   140       by (simp only: mult.assoc)
   141     finally show "norm (norm (f n * z ^ n)) \<le>
   142                   K * norm (z ^ n) * inverse (norm (x^n))"
   143       by (simp add: mult_le_cancel_right x_neq_0)
   144   qed
   145   moreover have "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
   146   proof -
   147     from 2 have "norm (norm (z * inverse x)) < 1"
   148       using x_neq_0
   149       by (simp add: norm_mult nonzero_norm_inverse divide_inverse [where 'a=real, symmetric])
   150     hence "summable (\<lambda>n. norm (z * inverse x) ^ n)"
   151       by (rule summable_geometric)
   152     hence "summable (\<lambda>n. K * norm (z * inverse x) ^ n)"
   153       by (rule summable_mult)
   154     thus "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
   155       using x_neq_0
   156       by (simp add: norm_mult nonzero_norm_inverse power_mult_distrib
   157                     power_inverse norm_power mult.assoc)
   158   qed
   159   ultimately show "summable (\<lambda>n. norm (f n * z ^ n))"
   160     by (rule summable_comparison_test)
   161 qed
   162 
   163 lemma powser_inside:
   164   fixes f :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
   165   shows
   166     "summable (\<lambda>n. f n * (x^n)) \<Longrightarrow> norm z < norm x \<Longrightarrow>
   167       summable (\<lambda>n. f n * (z ^ n))"
   168   by (rule powser_insidea [THEN summable_norm_cancel])
   169 
   170 lemma sum_split_even_odd:
   171   fixes f :: "nat \<Rightarrow> real"
   172   shows
   173     "(\<Sum>i<2 * n. if even i then f i else g i) =
   174      (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1))"
   175 proof (induct n)
   176   case 0
   177   then show ?case by simp
   178 next
   179   case (Suc n)
   180   have "(\<Sum>i<2 * Suc n. if even i then f i else g i) =
   181     (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1)) + (f (2 * n) + g (2 * n + 1))"
   182     using Suc.hyps unfolding One_nat_def by auto
   183   also have "\<dots> = (\<Sum>i<Suc n. f (2 * i)) + (\<Sum>i<Suc n. g (2 * i + 1))"
   184     by auto
   185   finally show ?case .
   186 qed
   187 
   188 lemma sums_if':
   189   fixes g :: "nat \<Rightarrow> real"
   190   assumes "g sums x"
   191   shows "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
   192   unfolding sums_def
   193 proof (rule LIMSEQ_I)
   194   fix r :: real
   195   assume "0 < r"
   196   from `g sums x`[unfolded sums_def, THEN LIMSEQ_D, OF this]
   197   obtain no where no_eq: "\<And> n. n \<ge> no \<Longrightarrow> (norm (setsum g {..<n} - x) < r)" by blast
   198 
   199   let ?SUM = "\<lambda> m. \<Sum>i<m. if even i then 0 else g ((i - 1) div 2)"
   200   {
   201     fix m
   202     assume "m \<ge> 2 * no"
   203     hence "m div 2 \<ge> no" by auto
   204     have sum_eq: "?SUM (2 * (m div 2)) = setsum g {..< m div 2}"
   205       using sum_split_even_odd by auto
   206     hence "(norm (?SUM (2 * (m div 2)) - x) < r)"
   207       using no_eq unfolding sum_eq using `m div 2 \<ge> no` by auto
   208     moreover
   209     have "?SUM (2 * (m div 2)) = ?SUM m"
   210     proof (cases "even m")
   211       case True
   212       then show ?thesis by (auto simp add: even_two_times_div_two)
   213     next
   214       case False
   215       then have eq: "Suc (2 * (m div 2)) = m" by simp
   216       hence "even (2 * (m div 2))" using `odd m` by auto
   217       have "?SUM m = ?SUM (Suc (2 * (m div 2)))" unfolding eq ..
   218       also have "\<dots> = ?SUM (2 * (m div 2))" using `even (2 * (m div 2))` by auto
   219       finally show ?thesis by auto
   220     qed
   221     ultimately have "(norm (?SUM m - x) < r)" by auto
   222   }
   223   thus "\<exists> no. \<forall> m \<ge> no. norm (?SUM m - x) < r" by blast
   224 qed
   225 
   226 lemma sums_if:
   227   fixes g :: "nat \<Rightarrow> real"
   228   assumes "g sums x" and "f sums y"
   229   shows "(\<lambda> n. if even n then f (n div 2) else g ((n - 1) div 2)) sums (x + y)"
   230 proof -
   231   let ?s = "\<lambda> n. if even n then 0 else f ((n - 1) div 2)"
   232   {
   233     fix B T E
   234     have "(if B then (0 :: real) else E) + (if B then T else 0) = (if B then T else E)"
   235       by (cases B) auto
   236   } note if_sum = this
   237   have g_sums: "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
   238     using sums_if'[OF `g sums x`] .
   239   {
   240     have if_eq: "\<And>B T E. (if \<not> B then T else E) = (if B then E else T)" by auto
   241 
   242     have "?s sums y" using sums_if'[OF `f sums y`] .
   243     from this[unfolded sums_def, THEN LIMSEQ_Suc]
   244     have "(\<lambda> n. if even n then f (n div 2) else 0) sums y"
   245       by (simp add: lessThan_Suc_eq_insert_0 image_iff setsum.reindex if_eq sums_def cong del: if_cong)
   246   }
   247   from sums_add[OF g_sums this] show ?thesis unfolding if_sum .
   248 qed
   249 
   250 subsection {* Alternating series test / Leibniz formula *}
   251 
   252 lemma sums_alternating_upper_lower:
   253   fixes a :: "nat \<Rightarrow> real"
   254   assumes mono: "\<And>n. a (Suc n) \<le> a n" and a_pos: "\<And>n. 0 \<le> a n" and "a ----> 0"
   255   shows "\<exists>l. ((\<forall>n. (\<Sum>i<2*n. (- 1)^i*a i) \<le> l) \<and> (\<lambda> n. \<Sum>i<2*n. (- 1)^i*a i) ----> l) \<and>
   256              ((\<forall>n. l \<le> (\<Sum>i<2*n + 1. (- 1)^i*a i)) \<and> (\<lambda> n. \<Sum>i<2*n + 1. (- 1)^i*a i) ----> l)"
   257   (is "\<exists>l. ((\<forall>n. ?f n \<le> l) \<and> _) \<and> ((\<forall>n. l \<le> ?g n) \<and> _)")
   258 proof (rule nested_sequence_unique)
   259   have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" unfolding One_nat_def by auto
   260 
   261   show "\<forall>n. ?f n \<le> ?f (Suc n)"
   262   proof
   263     fix n
   264     show "?f n \<le> ?f (Suc n)" using mono[of "2*n"] by auto
   265   qed
   266   show "\<forall>n. ?g (Suc n) \<le> ?g n"
   267   proof
   268     fix n
   269     show "?g (Suc n) \<le> ?g n" using mono[of "Suc (2*n)"]
   270       unfolding One_nat_def by auto
   271   qed
   272   show "\<forall>n. ?f n \<le> ?g n"
   273   proof
   274     fix n
   275     show "?f n \<le> ?g n" using fg_diff a_pos
   276       unfolding One_nat_def by auto
   277   qed
   278   show "(\<lambda>n. ?f n - ?g n) ----> 0" unfolding fg_diff
   279   proof (rule LIMSEQ_I)
   280     fix r :: real
   281     assume "0 < r"
   282     with `a ----> 0`[THEN LIMSEQ_D] obtain N where "\<And> n. n \<ge> N \<Longrightarrow> norm (a n - 0) < r"
   283       by auto
   284     hence "\<forall>n \<ge> N. norm (- a (2 * n) - 0) < r" by auto
   285     thus "\<exists>N. \<forall>n \<ge> N. norm (- a (2 * n) - 0) < r" by auto
   286   qed
   287 qed
   288 
   289 lemma summable_Leibniz':
   290   fixes a :: "nat \<Rightarrow> real"
   291   assumes a_zero: "a ----> 0"
   292     and a_pos: "\<And> n. 0 \<le> a n"
   293     and a_monotone: "\<And> n. a (Suc n) \<le> a n"
   294   shows summable: "summable (\<lambda> n. (-1)^n * a n)"
   295     and "\<And>n. (\<Sum>i<2*n. (-1)^i*a i) \<le> (\<Sum>i. (-1)^i*a i)"
   296     and "(\<lambda>n. \<Sum>i<2*n. (-1)^i*a i) ----> (\<Sum>i. (-1)^i*a i)"
   297     and "\<And>n. (\<Sum>i. (-1)^i*a i) \<le> (\<Sum>i<2*n+1. (-1)^i*a i)"
   298     and "(\<lambda>n. \<Sum>i<2*n+1. (-1)^i*a i) ----> (\<Sum>i. (-1)^i*a i)"
   299 proof -
   300   let ?S = "\<lambda>n. (-1)^n * a n"
   301   let ?P = "\<lambda>n. \<Sum>i<n. ?S i"
   302   let ?f = "\<lambda>n. ?P (2 * n)"
   303   let ?g = "\<lambda>n. ?P (2 * n + 1)"
   304   obtain l :: real
   305     where below_l: "\<forall> n. ?f n \<le> l"
   306       and "?f ----> l"
   307       and above_l: "\<forall> n. l \<le> ?g n"
   308       and "?g ----> l"
   309     using sums_alternating_upper_lower[OF a_monotone a_pos a_zero] by blast
   310 
   311   let ?Sa = "\<lambda>m. \<Sum>n<m. ?S n"
   312   have "?Sa ----> l"
   313   proof (rule LIMSEQ_I)
   314     fix r :: real
   315     assume "0 < r"
   316     with `?f ----> l`[THEN LIMSEQ_D]
   317     obtain f_no where f: "\<And> n. n \<ge> f_no \<Longrightarrow> norm (?f n - l) < r" by auto
   318 
   319     from `0 < r` `?g ----> l`[THEN LIMSEQ_D]
   320     obtain g_no where g: "\<And> n. n \<ge> g_no \<Longrightarrow> norm (?g n - l) < r" by auto
   321 
   322     {
   323       fix n :: nat
   324       assume "n \<ge> (max (2 * f_no) (2 * g_no))"
   325       hence "n \<ge> 2 * f_no" and "n \<ge> 2 * g_no" by auto
   326       have "norm (?Sa n - l) < r"
   327       proof (cases "even n")
   328         case True
   329         then have n_eq: "2 * (n div 2) = n" by (simp add: even_two_times_div_two)
   330         with `n \<ge> 2 * f_no` have "n div 2 \<ge> f_no"
   331           by auto
   332         from f[OF this] show ?thesis
   333           unfolding n_eq atLeastLessThanSuc_atLeastAtMost .
   334       next
   335         case False
   336         hence "even (n - 1)" by simp
   337         then have n_eq: "2 * ((n - 1) div 2) = n - 1"
   338           by (simp add: even_two_times_div_two)
   339         hence range_eq: "n - 1 + 1 = n"
   340           using odd_pos[OF False] by auto
   341 
   342         from n_eq `n \<ge> 2 * g_no` have "(n - 1) div 2 \<ge> g_no"
   343           by auto
   344         from g[OF this] show ?thesis
   345           unfolding n_eq range_eq .
   346       qed
   347     }
   348     thus "\<exists>no. \<forall>n \<ge> no. norm (?Sa n - l) < r" by blast
   349   qed
   350   hence sums_l: "(\<lambda>i. (-1)^i * a i) sums l"
   351     unfolding sums_def .
   352   thus "summable ?S" using summable_def by auto
   353 
   354   have "l = suminf ?S" using sums_unique[OF sums_l] .
   355 
   356   fix n
   357   show "suminf ?S \<le> ?g n"
   358     unfolding sums_unique[OF sums_l, symmetric] using above_l by auto
   359   show "?f n \<le> suminf ?S"
   360     unfolding sums_unique[OF sums_l, symmetric] using below_l by auto
   361   show "?g ----> suminf ?S"
   362     using `?g ----> l` `l = suminf ?S` by auto
   363   show "?f ----> suminf ?S"
   364     using `?f ----> l` `l = suminf ?S` by auto
   365 qed
   366 
   367 theorem summable_Leibniz:
   368   fixes a :: "nat \<Rightarrow> real"
   369   assumes a_zero: "a ----> 0" and "monoseq a"
   370   shows "summable (\<lambda> n. (-1)^n * a n)" (is "?summable")
   371     and "0 < a 0 \<longrightarrow>
   372       (\<forall>n. (\<Sum>i. (- 1)^i*a i) \<in> { \<Sum>i<2*n. (- 1)^i * a i .. \<Sum>i<2*n+1. (- 1)^i * a i})" (is "?pos")
   373     and "a 0 < 0 \<longrightarrow>
   374       (\<forall>n. (\<Sum>i. (- 1)^i*a i) \<in> { \<Sum>i<2*n+1. (- 1)^i * a i .. \<Sum>i<2*n. (- 1)^i * a i})" (is "?neg")
   375     and "(\<lambda>n. \<Sum>i<2*n. (- 1)^i*a i) ----> (\<Sum>i. (- 1)^i*a i)" (is "?f")
   376     and "(\<lambda>n. \<Sum>i<2*n+1. (- 1)^i*a i) ----> (\<Sum>i. (- 1)^i*a i)" (is "?g")
   377 proof -
   378   have "?summable \<and> ?pos \<and> ?neg \<and> ?f \<and> ?g"
   379   proof (cases "(\<forall> n. 0 \<le> a n) \<and> (\<forall>m. \<forall>n\<ge>m. a n \<le> a m)")
   380     case True
   381     hence ord: "\<And>n m. m \<le> n \<Longrightarrow> a n \<le> a m" and ge0: "\<And> n. 0 \<le> a n"
   382       by auto
   383     {
   384       fix n
   385       have "a (Suc n) \<le> a n"
   386         using ord[where n="Suc n" and m=n] by auto
   387     } note mono = this
   388     note leibniz = summable_Leibniz'[OF `a ----> 0` ge0]
   389     from leibniz[OF mono]
   390     show ?thesis using `0 \<le> a 0` by auto
   391   next
   392     let ?a = "\<lambda> n. - a n"
   393     case False
   394     with monoseq_le[OF `monoseq a` `a ----> 0`]
   395     have "(\<forall> n. a n \<le> 0) \<and> (\<forall>m. \<forall>n\<ge>m. a m \<le> a n)" by auto
   396     hence ord: "\<And>n m. m \<le> n \<Longrightarrow> ?a n \<le> ?a m" and ge0: "\<And> n. 0 \<le> ?a n"
   397       by auto
   398     {
   399       fix n
   400       have "?a (Suc n) \<le> ?a n" using ord[where n="Suc n" and m=n]
   401         by auto
   402     } note monotone = this
   403     note leibniz =
   404       summable_Leibniz'[OF _ ge0, of "\<lambda>x. x",
   405         OF tendsto_minus[OF `a ----> 0`, unfolded minus_zero] monotone]
   406     have "summable (\<lambda> n. (-1)^n * ?a n)"
   407       using leibniz(1) by auto
   408     then obtain l where "(\<lambda> n. (-1)^n * ?a n) sums l"
   409       unfolding summable_def by auto
   410     from this[THEN sums_minus] have "(\<lambda> n. (-1)^n * a n) sums -l"
   411       by auto
   412     hence ?summable unfolding summable_def by auto
   413     moreover
   414     have "\<And>a b :: real. \<bar>- a - - b\<bar> = \<bar>a - b\<bar>"
   415       unfolding minus_diff_minus by auto
   416 
   417     from suminf_minus[OF leibniz(1), unfolded mult_minus_right minus_minus]
   418     have move_minus: "(\<Sum>n. - ((- 1) ^ n * a n)) = - (\<Sum>n. (- 1) ^ n * a n)"
   419       by auto
   420 
   421     have ?pos using `0 \<le> ?a 0` by auto
   422     moreover have ?neg
   423       using leibniz(2,4)
   424       unfolding mult_minus_right setsum_negf move_minus neg_le_iff_le
   425       by auto
   426     moreover have ?f and ?g
   427       using leibniz(3,5)[unfolded mult_minus_right setsum_negf move_minus, THEN tendsto_minus_cancel]
   428       by auto
   429     ultimately show ?thesis by auto
   430   qed
   431   then show ?summable and ?pos and ?neg and ?f and ?g
   432     by safe
   433 qed
   434 
   435 subsection {* Term-by-Term Differentiability of Power Series *}
   436 
   437 definition diffs :: "(nat \<Rightarrow> 'a::ring_1) \<Rightarrow> nat \<Rightarrow> 'a"
   438   where "diffs c = (\<lambda>n. of_nat (Suc n) * c (Suc n))"
   439 
   440 text{*Lemma about distributing negation over it*}
   441 lemma diffs_minus: "diffs (\<lambda>n. - c n) = (\<lambda>n. - diffs c n)"
   442   by (simp add: diffs_def)
   443 
   444 lemma sums_Suc_imp:
   445   "(f::nat \<Rightarrow> 'a::real_normed_vector) 0 = 0 \<Longrightarrow> (\<lambda>n. f (Suc n)) sums s \<Longrightarrow> (\<lambda>n. f n) sums s"
   446   using sums_Suc_iff[of f] by simp
   447 
   448 lemma diffs_equiv:
   449   fixes x :: "'a::{real_normed_vector, ring_1}"
   450   shows "summable (\<lambda>n. diffs c n * x^n) \<Longrightarrow>
   451       (\<lambda>n. of_nat n * c n * x^(n - Suc 0)) sums (\<Sum>n. diffs c n * x^n)"
   452   unfolding diffs_def
   453   by (simp add: summable_sums sums_Suc_imp)
   454 
   455 lemma lemma_termdiff1:
   456   fixes z :: "'a :: {monoid_mult,comm_ring}" shows
   457   "(\<Sum>p<m. (((z + h) ^ (m - p)) * (z ^ p)) - (z ^ m)) =
   458    (\<Sum>p<m. (z ^ p) * (((z + h) ^ (m - p)) - (z ^ (m - p))))"
   459   by (auto simp add: algebra_simps power_add [symmetric])
   460 
   461 lemma sumr_diff_mult_const2:
   462   "setsum f {..<n} - of_nat n * (r::'a::ring_1) = (\<Sum>i<n. f i - r)"
   463   by (simp add: setsum_subtractf)
   464 
   465 lemma lemma_termdiff2:
   466   fixes h :: "'a :: {field}"
   467   assumes h: "h \<noteq> 0"
   468   shows
   469     "((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0) =
   470      h * (\<Sum>p< n - Suc 0. \<Sum>q< n - Suc 0 - p.
   471           (z + h) ^ q * z ^ (n - 2 - q))" (is "?lhs = ?rhs")
   472   apply (subgoal_tac "h * ?lhs = h * ?rhs", simp add: h)
   473   apply (simp add: right_diff_distrib diff_divide_distrib h)
   474   apply (simp add: mult.assoc [symmetric])
   475   apply (cases "n", simp)
   476   apply (simp add: lemma_realpow_diff_sumr2 h
   477                    right_diff_distrib [symmetric] mult.assoc
   478               del: power_Suc setsum_lessThan_Suc of_nat_Suc)
   479   apply (subst lemma_realpow_rev_sumr)
   480   apply (subst sumr_diff_mult_const2)
   481   apply simp
   482   apply (simp only: lemma_termdiff1 setsum_right_distrib)
   483   apply (rule setsum.cong [OF refl])
   484   apply (simp add: less_iff_Suc_add)
   485   apply (clarify)
   486   apply (simp add: setsum_right_distrib lemma_realpow_diff_sumr2 ac_simps
   487               del: setsum_lessThan_Suc power_Suc)
   488   apply (subst mult.assoc [symmetric], subst power_add [symmetric])
   489   apply (simp add: ac_simps)
   490   done
   491 
   492 lemma real_setsum_nat_ivl_bounded2:
   493   fixes K :: "'a::linordered_semidom"
   494   assumes f: "\<And>p::nat. p < n \<Longrightarrow> f p \<le> K"
   495     and K: "0 \<le> K"
   496   shows "setsum f {..<n-k} \<le> of_nat n * K"
   497   apply (rule order_trans [OF setsum_mono])
   498   apply (rule f, simp)
   499   apply (simp add: mult_right_mono K)
   500   done
   501 
   502 lemma lemma_termdiff3:
   503   fixes h z :: "'a::{real_normed_field}"
   504   assumes 1: "h \<noteq> 0"
   505     and 2: "norm z \<le> K"
   506     and 3: "norm (z + h) \<le> K"
   507   shows "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0))
   508           \<le> of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
   509 proof -
   510   have "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) =
   511         norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p.
   512           (z + h) ^ q * z ^ (n - 2 - q)) * norm h"
   513     by (metis (lifting, no_types) lemma_termdiff2 [OF 1] mult.commute norm_mult)
   514   also have "\<dots> \<le> of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2)) * norm h"
   515   proof (rule mult_right_mono [OF _ norm_ge_zero])
   516     from norm_ge_zero 2 have K: "0 \<le> K"
   517       by (rule order_trans)
   518     have le_Kn: "\<And>i j n. i + j = n \<Longrightarrow> norm ((z + h) ^ i * z ^ j) \<le> K ^ n"
   519       apply (erule subst)
   520       apply (simp only: norm_mult norm_power power_add)
   521       apply (intro mult_mono power_mono 2 3 norm_ge_zero zero_le_power K)
   522       done
   523     show "norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q))
   524           \<le> of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2))"
   525       apply (intro
   526          order_trans [OF norm_setsum]
   527          real_setsum_nat_ivl_bounded2
   528          mult_nonneg_nonneg
   529          of_nat_0_le_iff
   530          zero_le_power K)
   531       apply (rule le_Kn, simp)
   532       done
   533   qed
   534   also have "\<dots> = of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
   535     by (simp only: mult.assoc)
   536   finally show ?thesis .
   537 qed
   538 
   539 lemma lemma_termdiff4:
   540   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   541   assumes k: "0 < (k::real)"
   542     and le: "\<And>h. \<lbrakk>h \<noteq> 0; norm h < k\<rbrakk> \<Longrightarrow> norm (f h) \<le> K * norm h"
   543   shows "f -- 0 --> 0"
   544 proof (rule tendsto_norm_zero_cancel)
   545   show "(\<lambda>h. norm (f h)) -- 0 --> 0"
   546   proof (rule real_tendsto_sandwich)
   547     show "eventually (\<lambda>h. 0 \<le> norm (f h)) (at 0)"
   548       by simp
   549     show "eventually (\<lambda>h. norm (f h) \<le> K * norm h) (at 0)"
   550       using k by (auto simp add: eventually_at dist_norm le)
   551     show "(\<lambda>h. 0) -- (0::'a) --> (0::real)"
   552       by (rule tendsto_const)
   553     have "(\<lambda>h. K * norm h) -- (0::'a) --> K * norm (0::'a)"
   554       by (intro tendsto_intros)
   555     then show "(\<lambda>h. K * norm h) -- (0::'a) --> 0"
   556       by simp
   557   qed
   558 qed
   559 
   560 lemma lemma_termdiff5:
   561   fixes g :: "'a::real_normed_vector \<Rightarrow> nat \<Rightarrow> 'b::banach"
   562   assumes k: "0 < (k::real)"
   563   assumes f: "summable f"
   564   assumes le: "\<And>h n. \<lbrakk>h \<noteq> 0; norm h < k\<rbrakk> \<Longrightarrow> norm (g h n) \<le> f n * norm h"
   565   shows "(\<lambda>h. suminf (g h)) -- 0 --> 0"
   566 proof (rule lemma_termdiff4 [OF k])
   567   fix h::'a
   568   assume "h \<noteq> 0" and "norm h < k"
   569   hence A: "\<forall>n. norm (g h n) \<le> f n * norm h"
   570     by (simp add: le)
   571   hence "\<exists>N. \<forall>n\<ge>N. norm (norm (g h n)) \<le> f n * norm h"
   572     by simp
   573   moreover from f have B: "summable (\<lambda>n. f n * norm h)"
   574     by (rule summable_mult2)
   575   ultimately have C: "summable (\<lambda>n. norm (g h n))"
   576     by (rule summable_comparison_test)
   577   hence "norm (suminf (g h)) \<le> (\<Sum>n. norm (g h n))"
   578     by (rule summable_norm)
   579   also from A C B have "(\<Sum>n. norm (g h n)) \<le> (\<Sum>n. f n * norm h)"
   580     by (rule suminf_le)
   581   also from f have "(\<Sum>n. f n * norm h) = suminf f * norm h"
   582     by (rule suminf_mult2 [symmetric])
   583   finally show "norm (suminf (g h)) \<le> suminf f * norm h" .
   584 qed
   585 
   586 
   587 text{* FIXME: Long proofs*}
   588 
   589 lemma termdiffs_aux:
   590   fixes x :: "'a::{real_normed_field,banach}"
   591   assumes 1: "summable (\<lambda>n. diffs (diffs c) n * K ^ n)"
   592     and 2: "norm x < norm K"
   593   shows "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h
   594              - of_nat n * x ^ (n - Suc 0))) -- 0 --> 0"
   595 proof -
   596   from dense [OF 2]
   597   obtain r where r1: "norm x < r" and r2: "r < norm K" by fast
   598   from norm_ge_zero r1 have r: "0 < r"
   599     by (rule order_le_less_trans)
   600   hence r_neq_0: "r \<noteq> 0" by simp
   601   show ?thesis
   602   proof (rule lemma_termdiff5)
   603     show "0 < r - norm x" using r1 by simp
   604     from r r2 have "norm (of_real r::'a) < norm K"
   605       by simp
   606     with 1 have "summable (\<lambda>n. norm (diffs (diffs c) n * (of_real r ^ n)))"
   607       by (rule powser_insidea)
   608     hence "summable (\<lambda>n. diffs (diffs (\<lambda>n. norm (c n))) n * r ^ n)"
   609       using r
   610       by (simp add: diffs_def norm_mult norm_power del: of_nat_Suc)
   611     hence "summable (\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0))"
   612       by (rule diffs_equiv [THEN sums_summable])
   613     also have "(\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0)) =
   614       (\<lambda>n. diffs (\<lambda>m. of_nat (m - Suc 0) * norm (c m) * inverse r) n * (r ^ n))"
   615       apply (rule ext)
   616       apply (simp add: diffs_def)
   617       apply (case_tac n, simp_all add: r_neq_0)
   618       done
   619     finally have "summable
   620       (\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0))"
   621       by (rule diffs_equiv [THEN sums_summable])
   622     also have
   623       "(\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) *
   624            r ^ (n - Suc 0)) =
   625        (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))"
   626       apply (rule ext)
   627       apply (case_tac "n", simp)
   628       apply (rename_tac nat)
   629       apply (case_tac "nat", simp)
   630       apply (simp add: r_neq_0)
   631       done
   632     finally
   633     show "summable (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))" .
   634   next
   635     fix h::'a and n::nat
   636     assume h: "h \<noteq> 0"
   637     assume "norm h < r - norm x"
   638     hence "norm x + norm h < r" by simp
   639     with norm_triangle_ineq have xh: "norm (x + h) < r"
   640       by (rule order_le_less_trans)
   641     show "norm (c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0)))
   642           \<le> norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2) * norm h"
   643       apply (simp only: norm_mult mult.assoc)
   644       apply (rule mult_left_mono [OF _ norm_ge_zero])
   645       apply (simp add: mult.assoc [symmetric])
   646       apply (metis h lemma_termdiff3 less_eq_real_def r1 xh)
   647       done
   648   qed
   649 qed
   650 
   651 lemma termdiffs:
   652   fixes K x :: "'a::{real_normed_field,banach}"
   653   assumes 1: "summable (\<lambda>n. c n * K ^ n)"
   654       and 2: "summable (\<lambda>n. (diffs c) n * K ^ n)"
   655       and 3: "summable (\<lambda>n. (diffs (diffs c)) n * K ^ n)"
   656       and 4: "norm x < norm K"
   657   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. (diffs c) n * x^n)"
   658   unfolding DERIV_def
   659 proof (rule LIM_zero_cancel)
   660   show "(\<lambda>h. (suminf (\<lambda>n. c n * (x + h) ^ n) - suminf (\<lambda>n. c n * x^n)) / h
   661             - suminf (\<lambda>n. diffs c n * x^n)) -- 0 --> 0"
   662   proof (rule LIM_equal2)
   663     show "0 < norm K - norm x" using 4 by (simp add: less_diff_eq)
   664   next
   665     fix h :: 'a
   666     assume "norm (h - 0) < norm K - norm x"
   667     hence "norm x + norm h < norm K" by simp
   668     hence 5: "norm (x + h) < norm K"
   669       by (rule norm_triangle_ineq [THEN order_le_less_trans])
   670     have "summable (\<lambda>n. c n * x^n)"
   671       and "summable (\<lambda>n. c n * (x + h) ^ n)"
   672       and "summable (\<lambda>n. diffs c n * x^n)"
   673       using 1 2 4 5 by (auto elim: powser_inside)
   674     then have "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
   675           (\<Sum>n. (c n * (x + h) ^ n - c n * x^n) / h - of_nat n * c n * x ^ (n - Suc 0))"
   676       by (intro sums_unique sums_diff sums_divide diffs_equiv summable_sums)
   677     then show "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
   678           (\<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0)))"
   679       by (simp add: algebra_simps)
   680   next
   681     show "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) -- 0 --> 0"
   682       by (rule termdiffs_aux [OF 3 4])
   683   qed
   684 qed
   685 
   686 
   687 subsection {* Derivability of power series *}
   688 
   689 lemma DERIV_series':
   690   fixes f :: "real \<Rightarrow> nat \<Rightarrow> real"
   691   assumes DERIV_f: "\<And> n. DERIV (\<lambda> x. f x n) x0 :> (f' x0 n)"
   692     and allf_summable: "\<And> x. x \<in> {a <..< b} \<Longrightarrow> summable (f x)" and x0_in_I: "x0 \<in> {a <..< b}"
   693     and "summable (f' x0)"
   694     and "summable L"
   695     and L_def: "\<And>n x y. \<lbrakk> x \<in> { a <..< b} ; y \<in> { a <..< b} \<rbrakk> \<Longrightarrow> \<bar>f x n - f y n\<bar> \<le> L n * \<bar>x - y\<bar>"
   696   shows "DERIV (\<lambda> x. suminf (f x)) x0 :> (suminf (f' x0))"
   697   unfolding DERIV_def
   698 proof (rule LIM_I)
   699   fix r :: real
   700   assume "0 < r" hence "0 < r/3" by auto
   701 
   702   obtain N_L where N_L: "\<And> n. N_L \<le> n \<Longrightarrow> \<bar> \<Sum> i. L (i + n) \<bar> < r/3"
   703     using suminf_exist_split[OF `0 < r/3` `summable L`] by auto
   704 
   705   obtain N_f' where N_f': "\<And> n. N_f' \<le> n \<Longrightarrow> \<bar> \<Sum> i. f' x0 (i + n) \<bar> < r/3"
   706     using suminf_exist_split[OF `0 < r/3` `summable (f' x0)`] by auto
   707 
   708   let ?N = "Suc (max N_L N_f')"
   709   have "\<bar> \<Sum> i. f' x0 (i + ?N) \<bar> < r/3" (is "?f'_part < r/3") and
   710     L_estimate: "\<bar> \<Sum> i. L (i + ?N) \<bar> < r/3" using N_L[of "?N"] and N_f' [of "?N"] by auto
   711 
   712   let ?diff = "\<lambda>i x. (f (x0 + x) i - f x0 i) / x"
   713 
   714   let ?r = "r / (3 * real ?N)"
   715   from `0 < r` have "0 < ?r" by simp
   716 
   717   let ?s = "\<lambda>n. SOME s. 0 < s \<and> (\<forall> x. x \<noteq> 0 \<and> \<bar> x \<bar> < s \<longrightarrow> \<bar> ?diff n x - f' x0 n \<bar> < ?r)"
   718   def S' \<equiv> "Min (?s ` {..< ?N })"
   719 
   720   have "0 < S'" unfolding S'_def
   721   proof (rule iffD2[OF Min_gr_iff])
   722     show "\<forall>x \<in> (?s ` {..< ?N }). 0 < x"
   723     proof
   724       fix x
   725       assume "x \<in> ?s ` {..<?N}"
   726       then obtain n where "x = ?s n" and "n \<in> {..<?N}"
   727         using image_iff[THEN iffD1] by blast
   728       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF `0 < ?r`, unfolded real_norm_def]
   729       obtain s where s_bound: "0 < s \<and> (\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < s \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r)"
   730         by auto
   731       have "0 < ?s n" by (rule someI2[where a=s]) (auto simp add: s_bound)
   732       thus "0 < x" unfolding `x = ?s n` .
   733     qed
   734   qed auto
   735 
   736   def S \<equiv> "min (min (x0 - a) (b - x0)) S'"
   737   hence "0 < S" and S_a: "S \<le> x0 - a" and S_b: "S \<le> b - x0"
   738     and "S \<le> S'" using x0_in_I and `0 < S'`
   739     by auto
   740 
   741   {
   742     fix x
   743     assume "x \<noteq> 0" and "\<bar> x \<bar> < S"
   744     hence x_in_I: "x0 + x \<in> { a <..< b }"
   745       using S_a S_b by auto
   746 
   747     note diff_smbl = summable_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
   748     note div_smbl = summable_divide[OF diff_smbl]
   749     note all_smbl = summable_diff[OF div_smbl `summable (f' x0)`]
   750     note ign = summable_ignore_initial_segment[where k="?N"]
   751     note diff_shft_smbl = summable_diff[OF ign[OF allf_summable[OF x_in_I]] ign[OF allf_summable[OF x0_in_I]]]
   752     note div_shft_smbl = summable_divide[OF diff_shft_smbl]
   753     note all_shft_smbl = summable_diff[OF div_smbl ign[OF `summable (f' x0)`]]
   754 
   755     { fix n
   756       have "\<bar> ?diff (n + ?N) x \<bar> \<le> L (n + ?N) * \<bar> (x0 + x) - x0 \<bar> / \<bar> x \<bar>"
   757         using divide_right_mono[OF L_def[OF x_in_I x0_in_I] abs_ge_zero]
   758         unfolding abs_divide .
   759       hence "\<bar> (\<bar>?diff (n + ?N) x \<bar>) \<bar> \<le> L (n + ?N)"
   760         using `x \<noteq> 0` by auto }
   761     note 1 = this and 2 = summable_rabs_comparison_test[OF _ ign[OF `summable L`]]
   762     then have "\<bar> \<Sum> i. ?diff (i + ?N) x \<bar> \<le> (\<Sum> i. L (i + ?N))"
   763       by (metis (lifting) abs_idempotent order_trans[OF summable_rabs[OF 2] suminf_le[OF _ 2 ign[OF `summable L`]]])
   764     then have "\<bar> \<Sum> i. ?diff (i + ?N) x \<bar> \<le> r / 3" (is "?L_part \<le> r/3")
   765       using L_estimate by auto
   766 
   767     have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n \<bar> \<le> (\<Sum>n<?N. \<bar>?diff n x - f' x0 n \<bar>)" ..
   768     also have "\<dots> < (\<Sum>n<?N. ?r)"
   769     proof (rule setsum_strict_mono)
   770       fix n
   771       assume "n \<in> {..< ?N}"
   772       have "\<bar>x\<bar> < S" using `\<bar>x\<bar> < S` .
   773       also have "S \<le> S'" using `S \<le> S'` .
   774       also have "S' \<le> ?s n" unfolding S'_def
   775       proof (rule Min_le_iff[THEN iffD2])
   776         have "?s n \<in> (?s ` {..<?N}) \<and> ?s n \<le> ?s n"
   777           using `n \<in> {..< ?N}` by auto
   778         thus "\<exists> a \<in> (?s ` {..<?N}). a \<le> ?s n" by blast
   779       qed auto
   780       finally have "\<bar>x\<bar> < ?s n" .
   781 
   782       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF `0 < ?r`, unfolded real_norm_def diff_0_right, unfolded some_eq_ex[symmetric], THEN conjunct2]
   783       have "\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < ?s n \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r" .
   784       with `x \<noteq> 0` and `\<bar>x\<bar> < ?s n` show "\<bar>?diff n x - f' x0 n\<bar> < ?r"
   785         by blast
   786     qed auto
   787     also have "\<dots> = of_nat (card {..<?N}) * ?r"
   788       by (rule setsum_constant)
   789     also have "\<dots> = real ?N * ?r"
   790       unfolding real_eq_of_nat by auto
   791     also have "\<dots> = r/3" by auto
   792     finally have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n \<bar> < r / 3" (is "?diff_part < r / 3") .
   793 
   794     from suminf_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
   795     have "\<bar>(suminf (f (x0 + x)) - (suminf (f x0))) / x - suminf (f' x0)\<bar> =
   796         \<bar>\<Sum>n. ?diff n x - f' x0 n\<bar>"
   797       unfolding suminf_diff[OF div_smbl `summable (f' x0)`, symmetric]
   798       using suminf_divide[OF diff_smbl, symmetric] by auto
   799     also have "\<dots> \<le> ?diff_part + \<bar> (\<Sum>n. ?diff (n + ?N) x) - (\<Sum> n. f' x0 (n + ?N)) \<bar>"
   800       unfolding suminf_split_initial_segment[OF all_smbl, where k="?N"]
   801       unfolding suminf_diff[OF div_shft_smbl ign[OF `summable (f' x0)`]]
   802       apply (subst (5) add.commute)
   803       by (rule abs_triangle_ineq)
   804     also have "\<dots> \<le> ?diff_part + ?L_part + ?f'_part"
   805       using abs_triangle_ineq4 by auto
   806     also have "\<dots> < r /3 + r/3 + r/3"
   807       using `?diff_part < r/3` `?L_part \<le> r/3` and `?f'_part < r/3`
   808       by (rule add_strict_mono [OF add_less_le_mono])
   809     finally have "\<bar>(suminf (f (x0 + x)) - suminf (f x0)) / x - suminf (f' x0)\<bar> < r"
   810       by auto
   811   }
   812   thus "\<exists> s > 0. \<forall> x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow>
   813       norm (((\<Sum>n. f (x0 + x) n) - (\<Sum>n. f x0 n)) / x - (\<Sum>n. f' x0 n)) < r"
   814     using `0 < S` unfolding real_norm_def diff_0_right by blast
   815 qed
   816 
   817 lemma DERIV_power_series':
   818   fixes f :: "nat \<Rightarrow> real"
   819   assumes converges: "\<And> x. x \<in> {-R <..< R} \<Longrightarrow> summable (\<lambda> n. f n * real (Suc n) * x^n)"
   820     and x0_in_I: "x0 \<in> {-R <..< R}" and "0 < R"
   821   shows "DERIV (\<lambda> x. (\<Sum> n. f n * x^(Suc n))) x0 :> (\<Sum> n. f n * real (Suc n) * x0^n)"
   822   (is "DERIV (\<lambda> x. (suminf (?f x))) x0 :> (suminf (?f' x0))")
   823 proof -
   824   {
   825     fix R'
   826     assume "0 < R'" and "R' < R" and "-R' < x0" and "x0 < R'"
   827     hence "x0 \<in> {-R' <..< R'}" and "R' \<in> {-R <..< R}" and "x0 \<in> {-R <..< R}"
   828       by auto
   829     have "DERIV (\<lambda> x. (suminf (?f x))) x0 :> (suminf (?f' x0))"
   830     proof (rule DERIV_series')
   831       show "summable (\<lambda> n. \<bar>f n * real (Suc n) * R'^n\<bar>)"
   832       proof -
   833         have "(R' + R) / 2 < R" and "0 < (R' + R) / 2"
   834           using `0 < R'` `0 < R` `R' < R` by auto
   835         hence in_Rball: "(R' + R) / 2 \<in> {-R <..< R}"
   836           using `R' < R` by auto
   837         have "norm R' < norm ((R' + R) / 2)"
   838           using `0 < R'` `0 < R` `R' < R` by auto
   839         from powser_insidea[OF converges[OF in_Rball] this] show ?thesis
   840           by auto
   841       qed
   842       {
   843         fix n x y
   844         assume "x \<in> {-R' <..< R'}" and "y \<in> {-R' <..< R'}"
   845         show "\<bar>?f x n - ?f y n\<bar> \<le> \<bar>f n * real (Suc n) * R'^n\<bar> * \<bar>x-y\<bar>"
   846         proof -
   847           have "\<bar>f n * x ^ (Suc n) - f n * y ^ (Suc n)\<bar> =
   848             (\<bar>f n\<bar> * \<bar>x-y\<bar>) * \<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar>"
   849             unfolding right_diff_distrib[symmetric] lemma_realpow_diff_sumr2 abs_mult
   850             by auto
   851           also have "\<dots> \<le> (\<bar>f n\<bar> * \<bar>x-y\<bar>) * (\<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>)"
   852           proof (rule mult_left_mono)
   853             have "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> (\<Sum>p<Suc n. \<bar>x ^ p * y ^ (n - p)\<bar>)"
   854               by (rule setsum_abs)
   855             also have "\<dots> \<le> (\<Sum>p<Suc n. R' ^ n)"
   856             proof (rule setsum_mono)
   857               fix p
   858               assume "p \<in> {..<Suc n}"
   859               hence "p \<le> n" by auto
   860               {
   861                 fix n
   862                 fix x :: real
   863                 assume "x \<in> {-R'<..<R'}"
   864                 hence "\<bar>x\<bar> \<le> R'"  by auto
   865                 hence "\<bar>x^n\<bar> \<le> R'^n"
   866                   unfolding power_abs by (rule power_mono, auto)
   867               }
   868               from mult_mono[OF this[OF `x \<in> {-R'<..<R'}`, of p] this[OF `y \<in> {-R'<..<R'}`, of "n-p"]] `0 < R'`
   869               have "\<bar>x^p * y^(n-p)\<bar> \<le> R'^p * R'^(n-p)"
   870                 unfolding abs_mult by auto
   871               thus "\<bar>x^p * y^(n-p)\<bar> \<le> R'^n"
   872                 unfolding power_add[symmetric] using `p \<le> n` by auto
   873             qed
   874             also have "\<dots> = real (Suc n) * R' ^ n"
   875               unfolding setsum_constant card_atLeastLessThan real_of_nat_def by auto
   876             finally show "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> \<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>"
   877               unfolding abs_real_of_nat_cancel abs_of_nonneg[OF zero_le_power[OF less_imp_le[OF `0 < R'`]]] .
   878             show "0 \<le> \<bar>f n\<bar> * \<bar>x - y\<bar>"
   879               unfolding abs_mult[symmetric] by auto
   880           qed
   881           also have "\<dots> = \<bar>f n * real (Suc n) * R' ^ n\<bar> * \<bar>x - y\<bar>"
   882             unfolding abs_mult mult.assoc[symmetric] by algebra
   883           finally show ?thesis .
   884         qed
   885       }
   886       {
   887         fix n
   888         show "DERIV (\<lambda> x. ?f x n) x0 :> (?f' x0 n)"
   889           by (auto intro!: derivative_eq_intros simp del: power_Suc simp: real_of_nat_def)
   890       }
   891       {
   892         fix x
   893         assume "x \<in> {-R' <..< R'}"
   894         hence "R' \<in> {-R <..< R}" and "norm x < norm R'"
   895           using assms `R' < R` by auto
   896         have "summable (\<lambda> n. f n * x^n)"
   897         proof (rule summable_comparison_test, intro exI allI impI)
   898           fix n
   899           have le: "\<bar>f n\<bar> * 1 \<le> \<bar>f n\<bar> * real (Suc n)"
   900             by (rule mult_left_mono) auto
   901           show "norm (f n * x^n) \<le> norm (f n * real (Suc n) * x^n)"
   902             unfolding real_norm_def abs_mult
   903             by (rule mult_right_mono) (auto simp add: le[unfolded mult_1_right])
   904         qed (rule powser_insidea[OF converges[OF `R' \<in> {-R <..< R}`] `norm x < norm R'`])
   905         from this[THEN summable_mult2[where c=x], unfolded mult.assoc, unfolded mult.commute]
   906         show "summable (?f x)" by auto
   907       }
   908       show "summable (?f' x0)"
   909         using converges[OF `x0 \<in> {-R <..< R}`] .
   910       show "x0 \<in> {-R' <..< R'}"
   911         using `x0 \<in> {-R' <..< R'}` .
   912     qed
   913   } note for_subinterval = this
   914   let ?R = "(R + \<bar>x0\<bar>) / 2"
   915   have "\<bar>x0\<bar> < ?R" using assms by auto
   916   hence "- ?R < x0"
   917   proof (cases "x0 < 0")
   918     case True
   919     hence "- x0 < ?R" using `\<bar>x0\<bar> < ?R` by auto
   920     thus ?thesis unfolding neg_less_iff_less[symmetric, of "- x0"] by auto
   921   next
   922     case False
   923     have "- ?R < 0" using assms by auto
   924     also have "\<dots> \<le> x0" using False by auto
   925     finally show ?thesis .
   926   qed
   927   hence "0 < ?R" "?R < R" "- ?R < x0" and "x0 < ?R"
   928     using assms by auto
   929   from for_subinterval[OF this]
   930   show ?thesis .
   931 qed
   932 
   933 
   934 subsection {* Exponential Function *}
   935 
   936 definition exp :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   937   where "exp = (\<lambda>x. \<Sum>n. x^n /\<^sub>R fact n)"
   938 
   939 lemma summable_exp_generic:
   940   fixes x :: "'a::{real_normed_algebra_1,banach}"
   941   defines S_def: "S \<equiv> \<lambda>n. x^n /\<^sub>R fact n"
   942   shows "summable S"
   943 proof -
   944   have S_Suc: "\<And>n. S (Suc n) = (x * S n) /\<^sub>R (Suc n)"
   945     unfolding S_def by (simp del: mult_Suc)
   946   obtain r :: real where r0: "0 < r" and r1: "r < 1"
   947     using dense [OF zero_less_one] by fast
   948   obtain N :: nat where N: "norm x < real N * r"
   949     using reals_Archimedean3 [OF r0] by fast
   950   from r1 show ?thesis
   951   proof (rule summable_ratio_test [rule_format])
   952     fix n :: nat
   953     assume n: "N \<le> n"
   954     have "norm x \<le> real N * r"
   955       using N by (rule order_less_imp_le)
   956     also have "real N * r \<le> real (Suc n) * r"
   957       using r0 n by (simp add: mult_right_mono)
   958     finally have "norm x * norm (S n) \<le> real (Suc n) * r * norm (S n)"
   959       using norm_ge_zero by (rule mult_right_mono)
   960     hence "norm (x * S n) \<le> real (Suc n) * r * norm (S n)"
   961       by (rule order_trans [OF norm_mult_ineq])
   962     hence "norm (x * S n) / real (Suc n) \<le> r * norm (S n)"
   963       by (simp add: pos_divide_le_eq ac_simps)
   964     thus "norm (S (Suc n)) \<le> r * norm (S n)"
   965       by (simp add: S_Suc inverse_eq_divide)
   966   qed
   967 qed
   968 
   969 lemma summable_norm_exp:
   970   fixes x :: "'a::{real_normed_algebra_1,banach}"
   971   shows "summable (\<lambda>n. norm (x^n /\<^sub>R fact n))"
   972 proof (rule summable_norm_comparison_test [OF exI, rule_format])
   973   show "summable (\<lambda>n. norm x^n /\<^sub>R fact n)"
   974     by (rule summable_exp_generic)
   975   fix n
   976   show "norm (x^n /\<^sub>R fact n) \<le> norm x^n /\<^sub>R fact n"
   977     by (simp add: norm_power_ineq)
   978 qed
   979 
   980 lemma summable_exp: 
   981   fixes x :: "'a::{real_normed_field,banach}"
   982   shows "summable (\<lambda>n. inverse (fact n) * x^n)"
   983   using summable_exp_generic [where x=x]
   984   by (simp add: scaleR_conv_of_real nonzero_of_real_inverse)
   985 
   986 lemma exp_converges: "(\<lambda>n. x^n /\<^sub>R fact n) sums exp x"
   987   unfolding exp_def by (rule summable_exp_generic [THEN summable_sums])
   988 
   989 lemma exp_fdiffs:
   990   fixes XXX :: "'a::{real_normed_field,banach}"
   991   shows "diffs (\<lambda>n. inverse (fact n)) = (\<lambda>n. inverse (fact n :: 'a))"
   992   by (simp add: diffs_def mult_ac nonzero_inverse_mult_distrib nonzero_of_real_inverse
   993            del: mult_Suc of_nat_Suc)
   994 
   995 lemma diffs_of_real: "diffs (\<lambda>n. of_real (f n)) = (\<lambda>n. of_real (diffs f n))"
   996   by (simp add: diffs_def)
   997 
   998 lemma DERIV_exp [simp]: "DERIV exp x :> exp(x)"
   999   unfolding exp_def scaleR_conv_of_real
  1000   apply (rule DERIV_cong)
  1001   apply (rule termdiffs [where K="of_real (1 + norm x)"])
  1002   apply (simp_all only: diffs_of_real scaleR_conv_of_real exp_fdiffs)
  1003   apply (rule exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real])+
  1004   apply (simp del: of_real_add)
  1005   done
  1006 
  1007 declare DERIV_exp[THEN DERIV_chain2, derivative_intros]
  1008 
  1009 lemma norm_exp: "norm (exp x) \<le> exp (norm x)"
  1010 proof -
  1011   from summable_norm[OF summable_norm_exp, of x]
  1012   have "norm (exp x) \<le> (\<Sum>n. inverse (fact n) * norm (x^n))"
  1013     by (simp add: exp_def)
  1014   also have "\<dots> \<le> exp (norm x)"
  1015     using summable_exp_generic[of "norm x"] summable_norm_exp[of x]
  1016     by (auto simp: exp_def intro!: suminf_le norm_power_ineq)
  1017   finally show ?thesis .
  1018 qed
  1019 
  1020 lemma isCont_exp:
  1021   fixes x::"'a::{real_normed_field,banach}"
  1022   shows "isCont exp x"
  1023   by (rule DERIV_exp [THEN DERIV_isCont])
  1024 
  1025 lemma isCont_exp' [simp]:
  1026   fixes f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1027   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. exp (f x)) a"
  1028   by (rule isCont_o2 [OF _ isCont_exp])
  1029 
  1030 lemma tendsto_exp [tendsto_intros]:
  1031   fixes f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1032   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. exp (f x)) ---> exp a) F"
  1033   by (rule isCont_tendsto_compose [OF isCont_exp])
  1034 
  1035 lemma continuous_exp [continuous_intros]:
  1036   fixes f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1037   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. exp (f x))"
  1038   unfolding continuous_def by (rule tendsto_exp)
  1039 
  1040 lemma continuous_on_exp [continuous_intros]:
  1041   fixes f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1042   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. exp (f x))"
  1043   unfolding continuous_on_def by (auto intro: tendsto_exp)
  1044 
  1045 
  1046 subsubsection {* Properties of the Exponential Function *}
  1047 
  1048 lemma powser_zero:
  1049   fixes f :: "nat \<Rightarrow> 'a::{real_normed_algebra_1}"
  1050   shows "(\<Sum>n. f n * 0 ^ n) = f 0"
  1051 proof -
  1052   have "(\<Sum>n<1. f n * 0 ^ n) = (\<Sum>n. f n * 0 ^ n)"
  1053     by (subst suminf_finite[where N="{0}"]) (auto simp: power_0_left)
  1054   thus ?thesis unfolding One_nat_def by simp
  1055 qed
  1056 
  1057 lemma exp_zero [simp]: "exp 0 = 1"
  1058   unfolding exp_def by (simp add: scaleR_conv_of_real powser_zero)
  1059 
  1060 lemma exp_series_add_commuting:
  1061   fixes x y :: "'a::{real_normed_algebra_1, banach}"
  1062   defines S_def: "S \<equiv> \<lambda>x n. x^n /\<^sub>R fact n"
  1063   assumes comm: "x * y = y * x"
  1064   shows "S (x + y) n = (\<Sum>i\<le>n. S x i * S y (n - i))"
  1065 proof (induct n)
  1066   case 0
  1067   show ?case
  1068     unfolding S_def by simp
  1069 next
  1070   case (Suc n)
  1071   have S_Suc: "\<And>x n. S x (Suc n) = (x * S x n) /\<^sub>R real (Suc n)"
  1072     unfolding S_def by (simp del: mult_Suc)
  1073   hence times_S: "\<And>x n. x * S x n = real (Suc n) *\<^sub>R S x (Suc n)"
  1074     by simp
  1075   have S_comm: "\<And>n. S x n * y = y * S x n"
  1076     by (simp add: power_commuting_commutes comm S_def)
  1077 
  1078   have "real (Suc n) *\<^sub>R S (x + y) (Suc n) = (x + y) * S (x + y) n"
  1079     by (simp only: times_S)
  1080   also have "\<dots> = (x + y) * (\<Sum>i\<le>n. S x i * S y (n-i))"
  1081     by (simp only: Suc)
  1082   also have "\<dots> = x * (\<Sum>i\<le>n. S x i * S y (n-i))
  1083                 + y * (\<Sum>i\<le>n. S x i * S y (n-i))"
  1084     by (rule distrib_right)
  1085   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n-i))
  1086                 + (\<Sum>i\<le>n. S x i * y * S y (n-i))"
  1087     by (simp add: setsum_right_distrib ac_simps S_comm)
  1088   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n-i))
  1089                 + (\<Sum>i\<le>n. S x i * (y * S y (n-i)))"
  1090     by (simp add: ac_simps)
  1091   also have "\<dots> = (\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n-i)))
  1092                 + (\<Sum>i\<le>n. real (Suc n-i) *\<^sub>R (S x i * S y (Suc n-i)))"
  1093     by (simp add: times_S Suc_diff_le)
  1094   also have "(\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n-i))) =
  1095              (\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n-i)))"
  1096     by (subst setsum_atMost_Suc_shift) simp
  1097   also have "(\<Sum>i\<le>n. real (Suc n-i) *\<^sub>R (S x i * S y (Suc n-i))) =
  1098              (\<Sum>i\<le>Suc n. real (Suc n-i) *\<^sub>R (S x i * S y (Suc n-i)))"
  1099     by simp
  1100   also have "(\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n-i))) +
  1101              (\<Sum>i\<le>Suc n. real (Suc n-i) *\<^sub>R (S x i * S y (Suc n-i))) =
  1102              (\<Sum>i\<le>Suc n. real (Suc n) *\<^sub>R (S x i * S y (Suc n-i)))"
  1103     by (simp only: setsum.distrib [symmetric] scaleR_left_distrib [symmetric]
  1104                    real_of_nat_add [symmetric]) simp
  1105   also have "\<dots> = real (Suc n) *\<^sub>R (\<Sum>i\<le>Suc n. S x i * S y (Suc n-i))"
  1106     by (simp only: scaleR_right.setsum)
  1107   finally show
  1108     "S (x + y) (Suc n) = (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
  1109     by (simp del: setsum_cl_ivl_Suc)
  1110 qed
  1111 
  1112 lemma exp_add_commuting: "x * y = y * x \<Longrightarrow> exp (x + y) = exp x * exp y"
  1113   unfolding exp_def
  1114   by (simp only: Cauchy_product summable_norm_exp exp_series_add_commuting)
  1115 
  1116 lemma exp_add:
  1117   fixes x y::"'a::{real_normed_field,banach}"
  1118   shows "exp (x + y) = exp x * exp y"
  1119   by (rule exp_add_commuting) (simp add: ac_simps)
  1120 
  1121 lemma exp_double: "exp(2 * z) = exp z ^ 2"
  1122   by (simp add: exp_add_commuting mult_2 power2_eq_square)
  1123 
  1124 lemmas mult_exp_exp = exp_add [symmetric]
  1125 
  1126 lemma exp_of_real: "exp (of_real x) = of_real (exp x)"
  1127   unfolding exp_def
  1128   apply (subst suminf_of_real)
  1129   apply (rule summable_exp_generic)
  1130   apply (simp add: scaleR_conv_of_real)
  1131   done
  1132 
  1133 lemma exp_not_eq_zero [simp]: "exp x \<noteq> 0"
  1134 proof
  1135   have "exp x * exp (- x) = 1" by (simp add: exp_add_commuting[symmetric])
  1136   also assume "exp x = 0"
  1137   finally show "False" by simp
  1138 qed
  1139 
  1140 lemma exp_minus_inverse:
  1141   shows "exp x * exp (- x) = 1"
  1142   by (simp add: exp_add_commuting[symmetric])
  1143 
  1144 lemma exp_minus:
  1145   fixes x :: "'a::{real_normed_field, banach}"
  1146   shows "exp (- x) = inverse (exp x)"
  1147   by (intro inverse_unique [symmetric] exp_minus_inverse)
  1148 
  1149 lemma exp_diff:
  1150   fixes x :: "'a::{real_normed_field, banach}"
  1151   shows "exp (x - y) = exp x / exp y"
  1152   using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)
  1153 
  1154 lemma exp_of_nat_mult:
  1155   fixes x :: "'a::{real_normed_field,banach}"
  1156   shows "exp(of_nat n * x) = exp(x) ^ n"
  1157     by (induct n) (auto simp add: distrib_left exp_add mult.commute)
  1158 
  1159 lemma exp_setsum: "finite I \<Longrightarrow> exp(setsum f I) = setprod (\<lambda>x. exp(f x)) I"
  1160   by (induction I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)
  1161 
  1162 
  1163 subsubsection {* Properties of the Exponential Function on Reals *}
  1164 
  1165 text {* Comparisons of @{term "exp x"} with zero. *}
  1166 
  1167 text{*Proof: because every exponential can be seen as a square.*}
  1168 lemma exp_ge_zero [simp]: "0 \<le> exp (x::real)"
  1169 proof -
  1170   have "0 \<le> exp (x/2) * exp (x/2)" by simp
  1171   thus ?thesis by (simp add: exp_add [symmetric])
  1172 qed
  1173 
  1174 lemma exp_gt_zero [simp]: "0 < exp (x::real)"
  1175   by (simp add: order_less_le)
  1176 
  1177 lemma not_exp_less_zero [simp]: "\<not> exp (x::real) < 0"
  1178   by (simp add: not_less)
  1179 
  1180 lemma not_exp_le_zero [simp]: "\<not> exp (x::real) \<le> 0"
  1181   by (simp add: not_le)
  1182 
  1183 lemma abs_exp_cancel [simp]: "\<bar>exp x::real\<bar> = exp x"
  1184   by simp
  1185 
  1186 (*FIXME: superseded by exp_of_nat_mult*)
  1187 lemma exp_real_of_nat_mult: "exp(real n * x) = exp(x) ^ n"
  1188   by (induct n) (auto simp add: real_of_nat_Suc distrib_left exp_add mult.commute)
  1189 
  1190 text {* Strict monotonicity of exponential. *}
  1191 
  1192 lemma exp_ge_add_one_self_aux:
  1193   assumes "0 \<le> (x::real)" shows "1+x \<le> exp(x)"
  1194 using order_le_imp_less_or_eq [OF assms]
  1195 proof
  1196   assume "0 < x"
  1197   have "1+x \<le> (\<Sum>n<2. inverse (fact n) * x^n)"
  1198     by (auto simp add: numeral_2_eq_2)
  1199   also have "... \<le> (\<Sum>n. inverse (fact n) * x^n)"
  1200     apply (rule setsum_le_suminf [OF summable_exp])
  1201     using `0 < x`
  1202     apply (auto  simp add:  zero_le_mult_iff)
  1203     done
  1204   finally show "1+x \<le> exp x"
  1205     by (simp add: exp_def)
  1206 next
  1207   assume "0 = x"
  1208   then show "1 + x \<le> exp x"
  1209     by auto
  1210 qed
  1211 
  1212 lemma exp_gt_one: "0 < (x::real) \<Longrightarrow> 1 < exp x"
  1213 proof -
  1214   assume x: "0 < x"
  1215   hence "1 < 1 + x" by simp
  1216   also from x have "1 + x \<le> exp x"
  1217     by (simp add: exp_ge_add_one_self_aux)
  1218   finally show ?thesis .
  1219 qed
  1220 
  1221 lemma exp_less_mono:
  1222   fixes x y :: real
  1223   assumes "x < y"
  1224   shows "exp x < exp y"
  1225 proof -
  1226   from `x < y` have "0 < y - x" by simp
  1227   hence "1 < exp (y - x)" by (rule exp_gt_one)
  1228   hence "1 < exp y / exp x" by (simp only: exp_diff)
  1229   thus "exp x < exp y" by simp
  1230 qed
  1231 
  1232 lemma exp_less_cancel: "exp (x::real) < exp y \<Longrightarrow> x < y"
  1233   unfolding linorder_not_le [symmetric]
  1234   by (auto simp add: order_le_less exp_less_mono)
  1235 
  1236 lemma exp_less_cancel_iff [iff]: "exp (x::real) < exp y \<longleftrightarrow> x < y"
  1237   by (auto intro: exp_less_mono exp_less_cancel)
  1238 
  1239 lemma exp_le_cancel_iff [iff]: "exp (x::real) \<le> exp y \<longleftrightarrow> x \<le> y"
  1240   by (auto simp add: linorder_not_less [symmetric])
  1241 
  1242 lemma exp_inj_iff [iff]: "exp (x::real) = exp y \<longleftrightarrow> x = y"
  1243   by (simp add: order_eq_iff)
  1244 
  1245 text {* Comparisons of @{term "exp x"} with one. *}
  1246 
  1247 lemma one_less_exp_iff [simp]: "1 < exp (x::real) \<longleftrightarrow> 0 < x"
  1248   using exp_less_cancel_iff [where x=0 and y=x] by simp
  1249 
  1250 lemma exp_less_one_iff [simp]: "exp (x::real) < 1 \<longleftrightarrow> x < 0"
  1251   using exp_less_cancel_iff [where x=x and y=0] by simp
  1252 
  1253 lemma one_le_exp_iff [simp]: "1 \<le> exp (x::real) \<longleftrightarrow> 0 \<le> x"
  1254   using exp_le_cancel_iff [where x=0 and y=x] by simp
  1255 
  1256 lemma exp_le_one_iff [simp]: "exp (x::real) \<le> 1 \<longleftrightarrow> x \<le> 0"
  1257   using exp_le_cancel_iff [where x=x and y=0] by simp
  1258 
  1259 lemma exp_eq_one_iff [simp]: "exp (x::real) = 1 \<longleftrightarrow> x = 0"
  1260   using exp_inj_iff [where x=x and y=0] by simp
  1261 
  1262 lemma lemma_exp_total: "1 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x & x \<le> y - 1 & exp(x::real) = y"
  1263 proof (rule IVT)
  1264   assume "1 \<le> y"
  1265   hence "0 \<le> y - 1" by simp
  1266   hence "1 + (y - 1) \<le> exp (y - 1)" by (rule exp_ge_add_one_self_aux)
  1267   thus "y \<le> exp (y - 1)" by simp
  1268 qed (simp_all add: le_diff_eq)
  1269 
  1270 lemma exp_total: "0 < (y::real) \<Longrightarrow> \<exists>x. exp x = y"
  1271 proof (rule linorder_le_cases [of 1 y])
  1272   assume "1 \<le> y"
  1273   thus "\<exists>x. exp x = y" by (fast dest: lemma_exp_total)
  1274 next
  1275   assume "0 < y" and "y \<le> 1"
  1276   hence "1 \<le> inverse y" by (simp add: one_le_inverse_iff)
  1277   then obtain x where "exp x = inverse y" by (fast dest: lemma_exp_total)
  1278   hence "exp (- x) = y" by (simp add: exp_minus)
  1279   thus "\<exists>x. exp x = y" ..
  1280 qed
  1281 
  1282 
  1283 subsection {* Natural Logarithm *}
  1284 
  1285 definition ln :: "real \<Rightarrow> real"
  1286   where "ln x = (THE u. exp u = x)"
  1287 
  1288 lemma ln_exp [simp]: "ln (exp x) = x"
  1289   by (simp add: ln_def)
  1290 
  1291 lemma exp_ln [simp]: "0 < x \<Longrightarrow> exp (ln x) = x"
  1292   by (auto dest: exp_total)
  1293 
  1294 lemma exp_ln_iff [simp]: "exp (ln x) = x \<longleftrightarrow> 0 < x"
  1295   by (metis exp_gt_zero exp_ln)
  1296 
  1297 lemma ln_unique: "exp y = x \<Longrightarrow> ln x = y"
  1298   by (erule subst, rule ln_exp)
  1299 
  1300 lemma ln_one [simp]: "ln 1 = 0"
  1301   by (rule ln_unique) simp
  1302 
  1303 lemma ln_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x * y) = ln x + ln y"
  1304   by (rule ln_unique) (simp add: exp_add)
  1305 
  1306 lemma ln_setprod:
  1307     "\<lbrakk>finite I; \<And>i. i \<in> I \<Longrightarrow> f i > 0\<rbrakk> \<Longrightarrow> ln(setprod f I) = setsum (\<lambda>x. ln(f x)) I"
  1308   by (induction I rule: finite_induct) (auto simp: ln_mult setprod_pos)
  1309 
  1310 lemma ln_inverse: "0 < x \<Longrightarrow> ln (inverse x) = - ln x"
  1311   by (rule ln_unique) (simp add: exp_minus)
  1312 
  1313 lemma ln_div: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x / y) = ln x - ln y"
  1314   by (rule ln_unique) (simp add: exp_diff)
  1315 
  1316 lemma ln_realpow: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
  1317   by (rule ln_unique) (simp add: exp_real_of_nat_mult)
  1318 
  1319 lemma ln_less_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x < ln y \<longleftrightarrow> x < y"
  1320   by (subst exp_less_cancel_iff [symmetric]) simp
  1321 
  1322 lemma ln_le_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x \<le> ln y \<longleftrightarrow> x \<le> y"
  1323   by (simp add: linorder_not_less [symmetric])
  1324 
  1325 lemma ln_inj_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x = ln y \<longleftrightarrow> x = y"
  1326   by (simp add: order_eq_iff)
  1327 
  1328 lemma ln_add_one_self_le_self [simp]: "0 \<le> x \<Longrightarrow> ln (1 + x) \<le> x"
  1329   apply (rule exp_le_cancel_iff [THEN iffD1])
  1330   apply (simp add: exp_ge_add_one_self_aux)
  1331   done
  1332 
  1333 lemma ln_less_self [simp]: "0 < x \<Longrightarrow> ln x < x"
  1334   by (rule order_less_le_trans [where y="ln (1 + x)"]) simp_all
  1335 
  1336 lemma ln_ge_zero [simp]: "1 \<le> x \<Longrightarrow> 0 \<le> ln x"
  1337   using ln_le_cancel_iff [of 1 x] by simp
  1338 
  1339 lemma ln_ge_zero_imp_ge_one: "0 \<le> ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> x"
  1340   using ln_le_cancel_iff [of 1 x] by simp
  1341 
  1342 lemma ln_ge_zero_iff [simp]: "0 < x \<Longrightarrow> 0 \<le> ln x \<longleftrightarrow> 1 \<le> x"
  1343   using ln_le_cancel_iff [of 1 x] by simp
  1344 
  1345 lemma ln_less_zero_iff [simp]: "0 < x \<Longrightarrow> ln x < 0 \<longleftrightarrow> x < 1"
  1346   using ln_less_cancel_iff [of x 1] by simp
  1347 
  1348 lemma ln_gt_zero: "1 < x \<Longrightarrow> 0 < ln x"
  1349   using ln_less_cancel_iff [of 1 x] by simp
  1350 
  1351 lemma ln_gt_zero_imp_gt_one: "0 < ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 < x"
  1352   using ln_less_cancel_iff [of 1 x] by simp
  1353 
  1354 lemma ln_gt_zero_iff [simp]: "0 < x \<Longrightarrow> 0 < ln x \<longleftrightarrow> 1 < x"
  1355   using ln_less_cancel_iff [of 1 x] by simp
  1356 
  1357 lemma ln_eq_zero_iff [simp]: "0 < x \<Longrightarrow> ln x = 0 \<longleftrightarrow> x = 1"
  1358   using ln_inj_iff [of x 1] by simp
  1359 
  1360 lemma ln_less_zero: "0 < x \<Longrightarrow> x < 1 \<Longrightarrow> ln x < 0"
  1361   by simp
  1362 
  1363 lemma ln_neg_is_const: "x \<le> 0 \<Longrightarrow> ln x = (THE x. False)"
  1364   by (auto simp add: ln_def intro!: arg_cong[where f=The])
  1365 
  1366 lemma isCont_ln: assumes "x \<noteq> 0" shows "isCont ln x"
  1367 proof cases
  1368   assume "0 < x"
  1369   moreover then have "isCont ln (exp (ln x))"
  1370     by (intro isCont_inv_fun[where d="\<bar>x\<bar>" and f=exp]) auto
  1371   ultimately show ?thesis
  1372     by simp
  1373 next
  1374   assume "\<not> 0 < x" with `x \<noteq> 0` show "isCont ln x"
  1375     unfolding isCont_def
  1376     by (subst filterlim_cong[OF _ refl, of _ "nhds (ln 0)" _ "\<lambda>_. ln 0"])
  1377        (auto simp: ln_neg_is_const not_less eventually_at dist_real_def
  1378                 intro!: exI[of _ "\<bar>x\<bar>"])
  1379 qed
  1380 
  1381 lemma tendsto_ln [tendsto_intros]:
  1382   "(f ---> a) F \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. ln (f x)) ---> ln a) F"
  1383   by (rule isCont_tendsto_compose [OF isCont_ln])
  1384 
  1385 lemma continuous_ln:
  1386   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. ln (f x))"
  1387   unfolding continuous_def by (rule tendsto_ln)
  1388 
  1389 lemma isCont_ln' [continuous_intros]:
  1390   "continuous (at x) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x) (\<lambda>x. ln (f x))"
  1391   unfolding continuous_at by (rule tendsto_ln)
  1392 
  1393 lemma continuous_within_ln [continuous_intros]:
  1394   "continuous (at x within s) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. ln (f x))"
  1395   unfolding continuous_within by (rule tendsto_ln)
  1396 
  1397 lemma continuous_on_ln [continuous_intros]:
  1398   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. f x \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. ln (f x))"
  1399   unfolding continuous_on_def by (auto intro: tendsto_ln)
  1400 
  1401 lemma DERIV_ln: "0 < x \<Longrightarrow> DERIV ln x :> inverse x"
  1402   apply (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
  1403   apply (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)
  1404   done
  1405 
  1406 lemma DERIV_ln_divide: "0 < x \<Longrightarrow> DERIV ln x :> 1 / x"
  1407   by (rule DERIV_ln[THEN DERIV_cong], simp, simp add: divide_inverse)
  1408 
  1409 declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
  1410 
  1411 lemma ln_series:
  1412   assumes "0 < x" and "x < 2"
  1413   shows "ln x = (\<Sum> n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
  1414   (is "ln x = suminf (?f (x - 1))")
  1415 proof -
  1416   let ?f' = "\<lambda>x n. (-1)^n * (x - 1)^n"
  1417 
  1418   have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
  1419   proof (rule DERIV_isconst3[where x=x])
  1420     fix x :: real
  1421     assume "x \<in> {0 <..< 2}"
  1422     hence "0 < x" and "x < 2" by auto
  1423     have "norm (1 - x) < 1"
  1424       using `0 < x` and `x < 2` by auto
  1425     have "1 / x = 1 / (1 - (1 - x))" by auto
  1426     also have "\<dots> = (\<Sum> n. (1 - x)^n)"
  1427       using geometric_sums[OF `norm (1 - x) < 1`] by (rule sums_unique)
  1428     also have "\<dots> = suminf (?f' x)"
  1429       unfolding power_mult_distrib[symmetric]
  1430       by (rule arg_cong[where f=suminf], rule arg_cong[where f="op ^"], auto)
  1431     finally have "DERIV ln x :> suminf (?f' x)"
  1432       using DERIV_ln[OF `0 < x`] unfolding divide_inverse by auto
  1433     moreover
  1434     have repos: "\<And> h x :: real. h - 1 + x = h + x - 1" by auto
  1435     have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :>
  1436       (\<Sum>n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
  1437     proof (rule DERIV_power_series')
  1438       show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1"
  1439         using `0 < x` `x < 2` by auto
  1440       fix x :: real
  1441       assume "x \<in> {- 1<..<1}"
  1442       hence "norm (-x) < 1" by auto
  1443       show "summable (\<lambda>n. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
  1444         unfolding One_nat_def
  1445         by (auto simp add: power_mult_distrib[symmetric] summable_geometric[OF `norm (-x) < 1`])
  1446     qed
  1447     hence "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)"
  1448       unfolding One_nat_def by auto
  1449     hence "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)"
  1450       unfolding DERIV_def repos .
  1451     ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> (suminf (?f' x) - suminf (?f' x))"
  1452       by (rule DERIV_diff)
  1453     thus "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> 0" by auto
  1454   qed (auto simp add: assms)
  1455   thus ?thesis by auto
  1456 qed
  1457 
  1458 lemma exp_first_two_terms:
  1459   fixes x :: "'a::{real_normed_field,banach}"
  1460   shows "exp x = 1 + x + (\<Sum> n. inverse(fact (n+2)) * (x ^ (n+2)))"
  1461 proof -
  1462   have "exp x = suminf (\<lambda>n. inverse(fact n) * (x^n))"
  1463     by (simp add: exp_def scaleR_conv_of_real nonzero_of_real_inverse)
  1464   also from summable_exp have "... = (\<Sum> n. inverse(fact(n+2)) * (x ^ (n+2))) +
  1465     (\<Sum> n::nat<2. inverse(fact n) * (x^n))" (is "_ = _ + ?a")
  1466     by (rule suminf_split_initial_segment)
  1467   also have "?a = 1 + x"
  1468     by (simp add: numeral_2_eq_2)
  1469   finally show ?thesis
  1470     by simp
  1471 qed
  1472 
  1473 lemma exp_bound: "0 <= (x::real) \<Longrightarrow> x <= 1 \<Longrightarrow> exp x <= 1 + x + x\<^sup>2"
  1474 proof -
  1475   assume a: "0 <= x"
  1476   assume b: "x <= 1"
  1477   {
  1478     fix n :: nat
  1479     have "(2::nat) * 2 ^ n \<le> fact (n + 2)"
  1480       by (induct n) simp_all
  1481     hence "real ((2::nat) * 2 ^ n) \<le> real_of_nat (fact (n + 2))"
  1482       by (simp only: real_of_nat_le_iff)
  1483     hence "((2::real) * 2 ^ n) \<le> fact (n + 2)"
  1484       unfolding of_nat_fact real_of_nat_def
  1485       by (simp add: of_nat_mult of_nat_power)
  1486     hence "inverse (fact (n + 2)) \<le> inverse ((2::real) * 2 ^ n)"
  1487       by (rule le_imp_inverse_le) simp
  1488     hence "inverse (fact (n + 2)) \<le> 1/(2::real) * (1/2)^n"
  1489       by (simp add: power_inverse)
  1490     hence "inverse (fact (n + 2)) * (x^n * x\<^sup>2) \<le> 1/2 * (1/2)^n * (1 * x\<^sup>2)"
  1491       by (rule mult_mono)
  1492         (rule mult_mono, simp_all add: power_le_one a b)
  1493     hence "inverse (fact (n + 2)) * x ^ (n + 2) \<le> (x\<^sup>2/2) * ((1/2)^n)"
  1494       unfolding power_add by (simp add: ac_simps del: fact.simps) }
  1495   note aux1 = this
  1496   have "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1 / 2)))"
  1497     by (intro sums_mult geometric_sums, simp)
  1498   hence aux2: "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums x\<^sup>2"
  1499     by simp
  1500   have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n+2))) <= x\<^sup>2"
  1501   proof -
  1502     have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n+2))) <=
  1503         suminf (\<lambda>n. (x\<^sup>2/2) * ((1/2)^n))"
  1504       apply (rule suminf_le)
  1505       apply (rule allI, rule aux1)
  1506       apply (rule summable_exp [THEN summable_ignore_initial_segment])
  1507       by (rule sums_summable, rule aux2)
  1508     also have "... = x\<^sup>2"
  1509       by (rule sums_unique [THEN sym], rule aux2)
  1510     finally show ?thesis .
  1511   qed
  1512   thus ?thesis unfolding exp_first_two_terms by auto
  1513 qed
  1514 
  1515 corollary exp_half_le2: "exp(1/2) \<le> (2::real)"
  1516   using exp_bound [of "1/2"]
  1517   by (simp add: field_simps)
  1518 
  1519 corollary exp_le: "exp 1 \<le> (3::real)"
  1520   using exp_bound [of 1]
  1521   by (simp add: field_simps)
  1522 
  1523 lemma exp_bound_half: "norm(z) \<le> 1/2 \<Longrightarrow> norm(exp z) \<le> 2"
  1524   by (blast intro: order_trans intro!: exp_half_le2 norm_exp)
  1525 
  1526 lemma exp_bound_lemma:
  1527   assumes "norm(z) \<le> 1/2" shows "norm(exp z) \<le> 1 + 2 * norm(z)"
  1528 proof -
  1529   have n: "(norm z)\<^sup>2 \<le> norm z * 1"
  1530     unfolding power2_eq_square
  1531     apply (rule mult_left_mono)
  1532     using assms
  1533     apply (auto simp: )
  1534     done
  1535   show ?thesis
  1536     apply (rule order_trans [OF norm_exp])
  1537     apply (rule order_trans [OF exp_bound])
  1538     using assms n
  1539     apply (auto simp: )
  1540     done
  1541 qed
  1542 
  1543 lemma real_exp_bound_lemma:
  1544   fixes x :: real
  1545   shows "0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> exp(x) \<le> 1 + 2 * x"
  1546 using exp_bound_lemma [of x]
  1547 by simp
  1548 
  1549 lemma ln_one_minus_pos_upper_bound: "0 <= x \<Longrightarrow> x < 1 \<Longrightarrow> ln (1 - x) <= - x"
  1550 proof -
  1551   assume a: "0 <= (x::real)" and b: "x < 1"
  1552   have "(1 - x) * (1 + x + x\<^sup>2) = (1 - x^3)"
  1553     by (simp add: algebra_simps power2_eq_square power3_eq_cube)
  1554   also have "... <= 1"
  1555     by (auto simp add: a)
  1556   finally have "(1 - x) * (1 + x + x\<^sup>2) <= 1" .
  1557   moreover have c: "0 < 1 + x + x\<^sup>2"
  1558     by (simp add: add_pos_nonneg a)
  1559   ultimately have "1 - x <= 1 / (1 + x + x\<^sup>2)"
  1560     by (elim mult_imp_le_div_pos)
  1561   also have "... <= 1 / exp x"
  1562     by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
  1563               real_sqrt_pow2_iff real_sqrt_power)
  1564   also have "... = exp (-x)"
  1565     by (auto simp add: exp_minus divide_inverse)
  1566   finally have "1 - x <= exp (- x)" .
  1567   also have "1 - x = exp (ln (1 - x))"
  1568     by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
  1569   finally have "exp (ln (1 - x)) <= exp (- x)" .
  1570   thus ?thesis by (auto simp only: exp_le_cancel_iff)
  1571 qed
  1572 
  1573 lemma exp_ge_add_one_self [simp]: "1 + (x::real) <= exp x"
  1574   apply (case_tac "0 <= x")
  1575   apply (erule exp_ge_add_one_self_aux)
  1576   apply (case_tac "x <= -1")
  1577   apply (subgoal_tac "1 + x <= 0")
  1578   apply (erule order_trans)
  1579   apply simp
  1580   apply simp
  1581   apply (subgoal_tac "1 + x = exp(ln (1 + x))")
  1582   apply (erule ssubst)
  1583   apply (subst exp_le_cancel_iff)
  1584   apply (subgoal_tac "ln (1 - (- x)) <= - (- x)")
  1585   apply simp
  1586   apply (rule ln_one_minus_pos_upper_bound)
  1587   apply auto
  1588 done
  1589 
  1590 lemma ln_one_plus_pos_lower_bound: "0 <= x \<Longrightarrow> x <= 1 \<Longrightarrow> x - x\<^sup>2 <= ln (1 + x)"
  1591 proof -
  1592   assume a: "0 <= x" and b: "x <= 1"
  1593   have "exp (x - x\<^sup>2) = exp x / exp (x\<^sup>2)"
  1594     by (rule exp_diff)
  1595   also have "... <= (1 + x + x\<^sup>2) / exp (x \<^sup>2)"
  1596     by (metis a b divide_right_mono exp_bound exp_ge_zero)
  1597   also have "... <= (1 + x + x\<^sup>2) / (1 + x\<^sup>2)"
  1598     by (simp add: a divide_left_mono add_pos_nonneg)
  1599   also from a have "... <= 1 + x"
  1600     by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
  1601   finally have "exp (x - x\<^sup>2) <= 1 + x" .
  1602   also have "... = exp (ln (1 + x))"
  1603   proof -
  1604     from a have "0 < 1 + x" by auto
  1605     thus ?thesis
  1606       by (auto simp only: exp_ln_iff [THEN sym])
  1607   qed
  1608   finally have "exp (x - x\<^sup>2) <= exp (ln (1 + x))" .
  1609   thus ?thesis
  1610     by (metis exp_le_cancel_iff)
  1611 qed
  1612 
  1613 lemma ln_one_minus_pos_lower_bound:
  1614   "0 <= x \<Longrightarrow> x <= (1 / 2) \<Longrightarrow> - x - 2 * x\<^sup>2 <= ln (1 - x)"
  1615 proof -
  1616   assume a: "0 <= x" and b: "x <= (1 / 2)"
  1617   from b have c: "x < 1" by auto
  1618   then have "ln (1 - x) = - ln (1 + x / (1 - x))"
  1619     apply (subst ln_inverse [symmetric])
  1620     apply (simp add: field_simps)
  1621     apply (rule arg_cong [where f=ln])
  1622     apply (simp add: field_simps)
  1623     done
  1624   also have "- (x / (1 - x)) <= ..."
  1625   proof -
  1626     have "ln (1 + x / (1 - x)) <= x / (1 - x)"
  1627       using a c by (intro ln_add_one_self_le_self) auto
  1628     thus ?thesis
  1629       by auto
  1630   qed
  1631   also have "- (x / (1 - x)) = -x / (1 - x)"
  1632     by auto
  1633   finally have d: "- x / (1 - x) <= ln (1 - x)" .
  1634   have "0 < 1 - x" using a b by simp
  1635   hence e: "-x - 2 * x\<^sup>2 <= - x / (1 - x)"
  1636     using mult_right_le_one_le[of "x*x" "2*x"] a b
  1637     by (simp add: field_simps power2_eq_square)
  1638   from e d show "- x - 2 * x\<^sup>2 <= ln (1 - x)"
  1639     by (rule order_trans)
  1640 qed
  1641 
  1642 lemma ln_add_one_self_le_self2: "-1 < x \<Longrightarrow> ln(1 + x) <= x"
  1643   apply (subgoal_tac "ln (1 + x) \<le> ln (exp x)", simp)
  1644   apply (subst ln_le_cancel_iff)
  1645   apply auto
  1646   done
  1647 
  1648 lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
  1649   "0 <= x \<Longrightarrow> x <= 1 \<Longrightarrow> abs(ln (1 + x) - x) <= x\<^sup>2"
  1650 proof -
  1651   assume x: "0 <= x"
  1652   assume x1: "x <= 1"
  1653   from x have "ln (1 + x) <= x"
  1654     by (rule ln_add_one_self_le_self)
  1655   then have "ln (1 + x) - x <= 0"
  1656     by simp
  1657   then have "abs(ln(1 + x) - x) = - (ln(1 + x) - x)"
  1658     by (rule abs_of_nonpos)
  1659   also have "... = x - ln (1 + x)"
  1660     by simp
  1661   also have "... <= x\<^sup>2"
  1662   proof -
  1663     from x x1 have "x - x\<^sup>2 <= ln (1 + x)"
  1664       by (intro ln_one_plus_pos_lower_bound)
  1665     thus ?thesis
  1666       by simp
  1667   qed
  1668   finally show ?thesis .
  1669 qed
  1670 
  1671 lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
  1672   "-(1 / 2) <= x \<Longrightarrow> x <= 0 \<Longrightarrow> abs(ln (1 + x) - x) <= 2 * x\<^sup>2"
  1673 proof -
  1674   assume a: "-(1 / 2) <= x"
  1675   assume b: "x <= 0"
  1676   have "abs(ln (1 + x) - x) = x - ln(1 - (-x))"
  1677     apply (subst abs_of_nonpos)
  1678     apply simp
  1679     apply (rule ln_add_one_self_le_self2)
  1680     using a apply auto
  1681     done
  1682   also have "... <= 2 * x\<^sup>2"
  1683     apply (subgoal_tac "- (-x) - 2 * (-x)\<^sup>2 <= ln (1 - (-x))")
  1684     apply (simp add: algebra_simps)
  1685     apply (rule ln_one_minus_pos_lower_bound)
  1686     using a b apply auto
  1687     done
  1688   finally show ?thesis .
  1689 qed
  1690 
  1691 lemma abs_ln_one_plus_x_minus_x_bound:
  1692     "abs x <= 1 / 2 \<Longrightarrow> abs(ln (1 + x) - x) <= 2 * x\<^sup>2"
  1693   apply (case_tac "0 <= x")
  1694   apply (rule order_trans)
  1695   apply (rule abs_ln_one_plus_x_minus_x_bound_nonneg)
  1696   apply auto
  1697   apply (rule abs_ln_one_plus_x_minus_x_bound_nonpos)
  1698   apply auto
  1699   done
  1700 
  1701 lemma ln_x_over_x_mono: "exp 1 <= x \<Longrightarrow> x <= y \<Longrightarrow> (ln y / y) <= (ln x / x)"
  1702 proof -
  1703   assume x: "exp 1 <= x" "x <= y"
  1704   moreover have "0 < exp (1::real)" by simp
  1705   ultimately have a: "0 < x" and b: "0 < y"
  1706     by (fast intro: less_le_trans order_trans)+
  1707   have "x * ln y - x * ln x = x * (ln y - ln x)"
  1708     by (simp add: algebra_simps)
  1709   also have "... = x * ln(y / x)"
  1710     by (simp only: ln_div a b)
  1711   also have "y / x = (x + (y - x)) / x"
  1712     by simp
  1713   also have "... = 1 + (y - x) / x"
  1714     using x a by (simp add: field_simps)
  1715   also have "x * ln(1 + (y - x) / x) <= x * ((y - x) / x)"
  1716     using x a
  1717     by (intro mult_left_mono ln_add_one_self_le_self) simp_all
  1718   also have "... = y - x" using a by simp
  1719   also have "... = (y - x) * ln (exp 1)" by simp
  1720   also have "... <= (y - x) * ln x"
  1721     apply (rule mult_left_mono)
  1722     apply (subst ln_le_cancel_iff)
  1723     apply fact
  1724     apply (rule a)
  1725     apply (rule x)
  1726     using x apply simp
  1727     done
  1728   also have "... = y * ln x - x * ln x"
  1729     by (rule left_diff_distrib)
  1730   finally have "x * ln y <= y * ln x"
  1731     by arith
  1732   then have "ln y <= (y * ln x) / x" using a by (simp add: field_simps)
  1733   also have "... = y * (ln x / x)" by simp
  1734   finally show ?thesis using b by (simp add: field_simps)
  1735 qed
  1736 
  1737 lemma ln_le_minus_one: "0 < x \<Longrightarrow> ln x \<le> x - 1"
  1738   using exp_ge_add_one_self[of "ln x"] by simp
  1739 
  1740 lemma ln_eq_minus_one:
  1741   assumes "0 < x" "ln x = x - 1"
  1742   shows "x = 1"
  1743 proof -
  1744   let ?l = "\<lambda>y. ln y - y + 1"
  1745   have D: "\<And>x. 0 < x \<Longrightarrow> DERIV ?l x :> (1 / x - 1)"
  1746     by (auto intro!: derivative_eq_intros)
  1747 
  1748   show ?thesis
  1749   proof (cases rule: linorder_cases)
  1750     assume "x < 1"
  1751     from dense[OF `x < 1`] obtain a where "x < a" "a < 1" by blast
  1752     from `x < a` have "?l x < ?l a"
  1753     proof (rule DERIV_pos_imp_increasing, safe)
  1754       fix y
  1755       assume "x \<le> y" "y \<le> a"
  1756       with `0 < x` `a < 1` have "0 < 1 / y - 1" "0 < y"
  1757         by (auto simp: field_simps)
  1758       with D show "\<exists>z. DERIV ?l y :> z \<and> 0 < z"
  1759         by auto
  1760     qed
  1761     also have "\<dots> \<le> 0"
  1762       using ln_le_minus_one `0 < x` `x < a` by (auto simp: field_simps)
  1763     finally show "x = 1" using assms by auto
  1764   next
  1765     assume "1 < x"
  1766     from dense[OF this] obtain a where "1 < a" "a < x" by blast
  1767     from `a < x` have "?l x < ?l a"
  1768     proof (rule DERIV_neg_imp_decreasing, safe)
  1769       fix y
  1770       assume "a \<le> y" "y \<le> x"
  1771       with `1 < a` have "1 / y - 1 < 0" "0 < y"
  1772         by (auto simp: field_simps)
  1773       with D show "\<exists>z. DERIV ?l y :> z \<and> z < 0"
  1774         by blast
  1775     qed
  1776     also have "\<dots> \<le> 0"
  1777       using ln_le_minus_one `1 < a` by (auto simp: field_simps)
  1778     finally show "x = 1" using assms by auto
  1779   next
  1780     assume "x = 1"
  1781     then show ?thesis by simp
  1782   qed
  1783 qed
  1784 
  1785 lemma exp_at_bot: "(exp ---> (0::real)) at_bot"
  1786   unfolding tendsto_Zfun_iff
  1787 proof (rule ZfunI, simp add: eventually_at_bot_dense)
  1788   fix r :: real assume "0 < r"
  1789   {
  1790     fix x
  1791     assume "x < ln r"
  1792     then have "exp x < exp (ln r)"
  1793       by simp
  1794     with `0 < r` have "exp x < r"
  1795       by simp
  1796   }
  1797   then show "\<exists>k. \<forall>n<k. exp n < r" by auto
  1798 qed
  1799 
  1800 lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
  1801   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g="ln"])
  1802      (auto intro: eventually_gt_at_top)
  1803 
  1804 lemma lim_exp_minus_1:
  1805   fixes x :: "'a::{real_normed_field,banach}"
  1806   shows "((\<lambda>z::'a. (exp(z) - 1) / z) ---> 1) (at 0)"
  1807 proof -
  1808   have "((\<lambda>z::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
  1809     by (intro derivative_eq_intros | simp)+
  1810   then show ?thesis
  1811     by (simp add: Deriv.DERIV_iff2)
  1812 qed
  1813 
  1814 lemma ln_at_0: "LIM x at_right 0. ln x :> at_bot"
  1815   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  1816      (auto simp: eventually_at_filter)
  1817 
  1818 lemma ln_at_top: "LIM x at_top. ln x :> at_top"
  1819   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  1820      (auto intro: eventually_gt_at_top)
  1821 
  1822 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) ---> (0::real)) at_top"
  1823 proof (induct k)
  1824   case 0
  1825   show "((\<lambda>x. x ^ 0 / exp x) ---> (0::real)) at_top"
  1826     by (simp add: inverse_eq_divide[symmetric])
  1827        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
  1828               at_top_le_at_infinity order_refl)
  1829 next
  1830   case (Suc k)
  1831   show ?case
  1832   proof (rule lhospital_at_top_at_top)
  1833     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
  1834       by eventually_elim (intro derivative_eq_intros, auto)
  1835     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
  1836       by eventually_elim auto
  1837     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
  1838       by auto
  1839     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
  1840     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) ---> 0) at_top"
  1841       by simp
  1842   qed (rule exp_at_top)
  1843 qed
  1844 
  1845 
  1846 definition powr :: "[real,real] => real"  (infixr "powr" 80)
  1847   -- {*exponentation with real exponent*}
  1848   where "x powr a = exp(a * ln x)"
  1849 
  1850 definition log :: "[real,real] => real"
  1851   -- {*logarithm of @{term x} to base @{term a}*}
  1852   where "log a x = ln x / ln a"
  1853 
  1854 
  1855 lemma tendsto_log [tendsto_intros]:
  1856   "\<lbrakk>(f ---> a) F; (g ---> b) F; 0 < a; a \<noteq> 1; 0 < b\<rbrakk> \<Longrightarrow> ((\<lambda>x. log (f x) (g x)) ---> log a b) F"
  1857   unfolding log_def by (intro tendsto_intros) auto
  1858 
  1859 lemma continuous_log:
  1860   assumes "continuous F f"
  1861     and "continuous F g"
  1862     and "0 < f (Lim F (\<lambda>x. x))"
  1863     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
  1864     and "0 < g (Lim F (\<lambda>x. x))"
  1865   shows "continuous F (\<lambda>x. log (f x) (g x))"
  1866   using assms unfolding continuous_def by (rule tendsto_log)
  1867 
  1868 lemma continuous_at_within_log[continuous_intros]:
  1869   assumes "continuous (at a within s) f"
  1870     and "continuous (at a within s) g"
  1871     and "0 < f a"
  1872     and "f a \<noteq> 1"
  1873     and "0 < g a"
  1874   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
  1875   using assms unfolding continuous_within by (rule tendsto_log)
  1876 
  1877 lemma isCont_log[continuous_intros, simp]:
  1878   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
  1879   shows "isCont (\<lambda>x. log (f x) (g x)) a"
  1880   using assms unfolding continuous_at by (rule tendsto_log)
  1881 
  1882 lemma continuous_on_log[continuous_intros]:
  1883   assumes "continuous_on s f" "continuous_on s g"
  1884     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
  1885   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
  1886   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
  1887 
  1888 lemma powr_one_eq_one [simp]: "1 powr a = 1"
  1889   by (simp add: powr_def)
  1890 
  1891 lemma powr_zero_eq_one [simp]: "x powr 0 = 1"
  1892   by (simp add: powr_def)
  1893 
  1894 lemma powr_one_gt_zero_iff [simp]: "(x powr 1 = x) = (0 < x)"
  1895   by (simp add: powr_def)
  1896 declare powr_one_gt_zero_iff [THEN iffD2, simp]
  1897 
  1898 lemma powr_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
  1899   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
  1900 
  1901 lemma powr_gt_zero [simp]: "0 < x powr a"
  1902   by (simp add: powr_def)
  1903 
  1904 lemma powr_ge_pzero [simp]: "0 <= x powr y"
  1905   by (rule order_less_imp_le, rule powr_gt_zero)
  1906 
  1907 lemma powr_not_zero [simp]: "x powr a \<noteq> 0"
  1908   by (simp add: powr_def)
  1909 
  1910 lemma powr_divide: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
  1911   apply (simp add: divide_inverse positive_imp_inverse_positive powr_mult)
  1912   apply (simp add: powr_def exp_minus [symmetric] exp_add [symmetric] ln_inverse)
  1913   done
  1914 
  1915 lemma powr_divide2: "x powr a / x powr b = x powr (a - b)"
  1916   apply (simp add: powr_def)
  1917   apply (subst exp_diff [THEN sym])
  1918   apply (simp add: left_diff_distrib)
  1919   done
  1920 
  1921 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
  1922   by (simp add: powr_def exp_add [symmetric] distrib_right)
  1923 
  1924 lemma powr_mult_base: "0 < x \<Longrightarrow>x * x powr y = x powr (1 + y)"
  1925   using assms by (auto simp: powr_add)
  1926 
  1927 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
  1928   by (simp add: powr_def)
  1929 
  1930 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
  1931   by (simp add: powr_powr mult.commute)
  1932 
  1933 lemma powr_minus: "x powr (-a) = inverse (x powr a)"
  1934   by (simp add: powr_def exp_minus [symmetric])
  1935 
  1936 lemma powr_minus_divide: "x powr (-a) = 1/(x powr a)"
  1937   by (simp add: divide_inverse powr_minus)
  1938 
  1939 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
  1940   by (simp add: powr_minus_divide)
  1941 
  1942 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
  1943   by (simp add: powr_def)
  1944 
  1945 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  1946   by (simp add: powr_def)
  1947 
  1948 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> (x powr a < x powr b) = (a < b)"
  1949   by (blast intro: powr_less_cancel powr_less_mono)
  1950 
  1951 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> (x powr a \<le> x powr b) = (a \<le> b)"
  1952   by (simp add: linorder_not_less [symmetric])
  1953 
  1954 lemma log_ln: "ln x = log (exp(1)) x"
  1955   by (simp add: log_def)
  1956 
  1957 lemma DERIV_log:
  1958   assumes "x > 0"
  1959   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
  1960 proof -
  1961   def lb \<equiv> "1 / ln b"
  1962   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
  1963     using `x > 0` by (auto intro!: derivative_eq_intros)
  1964   ultimately show ?thesis
  1965     by (simp add: log_def)
  1966 qed
  1967 
  1968 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
  1969 
  1970 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
  1971   by (simp add: powr_def log_def)
  1972 
  1973 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
  1974   by (simp add: log_def powr_def)
  1975 
  1976 lemma log_mult:
  1977   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
  1978     log a (x * y) = log a x + log a y"
  1979   by (simp add: log_def ln_mult divide_inverse distrib_right)
  1980 
  1981 lemma log_eq_div_ln_mult_log:
  1982   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  1983     log a x = (ln b/ln a) * log b x"
  1984   by (simp add: log_def divide_inverse)
  1985 
  1986 text{*Base 10 logarithms*}
  1987 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
  1988   by (simp add: log_def)
  1989 
  1990 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
  1991   by (simp add: log_def)
  1992 
  1993 lemma log_one [simp]: "log a 1 = 0"
  1994   by (simp add: log_def)
  1995 
  1996 lemma log_eq_one [simp]: "[| 0 < a; a \<noteq> 1 |] ==> log a a = 1"
  1997   by (simp add: log_def)
  1998 
  1999 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
  2000   apply (rule_tac a1 = "log a x" in add_left_cancel [THEN iffD1])
  2001   apply (simp add: log_mult [symmetric])
  2002   done
  2003 
  2004 lemma log_divide: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a (x/y) = log a x - log a y"
  2005   by (simp add: log_mult divide_inverse log_inverse)
  2006 
  2007 lemma log_add_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log b x + y = log b (x * b powr y)"
  2008   and add_log_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> y + log b x = log b (b powr y * x)"
  2009   and log_minus_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log b x - y = log b (x * b powr -y)"
  2010   and minus_log_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> y - log b x = log b (b powr y / x)"
  2011   by (simp_all add: log_mult log_divide)
  2012 
  2013 lemma log_less_cancel_iff [simp]:
  2014   "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
  2015   apply safe
  2016   apply (rule_tac [2] powr_less_cancel)
  2017   apply (drule_tac a = "log a x" in powr_less_mono, auto)
  2018   done
  2019 
  2020 lemma log_inj:
  2021   assumes "1 < b"
  2022   shows "inj_on (log b) {0 <..}"
  2023 proof (rule inj_onI, simp)
  2024   fix x y
  2025   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
  2026   show "x = y"
  2027   proof (cases rule: linorder_cases)
  2028     assume "x = y"
  2029     then show ?thesis by simp
  2030   next
  2031     assume "x < y" hence "log b x < log b y"
  2032       using log_less_cancel_iff[OF `1 < b`] pos by simp
  2033     then show ?thesis using * by simp
  2034   next
  2035     assume "y < x" hence "log b y < log b x"
  2036       using log_less_cancel_iff[OF `1 < b`] pos by simp
  2037     then show ?thesis using * by simp
  2038   qed
  2039 qed
  2040 
  2041 lemma log_le_cancel_iff [simp]:
  2042   "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (log a x \<le> log a y) = (x \<le> y)"
  2043   by (simp add: linorder_not_less [symmetric])
  2044 
  2045 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
  2046   using log_less_cancel_iff[of a 1 x] by simp
  2047 
  2048 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
  2049   using log_le_cancel_iff[of a 1 x] by simp
  2050 
  2051 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
  2052   using log_less_cancel_iff[of a x 1] by simp
  2053 
  2054 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
  2055   using log_le_cancel_iff[of a x 1] by simp
  2056 
  2057 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
  2058   using log_less_cancel_iff[of a a x] by simp
  2059 
  2060 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
  2061   using log_le_cancel_iff[of a a x] by simp
  2062 
  2063 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
  2064   using log_less_cancel_iff[of a x a] by simp
  2065 
  2066 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
  2067   using log_le_cancel_iff[of a x a] by simp
  2068 
  2069 lemma le_log_iff:
  2070   assumes "1 < b" "x > 0"
  2071   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
  2072   by (metis assms(1) assms(2) dual_order.strict_trans powr_le_cancel_iff powr_log_cancel
  2073     powr_one_eq_one powr_one_gt_zero_iff)
  2074 
  2075 lemma less_log_iff:
  2076   assumes "1 < b" "x > 0"
  2077   shows "y < log b x \<longleftrightarrow> b powr y < x"
  2078   by (metis assms(1) assms(2) dual_order.strict_trans less_irrefl powr_less_cancel_iff
  2079     powr_log_cancel zero_less_one)
  2080 
  2081 lemma
  2082   assumes "1 < b" "x > 0"
  2083   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
  2084     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
  2085   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
  2086   by auto
  2087 
  2088 lemmas powr_le_iff = le_log_iff[symmetric]
  2089   and powr_less_iff = le_log_iff[symmetric]
  2090   and less_powr_iff = log_less_iff[symmetric]
  2091   and le_powr_iff = log_le_iff[symmetric]
  2092 
  2093 lemma
  2094   floor_log_eq_powr_iff: "x > 0 \<Longrightarrow> b > 1 \<Longrightarrow> \<lfloor>log b x\<rfloor> = k \<longleftrightarrow> b powr k \<le> x \<and> x < b powr (k + 1)"
  2095   by (auto simp add: floor_eq_iff powr_le_iff less_powr_iff)
  2096 
  2097 lemma powr_realpow: "0 < x ==> x powr (real n) = x^n"
  2098   apply (induct n)
  2099   apply simp
  2100   apply (subgoal_tac "real(Suc n) = real n + 1")
  2101   apply (erule ssubst)
  2102   apply (subst powr_add, simp, simp)
  2103   done
  2104 
  2105 lemma powr_realpow_numeral: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
  2106   unfolding real_of_nat_numeral [symmetric] by (rule powr_realpow)
  2107 
  2108 lemma powr2_sqrt[simp]: "0 < x \<Longrightarrow> sqrt x powr 2 = x"
  2109 by(simp add: powr_realpow_numeral)
  2110 
  2111 lemma powr_realpow2: "0 <= x ==> 0 < n ==> x^n = (if (x = 0) then 0 else x powr (real n))"
  2112   apply (case_tac "x = 0", simp, simp)
  2113   apply (rule powr_realpow [THEN sym], simp)
  2114   done
  2115 
  2116 lemma powr_int:
  2117   assumes "x > 0"
  2118   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
  2119 proof (cases "i < 0")
  2120   case True
  2121   have r: "x powr i = 1 / x powr (-i)" by (simp add: powr_minus field_simps)
  2122   show ?thesis using `i < 0` `x > 0` by (simp add: r field_simps powr_realpow[symmetric])
  2123 next
  2124   case False
  2125   then show ?thesis by (simp add: assms powr_realpow[symmetric])
  2126 qed
  2127 
  2128 lemma compute_powr[code]:
  2129   fixes i::real
  2130   shows "b powr i =
  2131     (if b \<le> 0 then Code.abort (STR ''op powr with nonpositive base'') (\<lambda>_. b powr i)
  2132     else if floor i = i then (if 0 \<le> i then b ^ nat(floor i) else 1 / b ^ nat(floor (- i)))
  2133     else Code.abort (STR ''op powr with non-integer exponent'') (\<lambda>_. b powr i))"
  2134   by (auto simp: powr_int)
  2135 
  2136 lemma powr_one: "0 < x \<Longrightarrow> x powr 1 = x"
  2137   using powr_realpow [of x 1] by simp
  2138 
  2139 lemma powr_numeral: "0 < x \<Longrightarrow> x powr numeral n = x ^ numeral n"
  2140   by (fact powr_realpow_numeral)
  2141 
  2142 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
  2143   using powr_int [of x "- 1"] by simp
  2144 
  2145 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
  2146   using powr_int [of x "- numeral n"] by simp
  2147 
  2148 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
  2149   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
  2150 
  2151 lemma ln_powr: "ln (x powr y) = y * ln x"
  2152   by (simp add: powr_def)
  2153 
  2154 lemma ln_root: "\<lbrakk> n > 0; b > 0 \<rbrakk> \<Longrightarrow> ln (root n b) =  ln b / n"
  2155 by(simp add: root_powr_inverse ln_powr)
  2156 
  2157 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
  2158   by (simp add: ln_powr powr_numeral ln_powr[symmetric] mult.commute)
  2159 
  2160 lemma log_root: "\<lbrakk> n > 0; a > 0 \<rbrakk> \<Longrightarrow> log b (root n a) =  log b a / n"
  2161 by(simp add: log_def ln_root)
  2162 
  2163 lemma log_powr: "log b (x powr y) = y * log b x"
  2164   by (simp add: log_def ln_powr)
  2165 
  2166 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
  2167   by (simp add: log_powr powr_realpow [symmetric])
  2168 
  2169 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
  2170   by (simp add: log_def)
  2171 
  2172 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
  2173   by (simp add: log_def ln_realpow)
  2174 
  2175 lemma log_base_powr: "log (a powr b) x = log a x / b"
  2176   by (simp add: log_def ln_powr)
  2177 
  2178 lemma log_base_root: "\<lbrakk> n > 0; b > 0 \<rbrakk> \<Longrightarrow> log (root n b) x = n * (log b x)"
  2179 by(simp add: log_def ln_root)
  2180 
  2181 lemma ln_bound: "1 <= x ==> ln x <= x"
  2182   apply (subgoal_tac "ln(1 + (x - 1)) <= x - 1")
  2183   apply simp
  2184   apply (rule ln_add_one_self_le_self, simp)
  2185   done
  2186 
  2187 lemma powr_mono: "a <= b ==> 1 <= x ==> x powr a <= x powr b"
  2188   apply (cases "x = 1", simp)
  2189   apply (cases "a = b", simp)
  2190   apply (rule order_less_imp_le)
  2191   apply (rule powr_less_mono, auto)
  2192   done
  2193 
  2194 lemma ge_one_powr_ge_zero: "1 <= x ==> 0 <= a ==> 1 <= x powr a"
  2195   apply (subst powr_zero_eq_one [THEN sym])
  2196   apply (rule powr_mono, assumption+)
  2197   done
  2198 
  2199 lemma powr_less_mono2: "0 < a ==> 0 < x ==> x < y ==> x powr a < y powr a"
  2200   apply (unfold powr_def)
  2201   apply (rule exp_less_mono)
  2202   apply (rule mult_strict_left_mono)
  2203   apply (subst ln_less_cancel_iff, assumption)
  2204   apply (rule order_less_trans)
  2205   prefer 2
  2206   apply assumption+
  2207   done
  2208 
  2209 lemma powr_less_mono2_neg: "a < 0 ==> 0 < x ==> x < y ==> y powr a < x powr a"
  2210   apply (unfold powr_def)
  2211   apply (rule exp_less_mono)
  2212   apply (rule mult_strict_left_mono_neg)
  2213   apply (subst ln_less_cancel_iff)
  2214   apply assumption
  2215   apply (rule order_less_trans)
  2216   prefer 2
  2217   apply assumption+
  2218   done
  2219 
  2220 lemma powr_mono2: "0 <= a ==> 0 < x ==> x <= y ==> x powr a <= y powr a"
  2221   apply (case_tac "a = 0", simp)
  2222   apply (case_tac "x = y", simp)
  2223   apply (metis less_eq_real_def powr_less_mono2)
  2224   done
  2225 
  2226 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
  2227   unfolding powr_def exp_inj_iff by simp
  2228 
  2229 lemma ln_powr_bound: "1 <= x ==> 0 < a ==> ln x <= (x powr a) / a"
  2230   by (metis less_eq_real_def ln_less_self mult_imp_le_div_pos ln_powr mult.commute
  2231             order.strict_trans2 powr_gt_zero zero_less_one)
  2232 
  2233 lemma ln_powr_bound2:
  2234   assumes "1 < x" and "0 < a"
  2235   shows "(ln x) powr a <= (a powr a) * x"
  2236 proof -
  2237   from assms have "ln x <= (x powr (1 / a)) / (1 / a)"
  2238     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
  2239   also have "... = a * (x powr (1 / a))"
  2240     by simp
  2241   finally have "(ln x) powr a <= (a * (x powr (1 / a))) powr a"
  2242     by (metis assms less_imp_le ln_gt_zero powr_mono2)
  2243   also have "... = (a powr a) * ((x powr (1 / a)) powr a)"
  2244     by (metis assms(2) powr_mult powr_gt_zero)
  2245   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
  2246     by (rule powr_powr)
  2247   also have "... = x" using assms
  2248     by auto
  2249   finally show ?thesis .
  2250 qed
  2251 
  2252 lemma tendsto_powr [tendsto_intros]:
  2253   "\<lbrakk>(f ---> a) F; (g ---> b) F; a \<noteq> 0\<rbrakk> \<Longrightarrow> ((\<lambda>x. f x powr g x) ---> a powr b) F"
  2254   unfolding powr_def by (intro tendsto_intros)
  2255 
  2256 lemma continuous_powr:
  2257   assumes "continuous F f"
  2258     and "continuous F g"
  2259     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
  2260   shows "continuous F (\<lambda>x. (f x) powr (g x))"
  2261   using assms unfolding continuous_def by (rule tendsto_powr)
  2262 
  2263 lemma continuous_at_within_powr[continuous_intros]:
  2264   assumes "continuous (at a within s) f"
  2265     and "continuous (at a within s) g"
  2266     and "f a \<noteq> 0"
  2267   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
  2268   using assms unfolding continuous_within by (rule tendsto_powr)
  2269 
  2270 lemma isCont_powr[continuous_intros, simp]:
  2271   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
  2272   shows "isCont (\<lambda>x. (f x) powr g x) a"
  2273   using assms unfolding continuous_at by (rule tendsto_powr)
  2274 
  2275 lemma continuous_on_powr[continuous_intros]:
  2276   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
  2277   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2278   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
  2279 
  2280 (* FIXME: generalize by replacing d by with g x and g ---> d? *)
  2281 lemma tendsto_zero_powrI:
  2282   assumes "eventually (\<lambda>x. 0 < f x ) F" and "(f ---> 0) F"
  2283     and "0 < d"
  2284   shows "((\<lambda>x. f x powr d) ---> 0) F"
  2285 proof (rule tendstoI)
  2286   fix e :: real assume "0 < e"
  2287   def Z \<equiv> "e powr (1 / d)"
  2288   with `0 < e` have "0 < Z" by simp
  2289   with assms have "eventually (\<lambda>x. 0 < f x \<and> dist (f x) 0 < Z) F"
  2290     by (intro eventually_conj tendstoD)
  2291   moreover
  2292   from assms have "\<And>x. 0 < x \<and> dist x 0 < Z \<Longrightarrow> x powr d < Z powr d"
  2293     by (intro powr_less_mono2) (auto simp: dist_real_def)
  2294   with assms `0 < e` have "\<And>x. 0 < x \<and> dist x 0 < Z \<Longrightarrow> dist (x powr d) 0 < e"
  2295     unfolding dist_real_def Z_def by (auto simp: powr_powr)
  2296   ultimately
  2297   show "eventually (\<lambda>x. dist (f x powr d) 0 < e) F" by (rule eventually_elim1)
  2298 qed
  2299 
  2300 lemma tendsto_neg_powr:
  2301   assumes "s < 0"
  2302     and "LIM x F. f x :> at_top"
  2303   shows "((\<lambda>x. f x powr s) ---> 0) F"
  2304 proof (rule tendstoI)
  2305   fix e :: real assume "0 < e"
  2306   def Z \<equiv> "e powr (1 / s)"
  2307   from assms have "eventually (\<lambda>x. Z < f x) F"
  2308     by (simp add: filterlim_at_top_dense)
  2309   moreover
  2310   from assms have "\<And>x. Z < x \<Longrightarrow> x powr s < Z powr s"
  2311     by (auto simp: Z_def intro!: powr_less_mono2_neg)
  2312   with assms `0 < e` have "\<And>x. Z < x \<Longrightarrow> dist (x powr s) 0 < e"
  2313     by (simp add: powr_powr Z_def dist_real_def)
  2314   ultimately
  2315   show "eventually (\<lambda>x. dist (f x powr s) 0 < e) F" by (rule eventually_elim1)
  2316 qed
  2317 
  2318 (* it is funny that this isn't in the library! It could go in Transcendental *)
  2319 lemma tendsto_exp_limit_at_right:
  2320   fixes x :: real
  2321   shows "((\<lambda>y. (1 + x * y) powr (1 / y)) ---> exp x) (at_right 0)"
  2322 proof cases
  2323   assume "x \<noteq> 0"
  2324 
  2325   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
  2326     by (auto intro!: derivative_eq_intros)
  2327   then have "((\<lambda>y. ln (1 + x * y) / y) ---> x) (at 0)"
  2328     by (auto simp add: has_field_derivative_def field_has_derivative_at)
  2329   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) ---> exp x) (at 0)"
  2330     by (rule tendsto_intros)
  2331   then show ?thesis
  2332   proof (rule filterlim_mono_eventually)
  2333     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
  2334       unfolding eventually_at_right[OF zero_less_one]
  2335       using `x \<noteq> 0` by (intro exI[of _ "1 / \<bar>x\<bar>"]) (auto simp: field_simps powr_def)
  2336   qed (simp_all add: at_eq_sup_left_right)
  2337 qed simp
  2338 
  2339 lemma tendsto_exp_limit_at_top:
  2340   fixes x :: real
  2341   shows "((\<lambda>y. (1 + x / y) powr y) ---> exp x) at_top"
  2342   apply (subst filterlim_at_top_to_right)
  2343   apply (simp add: inverse_eq_divide)
  2344   apply (rule tendsto_exp_limit_at_right)
  2345   done
  2346 
  2347 lemma tendsto_exp_limit_sequentially:
  2348   fixes x :: real
  2349   shows "(\<lambda>n. (1 + x / n) ^ n) ----> exp x"
  2350 proof (rule filterlim_mono_eventually)
  2351   from reals_Archimedean2 [of "abs x"] obtain n :: nat where *: "real n > abs x" ..
  2352   hence "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
  2353     apply (intro eventually_sequentiallyI [of n])
  2354     apply (case_tac "x \<ge> 0")
  2355     apply (rule add_pos_nonneg, auto intro: divide_nonneg_nonneg)
  2356     apply (subgoal_tac "x / real xa > -1")
  2357     apply (auto simp add: field_simps)
  2358     done
  2359   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
  2360     by (rule eventually_elim1) (erule powr_realpow)
  2361   show "(\<lambda>n. (1 + x / real n) powr real n) ----> exp x"
  2362     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
  2363 qed auto
  2364 
  2365 subsection {* Sine and Cosine *}
  2366 
  2367 definition sin_coeff :: "nat \<Rightarrow> real" where
  2368   "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
  2369 
  2370 definition cos_coeff :: "nat \<Rightarrow> real" where
  2371   "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
  2372 
  2373 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  2374   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
  2375 
  2376 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  2377   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
  2378 
  2379 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
  2380   unfolding sin_coeff_def by simp
  2381 
  2382 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
  2383   unfolding cos_coeff_def by simp
  2384 
  2385 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
  2386   unfolding cos_coeff_def sin_coeff_def
  2387   by (simp del: mult_Suc)
  2388 
  2389 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
  2390   unfolding cos_coeff_def sin_coeff_def
  2391   by (simp del: mult_Suc) (auto elim: oddE)
  2392 
  2393 lemma summable_norm_sin:
  2394   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2395   shows "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
  2396   unfolding sin_coeff_def
  2397   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  2398   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  2399   done
  2400 
  2401 lemma summable_norm_cos:
  2402   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2403   shows "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
  2404   unfolding cos_coeff_def
  2405   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  2406   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  2407   done
  2408 
  2409 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin(x)"
  2410 unfolding sin_def
  2411   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
  2412 
  2413 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos(x)"
  2414 unfolding cos_def
  2415   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
  2416 
  2417 lemma sin_of_real:
  2418   fixes x::real
  2419   shows "sin (of_real x) = of_real (sin x)"
  2420 proof -
  2421   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
  2422   proof
  2423     fix n
  2424     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n"
  2425       by (simp add: scaleR_conv_of_real)
  2426   qed
  2427   also have "... sums (sin (of_real x))"
  2428     by (rule sin_converges)
  2429   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
  2430   then show ?thesis
  2431     using sums_unique2 sums_of_real [OF sin_converges]
  2432     by blast
  2433 qed
  2434 
  2435 lemma cos_of_real:
  2436   fixes x::real
  2437   shows "cos (of_real x) = of_real (cos x)"
  2438 proof -
  2439   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
  2440   proof
  2441     fix n
  2442     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n"
  2443       by (simp add: scaleR_conv_of_real)
  2444   qed
  2445   also have "... sums (cos (of_real x))"
  2446     by (rule cos_converges)
  2447   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
  2448   then show ?thesis
  2449     using sums_unique2 sums_of_real [OF cos_converges]
  2450     by blast
  2451 qed
  2452 
  2453 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
  2454   by (simp add: diffs_def sin_coeff_Suc real_of_nat_def del: of_nat_Suc)
  2455 
  2456 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
  2457   by (simp add: diffs_def cos_coeff_Suc real_of_nat_def del: of_nat_Suc)
  2458 
  2459 text{*Now at last we can get the derivatives of exp, sin and cos*}
  2460 
  2461 lemma DERIV_sin [simp]:
  2462   fixes x :: "'a::{real_normed_field,banach}"
  2463   shows "DERIV sin x :> cos(x)"
  2464   unfolding sin_def cos_def scaleR_conv_of_real
  2465   apply (rule DERIV_cong)
  2466   apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  2467   apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
  2468               summable_minus_iff scaleR_conv_of_real [symmetric]
  2469               summable_norm_sin [THEN summable_norm_cancel]
  2470               summable_norm_cos [THEN summable_norm_cancel])
  2471   done
  2472 
  2473 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
  2474 
  2475 lemma DERIV_cos [simp]:
  2476   fixes x :: "'a::{real_normed_field,banach}"
  2477   shows "DERIV cos x :> -sin(x)"
  2478   unfolding sin_def cos_def scaleR_conv_of_real
  2479   apply (rule DERIV_cong)
  2480   apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  2481   apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
  2482               diffs_sin_coeff diffs_cos_coeff
  2483               summable_minus_iff scaleR_conv_of_real [symmetric]
  2484               summable_norm_sin [THEN summable_norm_cancel]
  2485               summable_norm_cos [THEN summable_norm_cancel])
  2486   done
  2487 
  2488 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
  2489 
  2490 lemma isCont_sin:
  2491   fixes x :: "'a::{real_normed_field,banach}"
  2492   shows "isCont sin x"
  2493   by (rule DERIV_sin [THEN DERIV_isCont])
  2494 
  2495 lemma isCont_cos:
  2496   fixes x :: "'a::{real_normed_field,banach}"
  2497   shows "isCont cos x"
  2498   by (rule DERIV_cos [THEN DERIV_isCont])
  2499 
  2500 lemma isCont_sin' [simp]:
  2501   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2502   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
  2503   by (rule isCont_o2 [OF _ isCont_sin])
  2504 
  2505 (*FIXME A CONTEXT FOR F WOULD BE BETTER*)
  2506 
  2507 lemma isCont_cos' [simp]:
  2508   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2509   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
  2510   by (rule isCont_o2 [OF _ isCont_cos])
  2511 
  2512 lemma tendsto_sin [tendsto_intros]:
  2513   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2514   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) ---> sin a) F"
  2515   by (rule isCont_tendsto_compose [OF isCont_sin])
  2516 
  2517 lemma tendsto_cos [tendsto_intros]:
  2518   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2519   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) ---> cos a) F"
  2520   by (rule isCont_tendsto_compose [OF isCont_cos])
  2521 
  2522 lemma continuous_sin [continuous_intros]:
  2523   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2524   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
  2525   unfolding continuous_def by (rule tendsto_sin)
  2526 
  2527 lemma continuous_on_sin [continuous_intros]:
  2528   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2529   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
  2530   unfolding continuous_on_def by (auto intro: tendsto_sin)
  2531 
  2532 lemma continuous_within_sin:
  2533   fixes z :: "'a::{real_normed_field,banach}"
  2534   shows "continuous (at z within s) sin"
  2535   by (simp add: continuous_within tendsto_sin)
  2536 
  2537 lemma continuous_cos [continuous_intros]:
  2538   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2539   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
  2540   unfolding continuous_def by (rule tendsto_cos)
  2541 
  2542 lemma continuous_on_cos [continuous_intros]:
  2543   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2544   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
  2545   unfolding continuous_on_def by (auto intro: tendsto_cos)
  2546 
  2547 lemma continuous_within_cos:
  2548   fixes z :: "'a::{real_normed_field,banach}"
  2549   shows "continuous (at z within s) cos"
  2550   by (simp add: continuous_within tendsto_cos)
  2551 
  2552 subsection {* Properties of Sine and Cosine *}
  2553 
  2554 lemma sin_zero [simp]: "sin 0 = 0"
  2555   unfolding sin_def sin_coeff_def by (simp add: scaleR_conv_of_real powser_zero)
  2556 
  2557 lemma cos_zero [simp]: "cos 0 = 1"
  2558   unfolding cos_def cos_coeff_def by (simp add: scaleR_conv_of_real powser_zero)
  2559 
  2560 lemma DERIV_fun_sin:
  2561      "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin(g x)) x :> cos(g x) * m"
  2562   by (auto intro!: derivative_intros)
  2563 
  2564 lemma DERIV_fun_cos:
  2565      "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> -sin(g x) * m"
  2566   by (auto intro!: derivative_eq_intros simp: real_of_nat_def)
  2567 
  2568 subsection {*Deriving the Addition Formulas*}
  2569 
  2570 text{*The the product of two cosine series*}
  2571 lemma cos_x_cos_y:
  2572   fixes x :: "'a::{real_normed_field,banach}"
  2573   shows "(\<lambda>p. \<Sum>n\<le>p.
  2574           if even p \<and> even n
  2575           then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2576          sums (cos x * cos y)"
  2577 proof -
  2578   { fix n p::nat
  2579     assume "n\<le>p"
  2580     then have *: "even n \<Longrightarrow> even p \<Longrightarrow> (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
  2581       by (metis div_add power_add le_add_diff_inverse odd_add)
  2582     have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  2583           (if even p \<and> even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2584     using `n\<le>p`
  2585       by (auto simp: * algebra_simps cos_coeff_def binomial_fact real_of_nat_def)
  2586   }
  2587   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
  2588                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  2589              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  2590     by simp
  2591   also have "... = (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n *\<^sub>R x^n) * (cos_coeff (p - n) *\<^sub>R y^(p-n)))"
  2592     by (simp add: algebra_simps)
  2593   also have "... sums (cos x * cos y)"
  2594     using summable_norm_cos
  2595     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  2596   finally show ?thesis .
  2597 qed
  2598 
  2599 text{*The product of two sine series*}
  2600 lemma sin_x_sin_y:
  2601   fixes x :: "'a::{real_normed_field,banach}"
  2602   shows "(\<lambda>p. \<Sum>n\<le>p.
  2603           if even p \<and> odd n
  2604                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2605          sums (sin x * sin y)"
  2606 proof -
  2607   { fix n p::nat
  2608     assume "n\<le>p"
  2609     { assume np: "odd n" "even p"
  2610         with `n\<le>p` have "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
  2611         by arith+
  2612       moreover have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
  2613         by simp
  2614       ultimately have *: "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
  2615         using np `n\<le>p`
  2616         apply (simp add: power_add [symmetric] div_add [symmetric] del: div_add)
  2617         apply (metis (no_types) One_nat_def Suc_1 le_div_geq minus_minus mult.left_neutral mult_minus_left power.simps(2) zero_less_Suc)
  2618         done
  2619     } then
  2620     have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  2621           (if even p \<and> odd n
  2622           then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2623     using `n\<le>p`
  2624       by (auto simp:  algebra_simps sin_coeff_def binomial_fact real_of_nat_def)
  2625   }
  2626   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
  2627                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  2628              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  2629     by simp
  2630   also have "... = (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n *\<^sub>R x^n) * (sin_coeff (p - n) *\<^sub>R y^(p-n)))"
  2631     by (simp add: algebra_simps)
  2632   also have "... sums (sin x * sin y)"
  2633     using summable_norm_sin
  2634     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  2635   finally show ?thesis .
  2636 qed
  2637 
  2638 lemma sums_cos_x_plus_y:
  2639   fixes x :: "'a::{real_normed_field,banach}"
  2640   shows
  2641   "(\<lambda>p. \<Sum>n\<le>p. if even p
  2642                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2643                else 0)
  2644         sums cos (x + y)"
  2645 proof -
  2646   { fix p::nat
  2647     have "(\<Sum>n\<le>p. if even p
  2648                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2649                   else 0) =
  2650           (if even p
  2651                   then \<Sum>n\<le>p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2652                   else 0)"
  2653       by simp
  2654     also have "... = (if even p
  2655                   then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
  2656                   else 0)"
  2657       by (auto simp: setsum_right_distrib field_simps scaleR_conv_of_real nonzero_of_real_divide)
  2658     also have "... = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  2659       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real real_of_nat_def atLeast0AtMost)
  2660     finally have "(\<Sum>n\<le>p. if even p
  2661                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2662                   else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)" .
  2663   }
  2664   then have "(\<lambda>p. \<Sum>n\<le>p.
  2665                if even p
  2666                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2667                else 0)
  2668         = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
  2669         by simp
  2670    also have "... sums cos (x + y)"
  2671     by (rule cos_converges)
  2672    finally show ?thesis .
  2673 qed
  2674 
  2675 theorem cos_add:
  2676   fixes x :: "'a::{real_normed_field,banach}"
  2677   shows "cos (x + y) = cos x * cos y - sin x * sin y"
  2678 proof -
  2679   { fix n p::nat
  2680     assume "n\<le>p"
  2681     then have "(if even p \<and> even n
  2682                then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
  2683           (if even p \<and> odd n
  2684                then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2685           = (if even p
  2686                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2687       by simp
  2688   }
  2689   then have "(\<lambda>p. \<Sum>n\<le>p. (if even p
  2690                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0))
  2691         sums (cos x * cos y - sin x * sin y)"
  2692     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
  2693     by (simp add: setsum_subtractf [symmetric])
  2694   then show ?thesis
  2695     by (blast intro: sums_cos_x_plus_y sums_unique2)
  2696 qed
  2697 
  2698 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin(x)"
  2699 proof -
  2700   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
  2701     by (auto simp: sin_coeff_def elim!: oddE)
  2702   show ?thesis
  2703     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
  2704 qed
  2705 
  2706 lemma sin_minus [simp]:
  2707   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2708   shows "sin (-x) = -sin(x)"
  2709 using sin_minus_converges [of x]
  2710 by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel] suminf_minus sums_iff equation_minus_iff)
  2711 
  2712 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos(x)"
  2713 proof -
  2714   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
  2715     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
  2716   show ?thesis
  2717     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
  2718 qed
  2719 
  2720 lemma cos_minus [simp]:
  2721   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2722   shows "cos (-x) = cos(x)"
  2723 using cos_minus_converges [of x]
  2724 by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
  2725               suminf_minus sums_iff equation_minus_iff)
  2726 
  2727 lemma sin_cos_squared_add [simp]:
  2728   fixes x :: "'a::{real_normed_field,banach}"
  2729   shows "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
  2730 using cos_add [of x "-x"]
  2731 by (simp add: power2_eq_square algebra_simps)
  2732 
  2733 lemma sin_cos_squared_add2 [simp]:
  2734   fixes x :: "'a::{real_normed_field,banach}"
  2735   shows "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
  2736   by (subst add.commute, rule sin_cos_squared_add)
  2737 
  2738 lemma sin_cos_squared_add3 [simp]:
  2739   fixes x :: "'a::{real_normed_field,banach}"
  2740   shows "cos x * cos x + sin x * sin x = 1"
  2741   using sin_cos_squared_add2 [unfolded power2_eq_square] .
  2742 
  2743 lemma sin_squared_eq:
  2744   fixes x :: "'a::{real_normed_field,banach}"
  2745   shows "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
  2746   unfolding eq_diff_eq by (rule sin_cos_squared_add)
  2747 
  2748 lemma cos_squared_eq:
  2749   fixes x :: "'a::{real_normed_field,banach}"
  2750   shows "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
  2751   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
  2752 
  2753 lemma abs_sin_le_one [simp]:
  2754   fixes x :: real
  2755   shows "\<bar>sin x\<bar> \<le> 1"
  2756   by (rule power2_le_imp_le, simp_all add: sin_squared_eq)
  2757 
  2758 lemma sin_ge_minus_one [simp]:
  2759   fixes x :: real
  2760   shows "-1 \<le> sin x"
  2761   using abs_sin_le_one [of x] unfolding abs_le_iff by simp
  2762 
  2763 lemma sin_le_one [simp]:
  2764   fixes x :: real
  2765   shows "sin x \<le> 1"
  2766   using abs_sin_le_one [of x] unfolding abs_le_iff by simp
  2767 
  2768 lemma abs_cos_le_one [simp]:
  2769   fixes x :: real
  2770   shows "\<bar>cos x\<bar> \<le> 1"
  2771   by (rule power2_le_imp_le, simp_all add: cos_squared_eq)
  2772 
  2773 lemma cos_ge_minus_one [simp]:
  2774   fixes x :: real
  2775   shows "-1 \<le> cos x"
  2776   using abs_cos_le_one [of x] unfolding abs_le_iff by simp
  2777 
  2778 lemma cos_le_one [simp]:
  2779   fixes x :: real
  2780   shows "cos x \<le> 1"
  2781   using abs_cos_le_one [of x] unfolding abs_le_iff by simp
  2782 
  2783 lemma cos_diff:
  2784   fixes x :: "'a::{real_normed_field,banach}"
  2785   shows "cos (x - y) = cos x * cos y + sin x * sin y"
  2786   using cos_add [of x "- y"] by simp
  2787 
  2788 lemma cos_double:
  2789   fixes x :: "'a::{real_normed_field,banach}"
  2790   shows "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
  2791   using cos_add [where x=x and y=x]
  2792   by (simp add: power2_eq_square)
  2793 
  2794 lemma DERIV_fun_pow: "DERIV g x :> m ==>
  2795       DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  2796   by (auto intro!: derivative_eq_intros simp: real_of_nat_def)
  2797 
  2798 lemma DERIV_fun_exp:
  2799      "DERIV g x :> m ==> DERIV (\<lambda>x. exp(g x)) x :> exp(g x) * m"
  2800   by (auto intro!: derivative_intros)
  2801 
  2802 subsection {* The Constant Pi *}
  2803 
  2804 definition pi :: real
  2805   where "pi = 2 * (THE x. 0 \<le> (x::real) & x \<le> 2 & cos x = 0)"
  2806 
  2807 text{*Show that there's a least positive @{term x} with @{term "cos(x) = 0"};
  2808    hence define pi.*}
  2809 
  2810 lemma sin_paired:
  2811   fixes x :: real
  2812   shows "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
  2813 proof -
  2814   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
  2815     apply (rule sums_group)
  2816     using sin_converges [of x, unfolded scaleR_conv_of_real]
  2817     by auto
  2818   thus ?thesis unfolding One_nat_def sin_coeff_def by (simp add: ac_simps)
  2819 qed
  2820 
  2821 lemma sin_gt_zero_02:
  2822   fixes x :: real
  2823   assumes "0 < x" and "x < 2"
  2824   shows "0 < sin x"
  2825 proof -
  2826   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
  2827   have pos: "\<forall>n. 0 < ?f n"
  2828   proof
  2829     fix n :: nat
  2830     let ?k2 = "real (Suc (Suc (4 * n)))"
  2831     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
  2832     have "x * x < ?k2 * ?k3"
  2833       using assms by (intro mult_strict_mono', simp_all)
  2834     hence "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
  2835       by (intro mult_strict_right_mono zero_less_power `0 < x`)
  2836     thus "0 < ?f n"
  2837       by (simp add: real_of_nat_def divide_simps mult_ac del: mult_Suc)
  2838 qed
  2839   have sums: "?f sums sin x"
  2840     by (rule sin_paired [THEN sums_group], simp)
  2841   show "0 < sin x"
  2842     unfolding sums_unique [OF sums]
  2843     using sums_summable [OF sums] pos
  2844     by (rule suminf_pos)
  2845 qed
  2846 
  2847 lemma cos_double_less_one:
  2848   fixes x :: real
  2849   shows "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
  2850   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
  2851 
  2852 lemma cos_paired:
  2853   fixes x :: real
  2854   shows "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
  2855 proof -
  2856   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
  2857     apply (rule sums_group)
  2858     using cos_converges [of x, unfolded scaleR_conv_of_real]
  2859     by auto
  2860   thus ?thesis unfolding cos_coeff_def by (simp add: ac_simps)
  2861 qed
  2862 
  2863 lemmas realpow_num_eq_if = power_eq_if
  2864 
  2865 lemma sumr_pos_lt_pair:  (*FIXME A MESS, BUT THE REAL MESS IS THE NEXT THEOREM*)
  2866   fixes f :: "nat \<Rightarrow> real"
  2867   shows "\<lbrakk>summable f;
  2868         \<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
  2869       \<Longrightarrow> setsum f {..<k} < suminf f"
  2870 unfolding One_nat_def
  2871 apply (subst suminf_split_initial_segment [where k=k], assumption, simp)
  2872 apply (drule_tac k=k in summable_ignore_initial_segment)
  2873 apply (drule_tac k="Suc (Suc 0)" in sums_group [OF summable_sums], simp)
  2874 apply simp
  2875 apply (frule sums_unique)
  2876 apply (drule sums_summable, simp)
  2877 apply (erule suminf_pos)
  2878 apply (simp add: ac_simps)
  2879 done
  2880 
  2881 lemma cos_two_less_zero [simp]:
  2882   "cos 2 < (0::real)"
  2883 proof -
  2884   note fact.simps(2) [simp del]
  2885   from sums_minus [OF cos_paired]
  2886   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
  2887     by simp
  2888   then have **: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2889     by (rule sums_summable)
  2890   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2891     by (simp add: fact_num_eq_if realpow_num_eq_if)
  2892   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n))))
  2893     < (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2894   proof -
  2895     { fix d
  2896       have "(4::real) * (fact (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))
  2897             < (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d)))))))) *
  2898               fact (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d)))))))))"
  2899         unfolding real_of_nat_mult
  2900         by (rule mult_strict_mono) (simp_all add: fact_less_mono)
  2901       then have "(4::real) * (fact (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))
  2902         <  (fact (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))))"
  2903         by (simp only: fact.simps(2) [of "Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d)))))))"] real_of_nat_def of_nat_mult of_nat_fact)
  2904       then have "(4::real) * inverse (fact (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))))
  2905         < inverse (fact (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))"
  2906         by (simp add: inverse_eq_divide less_divide_eq)
  2907     }
  2908     note *** = this
  2909     have [simp]: "\<And>x y::real. 0 < x - y \<longleftrightarrow> y < x" by arith
  2910     from ** show ?thesis by (rule sumr_pos_lt_pair)
  2911       (simp add: divide_inverse mult.assoc [symmetric] ***)
  2912   qed
  2913   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2914     by (rule order_less_trans)
  2915   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2916     by (rule sums_unique)
  2917   ultimately have "(0::real) < - cos 2" by simp
  2918   then show ?thesis by simp
  2919 qed
  2920 
  2921 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
  2922 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
  2923 
  2924 lemma cos_is_zero: "EX! x::real. 0 \<le> x & x \<le> 2 \<and> cos x = 0"
  2925 proof (rule ex_ex1I)
  2926   show "\<exists>x::real. 0 \<le> x & x \<le> 2 & cos x = 0"
  2927     by (rule IVT2, simp_all)
  2928 next
  2929   fix x::real and y::real
  2930   assume x: "0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  2931   assume y: "0 \<le> y \<and> y \<le> 2 \<and> cos y = 0"
  2932   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  2933     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  2934   from x y show "x = y"
  2935     apply (cut_tac less_linear [of x y], auto)
  2936     apply (drule_tac f = cos in Rolle)
  2937     apply (drule_tac [5] f = cos in Rolle)
  2938     apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  2939     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  2940     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  2941     done
  2942 qed
  2943 
  2944 lemma pi_half: "pi/2 = (THE x. 0 \<le> x & x \<le> 2 & cos x = 0)"
  2945   by (simp add: pi_def)
  2946 
  2947 lemma cos_pi_half [simp]: "cos (pi / 2) = 0"
  2948   by (simp add: pi_half cos_is_zero [THEN theI'])
  2949 
  2950 lemma cos_of_real_pi_half [simp]:
  2951   fixes x :: "'a :: {real_field,banach,real_normed_algebra_1}"
  2952   shows "cos ((of_real pi / 2) :: 'a) = 0"
  2953 by (metis cos_pi_half cos_of_real eq_numeral_simps(4) nonzero_of_real_divide of_real_0 of_real_numeral)
  2954 
  2955 lemma pi_half_gt_zero [simp]: "0 < pi / 2"
  2956   apply (rule order_le_neq_trans)
  2957   apply (simp add: pi_half cos_is_zero [THEN theI'])
  2958   apply (metis cos_pi_half cos_zero zero_neq_one)
  2959   done
  2960 
  2961 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
  2962 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
  2963 
  2964 lemma pi_half_less_two [simp]: "pi / 2 < 2"
  2965   apply (rule order_le_neq_trans)
  2966   apply (simp add: pi_half cos_is_zero [THEN theI'])
  2967   apply (metis cos_pi_half cos_two_neq_zero)
  2968   done
  2969 
  2970 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
  2971 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
  2972 
  2973 lemma pi_gt_zero [simp]: "0 < pi"
  2974   using pi_half_gt_zero by simp
  2975 
  2976 lemma pi_ge_zero [simp]: "0 \<le> pi"
  2977   by (rule pi_gt_zero [THEN order_less_imp_le])
  2978 
  2979 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
  2980   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
  2981 
  2982 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
  2983   by (simp add: linorder_not_less)
  2984 
  2985 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
  2986   by simp
  2987 
  2988 lemma m2pi_less_pi: "- (2*pi) < pi"
  2989   by simp
  2990 
  2991 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
  2992   using sin_cos_squared_add2 [where x = "pi/2"]
  2993   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
  2994   by (simp add: power2_eq_1_iff)
  2995 
  2996 lemma sin_of_real_pi_half [simp]:
  2997   fixes x :: "'a :: {real_field,banach,real_normed_algebra_1}"
  2998   shows "sin ((of_real pi / 2) :: 'a) = 1"
  2999   using sin_pi_half
  3000 by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
  3001 
  3002 lemma sin_cos_eq:
  3003   fixes x :: "'a::{real_normed_field,banach}"
  3004   shows "sin x = cos (of_real pi / 2 - x)"
  3005   by (simp add: cos_diff)
  3006 
  3007 lemma minus_sin_cos_eq:
  3008   fixes x :: "'a::{real_normed_field,banach}"
  3009   shows "-sin x = cos (x + of_real pi / 2)"
  3010   by (simp add: cos_add nonzero_of_real_divide)
  3011 
  3012 lemma cos_sin_eq:
  3013   fixes x :: "'a::{real_normed_field,banach}"
  3014   shows "cos x = sin (of_real pi / 2 - x)"
  3015   using sin_cos_eq [of "of_real pi / 2 - x"]
  3016   by simp
  3017 
  3018 lemma sin_add:
  3019   fixes x :: "'a::{real_normed_field,banach}"
  3020   shows "sin (x + y) = sin x * cos y + cos x * sin y"
  3021   using cos_add [of "of_real pi / 2 - x" "-y"]
  3022   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
  3023 
  3024 lemma sin_diff:
  3025   fixes x :: "'a::{real_normed_field,banach}"
  3026   shows "sin (x - y) = sin x * cos y - cos x * sin y"
  3027   using sin_add [of x "- y"] by simp
  3028 
  3029 lemma sin_double:
  3030   fixes x :: "'a::{real_normed_field,banach}"
  3031   shows "sin(2 * x) = 2 * sin x * cos x"
  3032   using sin_add [where x=x and y=x] by simp
  3033 
  3034 
  3035 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
  3036   using cos_add [where x = "pi/2" and y = "pi/2"]
  3037   by (simp add: cos_of_real)
  3038 
  3039 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
  3040   using sin_add [where x = "pi/2" and y = "pi/2"]
  3041   by (simp add: sin_of_real)
  3042 
  3043 lemma cos_pi [simp]: "cos pi = -1"
  3044   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
  3045 
  3046 lemma sin_pi [simp]: "sin pi = 0"
  3047   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
  3048 
  3049 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
  3050   by (simp add: sin_add)
  3051 
  3052 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
  3053   by (simp add: sin_add)
  3054 
  3055 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
  3056   by (simp add: cos_add)
  3057 
  3058 lemma sin_periodic [simp]: "sin (x + 2*pi) = sin x"
  3059   by (simp add: sin_add sin_double cos_double)
  3060 
  3061 lemma cos_periodic [simp]: "cos (x + 2*pi) = cos x"
  3062   by (simp add: cos_add sin_double cos_double)
  3063 
  3064 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
  3065   by (induct n) (auto simp: real_of_nat_Suc distrib_right)
  3066 
  3067 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
  3068   by (metis cos_npi mult.commute)
  3069 
  3070 lemma sin_npi [simp]: "sin (real (n::nat) * pi) = 0"
  3071   by (induct n) (auto simp: real_of_nat_Suc distrib_right)
  3072 
  3073 lemma sin_npi2 [simp]: "sin (pi * real (n::nat)) = 0"
  3074   by (simp add: mult.commute [of pi])
  3075 
  3076 lemma cos_two_pi [simp]: "cos (2*pi) = 1"
  3077   by (simp add: cos_double)
  3078 
  3079 lemma sin_two_pi [simp]: "sin (2*pi) = 0"
  3080   by (simp add: sin_double)
  3081 
  3082 
  3083 lemma sin_times_sin:
  3084   fixes w :: "'a::{real_normed_field,banach}"
  3085   shows "sin(w) * sin(z) = (cos(w - z) - cos(w + z)) / 2"
  3086   by (simp add: cos_diff cos_add)
  3087 
  3088 lemma sin_times_cos:
  3089   fixes w :: "'a::{real_normed_field,banach}"
  3090   shows "sin(w) * cos(z) = (sin(w + z) + sin(w - z)) / 2"
  3091   by (simp add: sin_diff sin_add)
  3092 
  3093 lemma cos_times_sin:
  3094   fixes w :: "'a::{real_normed_field,banach}"
  3095   shows "cos(w) * sin(z) = (sin(w + z) - sin(w - z)) / 2"
  3096   by (simp add: sin_diff sin_add)
  3097 
  3098 lemma cos_times_cos:
  3099   fixes w :: "'a::{real_normed_field,banach}"
  3100   shows "cos(w) * cos(z) = (cos(w - z) + cos(w + z)) / 2"
  3101   by (simp add: cos_diff cos_add)
  3102 
  3103 lemma sin_plus_sin:  (*FIXME field_inverse_zero should not be necessary*)
  3104   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3105   shows "sin(w) + sin(z) = 2 * sin((w + z) / 2) * cos((w - z) / 2)"
  3106   apply (simp add: mult.assoc sin_times_cos)
  3107   apply (simp add: field_simps)
  3108   done
  3109 
  3110 lemma sin_diff_sin: 
  3111   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3112   shows "sin(w) - sin(z) = 2 * sin((w - z) / 2) * cos((w + z) / 2)"
  3113   apply (simp add: mult.assoc sin_times_cos)
  3114   apply (simp add: field_simps)
  3115   done
  3116 
  3117 lemma cos_plus_cos: 
  3118   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3119   shows "cos(w) + cos(z) = 2 * cos((w + z) / 2) * cos((w - z) / 2)"
  3120   apply (simp add: mult.assoc cos_times_cos)
  3121   apply (simp add: field_simps)
  3122   done
  3123 
  3124 lemma cos_diff_cos: 
  3125   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3126   shows "cos(w) - cos(z) = 2 * sin((w + z) / 2) * sin((z - w) / 2)"
  3127   apply (simp add: mult.assoc sin_times_sin)
  3128   apply (simp add: field_simps)
  3129   done
  3130 
  3131 lemma cos_double_cos: 
  3132   fixes z :: "'a::{real_normed_field,banach}"
  3133   shows "cos(2 * z) = 2 * cos z ^ 2 - 1"
  3134 by (simp add: cos_double sin_squared_eq)
  3135 
  3136 lemma cos_double_sin: 
  3137   fixes z :: "'a::{real_normed_field,banach}"
  3138   shows "cos(2 * z) = 1 - 2 * sin z ^ 2"
  3139 by (simp add: cos_double sin_squared_eq)
  3140 
  3141 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
  3142   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
  3143 
  3144 lemma cos_pi_minus [simp]: "cos (pi - x) = -(cos x)"
  3145   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
  3146 
  3147 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
  3148   by (simp add: sin_diff)
  3149 
  3150 lemma cos_minus_pi [simp]: "cos (x - pi) = -(cos x)"
  3151   by (simp add: cos_diff)
  3152 
  3153 lemma sin_2pi_minus [simp]: "sin (2*pi - x) = -(sin x)"
  3154   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
  3155 
  3156 lemma cos_2pi_minus [simp]: "cos (2*pi - x) = cos x"
  3157   by (metis (no_types, hide_lams) cos_add cos_minus cos_two_pi sin_minus sin_two_pi 
  3158            diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
  3159 
  3160 lemma sin_gt_zero2: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < sin x"
  3161   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
  3162 
  3163 lemma sin_less_zero:
  3164   assumes "- pi/2 < x" and "x < 0"
  3165   shows "sin x < 0"
  3166 proof -
  3167   have "0 < sin (- x)" using assms by (simp only: sin_gt_zero2)
  3168   thus ?thesis by simp
  3169 qed
  3170 
  3171 lemma pi_less_4: "pi < 4"
  3172   using pi_half_less_two by auto
  3173 
  3174 lemma cos_gt_zero: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < cos x"
  3175   by (simp add: cos_sin_eq sin_gt_zero2)
  3176 
  3177 lemma cos_gt_zero_pi: "\<lbrakk>-(pi/2) < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < cos x"
  3178   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
  3179   by (cases rule: linorder_cases [of x 0]) auto
  3180 
  3181 lemma cos_ge_zero: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2\<rbrakk> \<Longrightarrow> 0 \<le> cos x"
  3182   apply (auto simp: order_le_less cos_gt_zero_pi)
  3183   by (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
  3184 
  3185 lemma sin_gt_zero: "\<lbrakk>0 < x; x < pi \<rbrakk> \<Longrightarrow> 0 < sin x"
  3186   by (simp add: sin_cos_eq cos_gt_zero_pi)
  3187 
  3188 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2*pi \<Longrightarrow> sin x < 0"
  3189   using sin_gt_zero [of "x-pi"]
  3190   by (simp add: sin_diff)
  3191 
  3192 lemma pi_ge_two: "2 \<le> pi"
  3193 proof (rule ccontr)
  3194   assume "\<not> 2 \<le> pi" hence "pi < 2" by auto
  3195   have "\<exists>y > pi. y < 2 \<and> y < 2*pi"
  3196   proof (cases "2 < 2*pi")
  3197     case True with dense[OF `pi < 2`] show ?thesis by auto
  3198   next
  3199     case False have "pi < 2*pi" by auto
  3200     from dense[OF this] and False show ?thesis by auto
  3201   qed
  3202   then obtain y where "pi < y" and "y < 2" and "y < 2*pi" by blast
  3203   hence "0 < sin y" using sin_gt_zero_02 by auto
  3204   moreover
  3205   have "sin y < 0" using sin_gt_zero[of "y - pi"] `pi < y` and `y < 2*pi` sin_periodic_pi[of "y - pi"] by auto
  3206   ultimately show False by auto
  3207 qed
  3208 
  3209 lemma sin_ge_zero: "\<lbrakk>0 \<le> x; x \<le> pi\<rbrakk> \<Longrightarrow> 0 \<le> sin x"
  3210   by (auto simp: order_le_less sin_gt_zero)
  3211 
  3212 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2*pi \<Longrightarrow> sin x \<le> 0"
  3213   using sin_ge_zero [of "x-pi"]
  3214   by (simp add: sin_diff)
  3215 
  3216 text {* FIXME: This proof is almost identical to lemma @{text cos_is_zero}.
  3217   It should be possible to factor out some of the common parts. *}
  3218 
  3219 lemma cos_total: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> EX! x. 0 \<le> x & x \<le> pi & (cos x = y)"
  3220 proof (rule ex_ex1I)
  3221   assume y: "-1 \<le> y" "y \<le> 1"
  3222   show "\<exists>x. 0 \<le> x & x \<le> pi & cos x = y"
  3223     by (rule IVT2, simp_all add: y)
  3224 next
  3225   fix a b
  3226   assume a: "0 \<le> a \<and> a \<le> pi \<and> cos a = y"
  3227   assume b: "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
  3228   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3229     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3230   from a b show "a = b"
  3231     apply (cut_tac less_linear [of a b], auto)
  3232     apply (drule_tac f = cos in Rolle)
  3233     apply (drule_tac [5] f = cos in Rolle)
  3234     apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3235     apply (metis order_less_le_trans less_le sin_gt_zero)
  3236     apply (metis order_less_le_trans less_le sin_gt_zero)
  3237     done
  3238 qed
  3239 
  3240 lemma sin_total:
  3241   assumes y: "-1 \<le> y" "y \<le> 1"
  3242     shows "\<exists>! x. -(pi/2) \<le> x & x \<le> pi/2 & (sin x = y)"
  3243 proof -
  3244   from cos_total [OF y]
  3245   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
  3246            and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
  3247     by blast
  3248   show ?thesis
  3249     apply (simp add: sin_cos_eq)
  3250     apply (rule ex1I [where a="pi/2 - x"])
  3251     apply (cut_tac [2] x'="pi/2 - xa" in uniq)
  3252     using x
  3253     apply auto
  3254     done
  3255 qed
  3256 
  3257 lemma reals_Archimedean4:
  3258      "\<lbrakk>0 < y; 0 \<le> x\<rbrakk> \<Longrightarrow> \<exists>n. real n * y \<le> x & x < real (Suc n) * y"
  3259 apply (auto dest!: reals_Archimedean3)
  3260 apply (drule_tac x = x in spec, clarify)
  3261 apply (subgoal_tac "x < real(LEAST m::nat. x < real m * y) * y")
  3262  prefer 2 apply (erule LeastI)
  3263 apply (case_tac "LEAST m::nat. x < real m * y", simp)
  3264 apply (rename_tac m)
  3265 apply (subgoal_tac "~ x < real m * y")
  3266  prefer 2 apply (rule not_less_Least, simp, force)
  3267 done
  3268 
  3269 lemma cos_zero_lemma:
  3270      "\<lbrakk>0 \<le> x; cos x = 0\<rbrakk> \<Longrightarrow>
  3271       \<exists>n::nat. odd n & x = real n * (pi/2)"
  3272 apply (drule pi_gt_zero [THEN reals_Archimedean4], safe)
  3273 apply (subgoal_tac "0 \<le> x - real n * pi &
  3274                     (x - real n * pi) \<le> pi & (cos (x - real n * pi) = 0) ")
  3275 apply (auto simp: algebra_simps real_of_nat_Suc)
  3276  prefer 2 apply (simp add: cos_diff)
  3277 apply (simp add: cos_diff)
  3278 apply (subgoal_tac "EX! x. 0 \<le> x & x \<le> pi & cos x = 0")
  3279 apply (rule_tac [2] cos_total, safe)
  3280 apply (drule_tac x = "x - real n * pi" in spec)
  3281 apply (drule_tac x = "pi/2" in spec)
  3282 apply (simp add: cos_diff)
  3283 apply (rule_tac x = "Suc (2 * n)" in exI)
  3284 apply (simp add: real_of_nat_Suc algebra_simps, auto)
  3285 done
  3286 
  3287 lemma sin_zero_lemma:
  3288      "\<lbrakk>0 \<le> x; sin x = 0\<rbrakk> \<Longrightarrow>
  3289       \<exists>n::nat. even n & x = real n * (pi/2)"
  3290 apply (subgoal_tac "\<exists>n::nat. ~ even n & x + pi/2 = real n * (pi/2) ")
  3291  apply (clarify, rule_tac x = "n - 1" in exI)
  3292  apply (auto elim!: oddE simp add: real_of_nat_Suc field_simps)[1]
  3293  apply (rule cos_zero_lemma)
  3294  apply (auto simp: cos_add)
  3295 done
  3296 
  3297 lemma cos_zero_iff:
  3298      "(cos x = 0) =
  3299       ((\<exists>n::nat. odd n & (x = real n * (pi/2))) |
  3300        (\<exists>n::nat. odd n & (x = -(real n * (pi/2)))))"
  3301 proof -
  3302   { fix n :: nat
  3303     assume "odd n"
  3304     then obtain m where "n = 2 * m + 1" ..
  3305     then have "cos (real n * pi / 2) = 0"
  3306       by (simp add: field_simps real_of_nat_Suc) (simp add: cos_add add_divide_distrib)
  3307   } note * = this
  3308   show ?thesis
  3309   apply (rule iffI)
  3310   apply (cut_tac linorder_linear [of 0 x], safe)
  3311   apply (drule cos_zero_lemma, assumption+)
  3312   apply (cut_tac x="-x" in cos_zero_lemma, simp, simp)
  3313   apply (auto dest: *)
  3314   done
  3315 qed
  3316 
  3317 (* ditto: but to a lesser extent *)
  3318 lemma sin_zero_iff:
  3319      "(sin x = 0) =
  3320       ((\<exists>n::nat. even n & (x = real n * (pi/2))) |
  3321        (\<exists>n::nat. even n & (x = -(real n * (pi/2)))))"
  3322 apply (rule iffI)
  3323 apply (cut_tac linorder_linear [of 0 x], safe)
  3324 apply (drule sin_zero_lemma, assumption+)
  3325 apply (cut_tac x="-x" in sin_zero_lemma, simp, simp, safe)
  3326 apply (force simp add: minus_equation_iff [of x])
  3327 apply (auto elim: evenE)
  3328 done
  3329 
  3330 
  3331 lemma cos_zero_iff_int:
  3332      "cos x = 0 \<longleftrightarrow> (\<exists>n::int. odd n & x = real n * (pi/2))"
  3333 proof safe
  3334   assume "cos x = 0"
  3335   then show "\<exists>n::int. odd n & x = real n * (pi/2)"
  3336     apply (simp add: cos_zero_iff, safe)
  3337     apply (metis even_int_iff real_of_int_of_nat_eq)
  3338     apply (rule_tac x="- (int n)" in exI, simp)
  3339     done
  3340 next
  3341   fix n::int
  3342   assume "odd n"
  3343   then show "cos (real n * (pi / 2)) = 0"
  3344     apply (simp add: cos_zero_iff)
  3345     apply (case_tac n rule: int_cases2, simp)
  3346     apply (rule disjI2)
  3347     apply (rule_tac x="nat (-n)" in exI, simp)
  3348     done
  3349 qed
  3350 
  3351 lemma sin_zero_iff_int:
  3352      "sin x = 0 \<longleftrightarrow> (\<exists>n::int. even n & (x = real n * (pi/2)))"
  3353 proof safe
  3354   assume "sin x = 0"
  3355   then show "\<exists>n::int. even n \<and> x = real n * (pi / 2)"
  3356     apply (simp add: sin_zero_iff, safe)
  3357     apply (metis even_int_iff real_of_int_of_nat_eq)
  3358     apply (rule_tac x="- (int n)" in exI, simp)
  3359     done
  3360 next
  3361   fix n::int
  3362   assume "even n"
  3363   then show "sin (real n * (pi / 2)) = 0"
  3364     apply (simp add: sin_zero_iff)
  3365     apply (case_tac n rule: int_cases2, simp)
  3366     apply (rule disjI2)
  3367     apply (rule_tac x="nat (-n)" in exI, simp)
  3368     done
  3369 qed
  3370 
  3371 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>n::int. x = real n * pi)"
  3372   apply (simp only: sin_zero_iff_int)
  3373   apply (safe elim!: evenE)
  3374   apply (simp_all add: field_simps)
  3375   using dvd_triv_left by fastforce
  3376 
  3377 lemma cos_monotone_0_pi:
  3378   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
  3379   shows "cos x < cos y"
  3380 proof -
  3381   have "- (x - y) < 0" using assms by auto
  3382 
  3383   from MVT2[OF `y < x` DERIV_cos[THEN impI, THEN allI]]
  3384   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
  3385     by auto
  3386   hence "0 < z" and "z < pi" using assms by auto
  3387   hence "0 < sin z" using sin_gt_zero by auto
  3388   hence "cos x - cos y < 0"
  3389     unfolding cos_diff minus_mult_commute[symmetric]
  3390     using `- (x - y) < 0` by (rule mult_pos_neg2)
  3391   thus ?thesis by auto
  3392 qed
  3393 
  3394 lemma cos_monotone_0_pi':
  3395   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
  3396   shows "cos x \<le> cos y"
  3397 proof (cases "y < x")
  3398   case True
  3399   show ?thesis
  3400     using cos_monotone_0_pi[OF `0 \<le> y` True `x \<le> pi`] by auto
  3401 next
  3402   case False
  3403   hence "y = x" using `y \<le> x` by auto
  3404   thus ?thesis by auto
  3405 qed
  3406 
  3407 lemma cos_monotone_minus_pi_0:
  3408   assumes "-pi \<le> y" and "y < x" and "x \<le> 0"
  3409   shows "cos y < cos x"
  3410 proof -
  3411   have "0 \<le> -x" and "-x < -y" and "-y \<le> pi"
  3412     using assms by auto
  3413   from cos_monotone_0_pi[OF this] show ?thesis
  3414     unfolding cos_minus .
  3415 qed
  3416 
  3417 lemma cos_monotone_minus_pi_0':
  3418   assumes "-pi \<le> y" and "y \<le> x" and "x \<le> 0"
  3419   shows "cos y \<le> cos x"
  3420 proof (cases "y < x")
  3421   case True
  3422   show ?thesis using cos_monotone_minus_pi_0[OF `-pi \<le> y` True `x \<le> 0`]
  3423     by auto
  3424 next
  3425   case False
  3426   hence "y = x" using `y \<le> x` by auto
  3427   thus ?thesis by auto
  3428 qed
  3429 
  3430 lemma sin_monotone_2pi':
  3431   assumes "- (pi / 2) \<le> y" and "y \<le> x" and "x \<le> pi / 2"
  3432   shows "sin y \<le> sin x"
  3433 proof -
  3434   have "0 \<le> y + pi / 2" and "y + pi / 2 \<le> x + pi / 2" and "x + pi /2 \<le> pi"
  3435     using pi_ge_two and assms by auto
  3436   from cos_monotone_0_pi'[OF this] show ?thesis
  3437     unfolding minus_sin_cos_eq[symmetric]
  3438     by (metis minus_sin_cos_eq mult.right_neutral neg_le_iff_le of_real_def real_scaleR_def)
  3439 qed
  3440 
  3441 lemma sin_x_le_x:
  3442   fixes x::real assumes x: "x \<ge> 0" shows "sin x \<le> x"
  3443 proof -
  3444   let ?f = "\<lambda>x. x - sin x"
  3445   from x have "?f x \<ge> ?f 0"
  3446     apply (rule DERIV_nonneg_imp_nondecreasing)
  3447     apply (intro allI impI exI[of _ "1 - cos x" for x])
  3448     apply (auto intro!: derivative_eq_intros simp: field_simps)
  3449     done
  3450   thus "sin x \<le> x" by simp
  3451 qed
  3452 
  3453 lemma sin_x_ge_neg_x:
  3454   fixes x::real assumes x: "x \<ge> 0" shows "sin x \<ge> - x"
  3455 proof -
  3456   let ?f = "\<lambda>x. x + sin x"
  3457   from x have "?f x \<ge> ?f 0"
  3458     apply (rule DERIV_nonneg_imp_nondecreasing)
  3459     apply (intro allI impI exI[of _ "1 + cos x" for x])
  3460     apply (auto intro!: derivative_eq_intros simp: field_simps real_0_le_add_iff)
  3461     done
  3462   thus "sin x \<ge> -x" by simp
  3463 qed
  3464 
  3465 lemma abs_sin_x_le_abs_x:
  3466   fixes x::real shows "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
  3467   using sin_x_ge_neg_x [of x] sin_x_le_x [of x] sin_x_ge_neg_x [of "-x"] sin_x_le_x [of "-x"]
  3468   by (auto simp: abs_real_def)
  3469 
  3470 
  3471 subsection {* Tangent *}
  3472 
  3473 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3474   where "tan = (\<lambda>x. sin x / cos x)"
  3475 
  3476 lemma tan_zero [simp]: "tan 0 = 0"
  3477   by (simp add: tan_def)
  3478 
  3479 lemma tan_pi [simp]: "tan pi = 0"
  3480   by (simp add: tan_def)
  3481 
  3482 lemma tan_npi [simp]: "tan (real (n::nat) * pi) = 0"
  3483   by (simp add: tan_def)
  3484 
  3485 lemma tan_minus [simp]: "tan (-x) = - tan x"
  3486   by (simp add: tan_def)
  3487 
  3488 lemma tan_periodic [simp]: "tan (x + 2*pi) = tan x"
  3489   by (simp add: tan_def)
  3490 
  3491 lemma lemma_tan_add1:
  3492   "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0\<rbrakk> \<Longrightarrow> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
  3493   by (simp add: tan_def cos_add field_simps)
  3494 
  3495 lemma add_tan_eq:
  3496   fixes x :: "'a::{real_normed_field,banach}"
  3497   shows "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0\<rbrakk> \<Longrightarrow> tan x + tan y = sin(x + y)/(cos x * cos y)"
  3498   by (simp add: tan_def sin_add field_simps)
  3499 
  3500 lemma tan_add:
  3501   fixes x :: "'a::{real_normed_field,banach}"
  3502   shows
  3503      "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0; cos (x + y) \<noteq> 0\<rbrakk>
  3504       \<Longrightarrow> tan(x + y) = (tan(x) + tan(y))/(1 - tan(x) * tan(y))"
  3505       by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
  3506 
  3507 lemma tan_double:
  3508   fixes x :: "'a::{real_normed_field,banach}"
  3509   shows
  3510      "\<lbrakk>cos x \<noteq> 0; cos (2 * x) \<noteq> 0\<rbrakk>
  3511       \<Longrightarrow> tan (2 * x) = (2 * tan x) / (1 - (tan x)\<^sup>2)"
  3512   using tan_add [of x x] by (simp add: power2_eq_square)
  3513 
  3514 lemma tan_gt_zero: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < tan x"
  3515   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  3516 
  3517 lemma tan_less_zero:
  3518   assumes lb: "- pi/2 < x" and "x < 0"
  3519   shows "tan x < 0"
  3520 proof -
  3521   have "0 < tan (- x)" using assms by (simp only: tan_gt_zero)
  3522   thus ?thesis by simp
  3523 qed
  3524 
  3525 lemma tan_half:
  3526   fixes x :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3527   shows  "tan x = sin (2 * x) / (cos (2 * x) + 1)"
  3528   unfolding tan_def sin_double cos_double sin_squared_eq
  3529   by (simp add: power2_eq_square)
  3530 
  3531 lemma DERIV_tan [simp]:
  3532   fixes x :: "'a::{real_normed_field,banach}"
  3533   shows "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
  3534   unfolding tan_def
  3535   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
  3536 
  3537 lemma isCont_tan:
  3538   fixes x :: "'a::{real_normed_field,banach}"
  3539   shows "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
  3540   by (rule DERIV_tan [THEN DERIV_isCont])
  3541 
  3542 lemma isCont_tan' [simp,continuous_intros]:
  3543   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  3544   shows "\<lbrakk>isCont f a; cos (f a) \<noteq> 0\<rbrakk> \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
  3545   by (rule isCont_o2 [OF _ isCont_tan])
  3546 
  3547 lemma tendsto_tan [tendsto_intros]:
  3548   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3549   shows "\<lbrakk>(f ---> a) F; cos a \<noteq> 0\<rbrakk> \<Longrightarrow> ((\<lambda>x. tan (f x)) ---> tan a) F"
  3550   by (rule isCont_tendsto_compose [OF isCont_tan])
  3551 
  3552 lemma continuous_tan:
  3553   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3554   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
  3555   unfolding continuous_def by (rule tendsto_tan)
  3556 
  3557 lemma continuous_on_tan [continuous_intros]:
  3558   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3559   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
  3560   unfolding continuous_on_def by (auto intro: tendsto_tan)
  3561 
  3562 lemma continuous_within_tan [continuous_intros]:
  3563   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3564   shows
  3565   "continuous (at x within s) f \<Longrightarrow> cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
  3566   unfolding continuous_within by (rule tendsto_tan)
  3567 
  3568 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) -- pi/2 --> 0"
  3569   by (rule LIM_cong_limit, (rule tendsto_intros)+, simp_all)
  3570 
  3571 lemma lemma_tan_total: "0 < y ==> \<exists>x. 0 < x & x < pi/2 & y < tan x"
  3572   apply (cut_tac LIM_cos_div_sin)
  3573   apply (simp only: LIM_eq)
  3574   apply (drule_tac x = "inverse y" in spec, safe, force)
  3575   apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero], safe)
  3576   apply (rule_tac x = "(pi/2) - e" in exI)
  3577   apply (simp (no_asm_simp))
  3578   apply (drule_tac x = "(pi/2) - e" in spec)
  3579   apply (auto simp add: tan_def sin_diff cos_diff)
  3580   apply (rule inverse_less_iff_less [THEN iffD1])
  3581   apply (auto simp add: divide_inverse)
  3582   apply (rule mult_pos_pos)
  3583   apply (subgoal_tac [3] "0 < sin e & 0 < cos e")
  3584   apply (auto intro: cos_gt_zero sin_gt_zero2 simp add: mult.commute)
  3585   done
  3586 
  3587 lemma tan_total_pos: "0 \<le> y ==> \<exists>x. 0 \<le> x & x < pi/2 & tan x = y"
  3588   apply (frule order_le_imp_less_or_eq, safe)
  3589    prefer 2 apply force
  3590   apply (drule lemma_tan_total, safe)
  3591   apply (cut_tac f = tan and a = 0 and b = x and y = y in IVT_objl)
  3592   apply (auto intro!: DERIV_tan [THEN DERIV_isCont])
  3593   apply (drule_tac y = xa in order_le_imp_less_or_eq)
  3594   apply (auto dest: cos_gt_zero)
  3595   done
  3596 
  3597 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x & x < (pi/2) & tan x = y"
  3598   apply (cut_tac linorder_linear [of 0 y], safe)
  3599   apply (drule tan_total_pos)
  3600   apply (cut_tac [2] y="-y" in tan_total_pos, safe)
  3601   apply (rule_tac [3] x = "-x" in exI)
  3602   apply (auto del: exI intro!: exI)
  3603   done
  3604 
  3605 lemma tan_total: "EX! x. -(pi/2) < x & x < (pi/2) & tan x = y"
  3606   apply (cut_tac y = y in lemma_tan_total1, auto)
  3607   apply hypsubst_thin
  3608   apply (cut_tac x = xa and y = y in linorder_less_linear, auto)
  3609   apply (subgoal_tac [2] "\<exists>z. y < z & z < xa & DERIV tan z :> 0")
  3610   apply (subgoal_tac "\<exists>z. xa < z & z < y & DERIV tan z :> 0")
  3611   apply (rule_tac [4] Rolle)
  3612   apply (rule_tac [2] Rolle)
  3613   apply (auto del: exI intro!: DERIV_tan DERIV_isCont exI
  3614               simp add: real_differentiable_def)
  3615   txt{*Now, simulate TRYALL*}
  3616   apply (rule_tac [!] DERIV_tan asm_rl)
  3617   apply (auto dest!: DERIV_unique [OF _ DERIV_tan]
  3618               simp add: cos_gt_zero_pi [THEN less_imp_neq, THEN not_sym])
  3619   done
  3620 
  3621 lemma tan_monotone:
  3622   assumes "- (pi / 2) < y" and "y < x" and "x < pi / 2"
  3623   shows "tan y < tan x"
  3624 proof -
  3625   have "\<forall>x'. y \<le> x' \<and> x' \<le> x \<longrightarrow> DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  3626   proof (rule allI, rule impI)
  3627     fix x' :: real
  3628     assume "y \<le> x' \<and> x' \<le> x"
  3629     hence "-(pi/2) < x'" and "x' < pi/2" using assms by auto
  3630     from cos_gt_zero_pi[OF this]
  3631     have "cos x' \<noteq> 0" by auto
  3632     thus "DERIV tan x' :> inverse ((cos x')\<^sup>2)" by (rule DERIV_tan)
  3633   qed
  3634   from MVT2[OF `y < x` this]
  3635   obtain z where "y < z" and "z < x"
  3636     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
  3637   hence "- (pi / 2) < z" and "z < pi / 2" using assms by auto
  3638   hence "0 < cos z" using cos_gt_zero_pi by auto
  3639   hence inv_pos: "0 < inverse ((cos z)\<^sup>2)" by auto
  3640   have "0 < x - y" using `y < x` by auto
  3641   with inv_pos have "0 < tan x - tan y" unfolding tan_diff by auto
  3642   thus ?thesis by auto
  3643 qed
  3644 
  3645 lemma tan_monotone':
  3646   assumes "- (pi / 2) < y"
  3647     and "y < pi / 2"
  3648     and "- (pi / 2) < x"
  3649     and "x < pi / 2"
  3650   shows "(y < x) = (tan y < tan x)"
  3651 proof
  3652   assume "y < x"
  3653   thus "tan y < tan x"
  3654     using tan_monotone and `- (pi / 2) < y` and `x < pi / 2` by auto
  3655 next
  3656   assume "tan y < tan x"
  3657   show "y < x"
  3658   proof (rule ccontr)
  3659     assume "\<not> y < x" hence "x \<le> y" by auto
  3660     hence "tan x \<le> tan y"
  3661     proof (cases "x = y")
  3662       case True thus ?thesis by auto
  3663     next
  3664       case False hence "x < y" using `x \<le> y` by auto
  3665       from tan_monotone[OF `- (pi/2) < x` this `y < pi / 2`] show ?thesis by auto
  3666     qed
  3667     thus False using `tan y < tan x` by auto
  3668   qed
  3669 qed
  3670 
  3671 lemma tan_inverse: "1 / (tan y) = tan (pi / 2 - y)"
  3672   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
  3673 
  3674 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
  3675   by (simp add: tan_def)
  3676 
  3677 lemma tan_periodic_nat[simp]:
  3678   fixes n :: nat
  3679   shows "tan (x + real n * pi) = tan x"
  3680 proof (induct n arbitrary: x)
  3681   case 0
  3682   then show ?case by simp
  3683 next
  3684   case (Suc n)
  3685   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
  3686     unfolding Suc_eq_plus1 real_of_nat_add real_of_one distrib_right by auto
  3687   show ?case unfolding split_pi_off using Suc by auto
  3688 qed
  3689 
  3690 lemma tan_periodic_int[simp]: fixes i :: int shows "tan (x + real i * pi) = tan x"
  3691 proof (cases "0 \<le> i")
  3692   case True
  3693   hence i_nat: "real i = real (nat i)" by auto
  3694   show ?thesis unfolding i_nat by auto
  3695 next
  3696   case False
  3697   hence i_nat: "real i = - real (nat (-i))" by auto
  3698   have "tan x = tan (x + real i * pi - real i * pi)"
  3699     by auto
  3700   also have "\<dots> = tan (x + real i * pi)"
  3701     unfolding i_nat mult_minus_left diff_minus_eq_add by (rule tan_periodic_nat)
  3702   finally show ?thesis by auto
  3703 qed
  3704 
  3705 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
  3706   using tan_periodic_int[of _ "numeral n" ] unfolding real_numeral .
  3707 
  3708 
  3709 subsection {* Inverse Trigonometric Functions *}
  3710 text{*STILL DEFINED FOR THE REALS ONLY*}
  3711 
  3712 definition arcsin :: "real => real"
  3713   where "arcsin y = (THE x. -(pi/2) \<le> x & x \<le> pi/2 & sin x = y)"
  3714 
  3715 definition arccos :: "real => real"
  3716   where "arccos y = (THE x. 0 \<le> x & x \<le> pi & cos x = y)"
  3717 
  3718 definition arctan :: "real => real"
  3719   where "arctan y = (THE x. -(pi/2) < x & x < pi/2 & tan x = y)"
  3720 
  3721 lemma arcsin:
  3722   "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow>
  3723     -(pi/2) \<le> arcsin y & arcsin y \<le> pi/2 & sin(arcsin y) = y"
  3724   unfolding arcsin_def by (rule theI' [OF sin_total])
  3725 
  3726 lemma arcsin_pi:
  3727   "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y & arcsin y \<le> pi & sin(arcsin y) = y"
  3728   apply (drule (1) arcsin)
  3729   apply (force intro: order_trans)
  3730   done
  3731 
  3732 lemma sin_arcsin [simp]: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin(arcsin y) = y"
  3733   by (blast dest: arcsin)
  3734 
  3735 lemma arcsin_bounded: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y & arcsin y \<le> pi/2"
  3736   by (blast dest: arcsin)
  3737 
  3738 lemma arcsin_lbound: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y"
  3739   by (blast dest: arcsin)
  3740 
  3741 lemma arcsin_ubound: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
  3742   by (blast dest: arcsin)
  3743 
  3744 lemma arcsin_lt_bounded:
  3745      "\<lbrakk>-1 < y; y < 1\<rbrakk> \<Longrightarrow> -(pi/2) < arcsin y & arcsin y < pi/2"
  3746   apply (frule order_less_imp_le)
  3747   apply (frule_tac y = y in order_less_imp_le)
  3748   apply (frule arcsin_bounded)
  3749   apply (safe, simp)
  3750   apply (drule_tac y = "arcsin y" in order_le_imp_less_or_eq)
  3751   apply (drule_tac [2] y = "pi/2" in order_le_imp_less_or_eq, safe)
  3752   apply (drule_tac [!] f = sin in arg_cong, auto)
  3753   done
  3754 
  3755 lemma arcsin_sin: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2\<rbrakk> \<Longrightarrow> arcsin(sin x) = x"
  3756   apply (unfold arcsin_def)
  3757   apply (rule the1_equality)
  3758   apply (rule sin_total, auto)
  3759   done
  3760 
  3761 lemma arccos:
  3762      "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk>
  3763       \<Longrightarrow> 0 \<le> arccos y & arccos y \<le> pi & cos(arccos y) = y"
  3764   unfolding arccos_def by (rule theI' [OF cos_total])
  3765 
  3766 lemma cos_arccos [simp]: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> cos(arccos y) = y"
  3767   by (blast dest: arccos)
  3768 
  3769 lemma arccos_bounded: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> arccos y & arccos y \<le> pi"
  3770   by (blast dest: arccos)
  3771 
  3772 lemma arccos_lbound: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> arccos y"
  3773   by (blast dest: arccos)
  3774 
  3775 lemma arccos_ubound: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi"
  3776   by (blast dest: arccos)
  3777 
  3778 lemma arccos_lt_bounded:
  3779      "\<lbrakk>-1 < y; y < 1\<rbrakk>
  3780       \<Longrightarrow> 0 < arccos y & arccos y < pi"
  3781   apply (frule order_less_imp_le)
  3782   apply (frule_tac y = y in order_less_imp_le)
  3783   apply (frule arccos_bounded, auto)
  3784   apply (drule_tac y = "arccos y" in order_le_imp_less_or_eq)
  3785   apply (drule_tac [2] y = pi in order_le_imp_less_or_eq, auto)
  3786   apply (drule_tac [!] f = cos in arg_cong, auto)
  3787   done
  3788 
  3789 lemma arccos_cos: "\<lbrakk>0 \<le> x; x \<le> pi\<rbrakk> \<Longrightarrow> arccos(cos x) = x"
  3790   apply (simp add: arccos_def)
  3791   apply (auto intro!: the1_equality cos_total)
  3792   done
  3793 
  3794 lemma arccos_cos2: "\<lbrakk>x \<le> 0; -pi \<le> x\<rbrakk> \<Longrightarrow> arccos(cos x) = -x"
  3795   apply (simp add: arccos_def)
  3796   apply (auto intro!: the1_equality cos_total)
  3797   done
  3798 
  3799 lemma cos_arcsin: "\<lbrakk>-1 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> cos (arcsin x) = sqrt (1 - x\<^sup>2)"
  3800   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  3801   apply (rule power2_eq_imp_eq)
  3802   apply (simp add: cos_squared_eq)
  3803   apply (rule cos_ge_zero)
  3804   apply (erule (1) arcsin_lbound)
  3805   apply (erule (1) arcsin_ubound)
  3806   apply simp
  3807   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2", simp)
  3808   apply (rule power_mono, simp, simp)
  3809   done
  3810 
  3811 lemma sin_arccos: "\<lbrakk>-1 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> sin (arccos x) = sqrt (1 - x\<^sup>2)"
  3812   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  3813   apply (rule power2_eq_imp_eq)
  3814   apply (simp add: sin_squared_eq)
  3815   apply (rule sin_ge_zero)
  3816   apply (erule (1) arccos_lbound)
  3817   apply (erule (1) arccos_ubound)
  3818   apply simp
  3819   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2", simp)
  3820   apply (rule power_mono, simp, simp)
  3821   done
  3822 
  3823 lemma arctan [simp]: "- (pi/2) < arctan y  & arctan y < pi/2 & tan (arctan y) = y"
  3824   unfolding arctan_def by (rule theI' [OF tan_total])
  3825 
  3826 lemma tan_arctan: "tan (arctan y) = y"
  3827   by auto
  3828 
  3829 lemma arctan_bounded: "- (pi/2) < arctan y  & arctan y < pi/2"
  3830   by (auto simp only: arctan)
  3831 
  3832 lemma arctan_lbound: "- (pi/2) < arctan y"
  3833   by auto
  3834 
  3835 lemma arctan_ubound: "arctan y < pi/2"
  3836   by (auto simp only: arctan)
  3837 
  3838 lemma arctan_unique:
  3839   assumes "-(pi/2) < x"
  3840     and "x < pi/2"
  3841     and "tan x = y"
  3842   shows "arctan y = x"
  3843   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
  3844 
  3845 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
  3846   by (rule arctan_unique) simp_all
  3847 
  3848 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
  3849   by (rule arctan_unique) simp_all
  3850 
  3851 lemma arctan_minus: "arctan (- x) = - arctan x"
  3852   apply (rule arctan_unique)
  3853   apply (simp only: neg_less_iff_less arctan_ubound)
  3854   apply (metis minus_less_iff arctan_lbound, simp)
  3855   done
  3856 
  3857 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
  3858   by (intro less_imp_neq [symmetric] cos_gt_zero_pi
  3859     arctan_lbound arctan_ubound)
  3860 
  3861 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
  3862 proof (rule power2_eq_imp_eq)
  3863   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
  3864   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
  3865   show "0 \<le> cos (arctan x)"
  3866     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
  3867   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
  3868     unfolding tan_def by (simp add: distrib_left power_divide)
  3869   thus "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
  3870     using `0 < 1 + x\<^sup>2` by (simp add: power_divide eq_divide_eq)
  3871 qed
  3872 
  3873 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
  3874   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
  3875   using tan_arctan [of x] unfolding tan_def cos_arctan
  3876   by (simp add: eq_divide_eq)
  3877 
  3878 lemma tan_sec:
  3879   fixes x :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3880   shows "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
  3881   apply (rule power_inverse [THEN subst])
  3882   apply (rule_tac c1 = "(cos x)\<^sup>2" in mult_right_cancel [THEN iffD1])
  3883   apply (auto dest: field_power_not_zero
  3884           simp add: power_mult_distrib distrib_right power_divide tan_def
  3885                     mult.assoc power_inverse [symmetric])
  3886   done
  3887 
  3888 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
  3889   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
  3890 
  3891 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
  3892   by (simp only: not_less [symmetric] arctan_less_iff)
  3893 
  3894 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
  3895   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
  3896 
  3897 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
  3898   using arctan_less_iff [of 0 x] by simp
  3899 
  3900 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
  3901   using arctan_less_iff [of x 0] by simp
  3902 
  3903 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
  3904   using arctan_le_iff [of 0 x] by simp
  3905 
  3906 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
  3907   using arctan_le_iff [of x 0] by simp
  3908 
  3909 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
  3910   using arctan_eq_iff [of x 0] by simp
  3911 
  3912 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
  3913 proof -
  3914   have "continuous_on (sin ` {- pi / 2 .. pi / 2}) arcsin"
  3915     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
  3916   also have "sin ` {- pi / 2 .. pi / 2} = {-1 .. 1}"
  3917   proof safe
  3918     fix x :: real
  3919     assume "x \<in> {-1..1}"
  3920     then show "x \<in> sin ` {- pi / 2..pi / 2}"
  3921       using arcsin_lbound arcsin_ubound
  3922       by (intro image_eqI[where x="arcsin x"]) auto
  3923   qed simp
  3924   finally show ?thesis .
  3925 qed
  3926 
  3927 lemma continuous_on_arcsin [continuous_intros]:
  3928   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. -1 \<le> f x \<and> f x \<le> 1) \<Longrightarrow> continuous_on s (\<lambda>x. arcsin (f x))"
  3929   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
  3930   by (auto simp: comp_def subset_eq)
  3931 
  3932 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
  3933   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  3934   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  3935 
  3936 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
  3937 proof -
  3938   have "continuous_on (cos ` {0 .. pi}) arccos"
  3939     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
  3940   also have "cos ` {0 .. pi} = {-1 .. 1}"
  3941   proof safe
  3942     fix x :: real
  3943     assume "x \<in> {-1..1}"
  3944     then show "x \<in> cos ` {0..pi}"
  3945       using arccos_lbound arccos_ubound
  3946       by (intro image_eqI[where x="arccos x"]) auto
  3947   qed simp
  3948   finally show ?thesis .
  3949 qed
  3950 
  3951 lemma continuous_on_arccos [continuous_intros]:
  3952   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. -1 \<le> f x \<and> f x \<le> 1) \<Longrightarrow> continuous_on s (\<lambda>x. arccos (f x))"
  3953   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
  3954   by (auto simp: comp_def subset_eq)
  3955 
  3956 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
  3957   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  3958   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  3959 
  3960 lemma isCont_arctan: "isCont arctan x"
  3961   apply (rule arctan_lbound [of x, THEN dense, THEN exE], clarify)
  3962   apply (rule arctan_ubound [of x, THEN dense, THEN exE], clarify)
  3963   apply (subgoal_tac "isCont arctan (tan (arctan x))", simp)
  3964   apply (erule (1) isCont_inverse_function2 [where f=tan])
  3965   apply (metis arctan_tan order_le_less_trans order_less_le_trans)
  3966   apply (metis cos_gt_zero_pi isCont_tan order_less_le_trans less_le)
  3967   done
  3968 
  3969 lemma tendsto_arctan [tendsto_intros]: "(f ---> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) ---> arctan x) F"
  3970   by (rule isCont_tendsto_compose [OF isCont_arctan])
  3971 
  3972 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
  3973   unfolding continuous_def by (rule tendsto_arctan)
  3974 
  3975 lemma continuous_on_arctan [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
  3976   unfolding continuous_on_def by (auto intro: tendsto_arctan)
  3977 
  3978 lemma DERIV_arcsin:
  3979   "\<lbrakk>-1 < x; x < 1\<rbrakk> \<Longrightarrow> DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
  3980   apply (rule DERIV_inverse_function [where f=sin and a="-1" and b=1])
  3981   apply (rule DERIV_cong [OF DERIV_sin])
  3982   apply (simp add: cos_arcsin)
  3983   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2", simp)
  3984   apply (rule power_strict_mono, simp, simp, simp, assumption, assumption)
  3985   apply simp
  3986   apply (erule (1) isCont_arcsin)
  3987   done
  3988 
  3989 lemma DERIV_arccos:
  3990   "\<lbrakk>-1 < x; x < 1\<rbrakk> \<Longrightarrow> DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
  3991   apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
  3992   apply (rule DERIV_cong [OF DERIV_cos])
  3993   apply (simp add: sin_arccos)
  3994   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2", simp)
  3995   apply (rule power_strict_mono, simp, simp, simp, assumption, assumption)
  3996   apply simp
  3997   apply (erule (1) isCont_arccos)
  3998   done
  3999 
  4000 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
  4001   apply (rule DERIV_inverse_function [where f=tan and a="x - 1" and b="x + 1"])
  4002   apply (rule DERIV_cong [OF DERIV_tan])
  4003   apply (rule cos_arctan_not_zero)
  4004   apply (simp add: power_inverse tan_sec [symmetric])
  4005   apply (subgoal_tac "0 < 1 + x\<^sup>2", simp)
  4006   apply (simp add: add_pos_nonneg)
  4007   apply (simp, simp, simp, rule isCont_arctan)
  4008   done
  4009 
  4010 declare
  4011   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
  4012   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
  4013   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
  4014 
  4015 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- pi/2))"
  4016   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. - pi/2 < x \<and> x < pi/2" and P="\<lambda>x. True" and g=arctan])
  4017      (auto simp: le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  4018            intro!: tan_monotone exI[of _ "pi/2"])
  4019 
  4020 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
  4021   by (rule filterlim_at_top_at_left[where Q="\<lambda>x. - pi/2 < x \<and> x < pi/2" and P="\<lambda>x. True" and g=arctan])
  4022      (auto simp: le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  4023            intro!: tan_monotone exI[of _ "pi/2"])
  4024 
  4025 lemma tendsto_arctan_at_top: "(arctan ---> (pi/2)) at_top"
  4026 proof (rule tendstoI)
  4027   fix e :: real
  4028   assume "0 < e"
  4029   def y \<equiv> "pi/2 - min (pi/2) e"
  4030   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
  4031     using `0 < e` by auto
  4032 
  4033   show "eventually (\<lambda>x. dist (arctan x) (pi / 2) < e) at_top"
  4034   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
  4035     fix x
  4036     assume "tan y < x"
  4037     then have "arctan (tan y) < arctan x"
  4038       by (simp add: arctan_less_iff)
  4039     with y have "y < arctan x"
  4040       by (subst (asm) arctan_tan) simp_all
  4041     with arctan_ubound[of x, arith] y `0 < e`
  4042     show "dist (arctan x) (pi / 2) < e"
  4043       by (simp add: dist_real_def)
  4044   qed
  4045 qed
  4046 
  4047 lemma tendsto_arctan_at_bot: "(arctan ---> - (pi/2)) at_bot"
  4048   unfolding filterlim_at_bot_mirror arctan_minus
  4049   by (intro tendsto_minus tendsto_arctan_at_top)
  4050 
  4051 
  4052 subsection {* More Theorems about Sin and Cos *}
  4053 
  4054 lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
  4055 proof -
  4056   let ?c = "cos (pi / 4)" and ?s = "sin (pi / 4)"
  4057   have nonneg: "0 \<le> ?c"
  4058     by (simp add: cos_ge_zero)
  4059   have "0 = cos (pi / 4 + pi / 4)"
  4060     by simp
  4061   also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
  4062     by (simp only: cos_add power2_eq_square)
  4063   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
  4064     by (simp add: sin_squared_eq)
  4065   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
  4066     by (simp add: power_divide)
  4067   thus ?thesis
  4068     using nonneg by (rule power2_eq_imp_eq) simp
  4069 qed
  4070 
  4071 lemma cos_30: "cos (pi / 6) = sqrt 3/2"
  4072 proof -
  4073   let ?c = "cos (pi / 6)" and ?s = "sin (pi / 6)"
  4074   have pos_c: "0 < ?c"
  4075     by (rule cos_gt_zero, simp, simp)
  4076   have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
  4077     by simp
  4078   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
  4079     by (simp only: cos_add sin_add)
  4080   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
  4081     by (simp add: algebra_simps power2_eq_square)
  4082   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
  4083     using pos_c by (simp add: sin_squared_eq power_divide)
  4084   thus ?thesis
  4085     using pos_c [THEN order_less_imp_le]
  4086     by (rule power2_eq_imp_eq) simp
  4087 qed
  4088 
  4089 lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
  4090   by (simp add: sin_cos_eq cos_45)
  4091 
  4092 lemma sin_60: "sin (pi / 3) = sqrt 3/2"
  4093   by (simp add: sin_cos_eq cos_30)
  4094 
  4095 lemma cos_60: "cos (pi / 3) = 1 / 2"
  4096   apply (rule power2_eq_imp_eq)
  4097   apply (simp add: cos_squared_eq sin_60 power_divide)
  4098   apply (rule cos_ge_zero, rule order_trans [where y=0], simp_all)
  4099   done
  4100 
  4101 lemma sin_30: "sin (pi / 6) = 1 / 2"
  4102   by (simp add: sin_cos_eq cos_60)
  4103 
  4104 lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
  4105   unfolding tan_def by (simp add: sin_30 cos_30)
  4106 
  4107 lemma tan_45: "tan (pi / 4) = 1"
  4108   unfolding tan_def by (simp add: sin_45 cos_45)
  4109 
  4110 lemma tan_60: "tan (pi / 3) = sqrt 3"
  4111   unfolding tan_def by (simp add: sin_60 cos_60)
  4112 
  4113 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi / 2) = (-1) ^ n"
  4114 proof -
  4115   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
  4116     by (auto simp: algebra_simps sin_add)
  4117   thus ?thesis
  4118     by (simp add: real_of_nat_Suc distrib_right add_divide_distrib
  4119                   mult.commute [of pi])
  4120 qed
  4121 
  4122 lemma cos_2npi [simp]: "cos (2 * real (n::nat) * pi) = 1"
  4123   by (cases "even n") (simp_all add: cos_double mult.assoc)
  4124 
  4125 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
  4126   apply (subgoal_tac "cos (pi + pi/2) = 0", simp)
  4127   apply (subst cos_add, simp)
  4128   done
  4129 
  4130 lemma sin_2npi [simp]: "sin (2 * real (n::nat) * pi) = 0"
  4131   by (auto simp: mult.assoc sin_double)
  4132 
  4133 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
  4134   apply (subgoal_tac "sin (pi + pi/2) = - 1", simp)
  4135   apply (subst sin_add, simp)
  4136   done
  4137 
  4138 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
  4139 by (simp only: cos_add sin_add real_of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
  4140 
  4141 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
  4142   by (auto intro!: derivative_eq_intros)
  4143 
  4144 lemma sin_zero_norm_cos_one:
  4145   fixes x :: "'a::{real_normed_field,banach}"
  4146   assumes "sin x = 0" shows "norm (cos x) = 1"
  4147   using sin_cos_squared_add [of x, unfolded assms]
  4148   by (simp add: square_norm_one)
  4149 
  4150 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
  4151   using sin_zero_norm_cos_one by fastforce
  4152 
  4153 lemma cos_one_sin_zero:
  4154   fixes x :: "'a::{real_normed_field,banach}"
  4155   assumes "cos x = 1" shows "sin x = 0"
  4156   using sin_cos_squared_add [of x, unfolded assms]
  4157   by simp
  4158 
  4159 
  4160 subsection{* Prove Totality of the Trigonometric Functions *}
  4161 
  4162 lemma arccos_0 [simp]: "arccos 0 = pi/2"
  4163 by (metis arccos_cos cos_gt_zero cos_pi cos_pi_half pi_gt_zero pi_half_ge_zero not_le not_zero_less_neg_numeral numeral_One)
  4164 
  4165 lemma arccos_1 [simp]: "arccos 1 = 0"
  4166   using arccos_cos by force
  4167 
  4168 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
  4169   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi'
  4170       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
  4171 
  4172 lemma sincos_total_pi_half:
  4173   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  4174     shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
  4175 proof -
  4176   have x1: "x \<le> 1"
  4177     using assms
  4178     by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2) 
  4179   moreover with assms have ax: "0 \<le> arccos x" "cos(arccos x) = x"
  4180     by (auto simp: arccos)
  4181   moreover have "y = sqrt (1 - x\<^sup>2)" using assms
  4182     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
  4183   ultimately show ?thesis using assms arccos_le_pi2 [of x] 
  4184     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
  4185 qed    
  4186 
  4187 lemma sincos_total_pi:
  4188   assumes "0 \<le> y" and "x\<^sup>2 + y\<^sup>2 = 1"
  4189     shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
  4190 proof (cases rule: le_cases [of 0 x])
  4191   case le from sincos_total_pi_half [OF le]  
  4192   show ?thesis
  4193     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
  4194 next
  4195   case ge 
  4196   then have "0 \<le> -x"
  4197     by simp
  4198   then obtain t where "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
  4199     using sincos_total_pi_half assms
  4200     apply auto
  4201     by (metis `0 \<le> - x` power2_minus)
  4202   then show ?thesis
  4203     by (rule_tac x="pi-t" in exI, auto)
  4204 qed    
  4205     
  4206 lemma sincos_total_2pi_le:
  4207   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  4208     shows "\<exists>t. 0 \<le> t \<and> t \<le> 2*pi \<and> x = cos t \<and> y = sin t"
  4209 proof (cases rule: le_cases [of 0 y])
  4210   case le from sincos_total_pi [OF le]  
  4211   show ?thesis
  4212     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
  4213 next
  4214   case ge 
  4215   then have "0 \<le> -y"
  4216     by simp
  4217   then obtain t where "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
  4218     using sincos_total_pi assms
  4219     apply auto
  4220     by (metis `0 \<le> - y` power2_minus)
  4221   then show ?thesis
  4222     by (rule_tac x="2*pi-t" in exI, auto)
  4223 qed    
  4224 
  4225 lemma sincos_total_2pi:
  4226   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  4227     obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
  4228 proof -
  4229   from sincos_total_2pi_le [OF assms]
  4230   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
  4231     by blast
  4232   show ?thesis
  4233     apply (cases "t = 2*pi")
  4234     using t that
  4235     apply force+
  4236     done
  4237 qed
  4238 
  4239 subsection {* Machins formula *}
  4240 
  4241 lemma arctan_one: "arctan 1 = pi / 4"
  4242   by (rule arctan_unique, simp_all add: tan_45 m2pi_less_pi)
  4243 
  4244 lemma tan_total_pi4:
  4245   assumes "\<bar>x\<bar> < 1"
  4246   shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
  4247 proof
  4248   show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
  4249     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  4250     unfolding arctan_less_iff using assms by auto
  4251 qed
  4252 
  4253 lemma arctan_add:
  4254   assumes "\<bar>x\<bar> \<le> 1" and "\<bar>y\<bar> < 1"
  4255   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
  4256 proof (rule arctan_unique [symmetric])
  4257   have "- (pi / 4) \<le> arctan x" and "- (pi / 4) < arctan y"
  4258     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  4259     unfolding arctan_le_iff arctan_less_iff using assms by auto
  4260   from add_le_less_mono [OF this]
  4261   show 1: "- (pi / 2) < arctan x + arctan y" by simp
  4262   have "arctan x \<le> pi / 4" and "arctan y < pi / 4"
  4263     unfolding arctan_one [symmetric]
  4264     unfolding arctan_le_iff arctan_less_iff using assms by auto
  4265   from add_le_less_mono [OF this]
  4266   show 2: "arctan x + arctan y < pi / 2" by simp
  4267   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
  4268     using cos_gt_zero_pi [OF 1 2] by (simp add: tan_add)
  4269 qed
  4270 
  4271 theorem machin: "pi / 4 = 4 * arctan (1/5) - arctan (1 / 239)"
  4272 proof -
  4273   have "\<bar>1 / 5\<bar> < (1 :: real)" by auto
  4274   from arctan_add[OF less_imp_le[OF this] this]
  4275   have "2 * arctan (1 / 5) = arctan (5 / 12)" by auto
  4276   moreover
  4277   have "\<bar>5 / 12\<bar> < (1 :: real)" by auto
  4278   from arctan_add[OF less_imp_le[OF this] this]
  4279   have "2 * arctan (5 / 12) = arctan (120 / 119)" by auto
  4280   moreover
  4281   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)" by auto
  4282   from arctan_add[OF this]
  4283   have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)" by auto
  4284   ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)" by auto
  4285   thus ?thesis unfolding arctan_one by algebra
  4286 qed
  4287 
  4288 
  4289 subsection {* Introducing the inverse tangent power series *}
  4290 
  4291 lemma monoseq_arctan_series:
  4292   fixes x :: real
  4293   assumes "\<bar>x\<bar> \<le> 1"
  4294   shows "monoseq (\<lambda> n. 1 / real (n*2+1) * x^(n*2+1))" (is "monoseq ?a")
  4295 proof (cases "x = 0")
  4296   case True
  4297   thus ?thesis unfolding monoseq_def One_nat_def by auto
  4298 next
  4299   case False
  4300   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  4301   show "monoseq ?a"
  4302   proof -
  4303     {
  4304       fix n
  4305       fix x :: real
  4306       assume "0 \<le> x" and "x \<le> 1"
  4307       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
  4308         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
  4309       proof (rule mult_mono)
  4310         show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
  4311           by (rule frac_le) simp_all
  4312         show "0 \<le> 1 / real (Suc (n * 2))"
  4313           by auto
  4314         show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
  4315           by (rule power_decreasing) (simp_all add: `0 \<le> x` `x \<le> 1`)
  4316         show "0 \<le> x ^ Suc (Suc n * 2)"
  4317           by (rule zero_le_power) (simp add: `0 \<le> x`)
  4318       qed
  4319     } note mono = this
  4320 
  4321     show ?thesis
  4322     proof (cases "0 \<le> x")
  4323       case True from mono[OF this `x \<le> 1`, THEN allI]
  4324       show ?thesis unfolding Suc_eq_plus1[symmetric]
  4325         by (rule mono_SucI2)
  4326     next
  4327       case False
  4328       hence "0 \<le> -x" and "-x \<le> 1" using `-1 \<le> x` by auto
  4329       from mono[OF this]
  4330       have "\<And>n. 1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
  4331         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" using `0 \<le> -x` by auto
  4332       thus ?thesis unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
  4333     qed
  4334   qed
  4335 qed
  4336 
  4337 lemma zeroseq_arctan_series:
  4338   fixes x :: real
  4339   assumes "\<bar>x\<bar> \<le> 1"
  4340   shows "(\<lambda> n. 1 / real (n*2+1) * x^(n*2+1)) ----> 0" (is "?a ----> 0")
  4341 proof (cases "x = 0")
  4342   case True
  4343   thus ?thesis
  4344     unfolding One_nat_def by auto
  4345 next
  4346   case False
  4347   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  4348   show "?a ----> 0"
  4349   proof (cases "\<bar>x\<bar> < 1")
  4350     case True
  4351     hence "norm x < 1" by auto
  4352     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF `norm x < 1`, THEN LIMSEQ_Suc]]
  4353     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) ----> 0"
  4354       unfolding inverse_eq_divide Suc_eq_plus1 by simp
  4355     then show ?thesis using pos2 by (rule LIMSEQ_linear)
  4356   next
  4357     case False
  4358     hence "x = -1 \<or> x = 1" using `\<bar>x\<bar> \<le> 1` by auto
  4359     hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
  4360       unfolding One_nat_def by auto
  4361     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
  4362     show ?thesis unfolding n_eq Suc_eq_plus1 by auto
  4363   qed
  4364 qed
  4365 
  4366 text{*FIXME: generalise from the reals via type classes?*}
  4367 lemma summable_arctan_series:
  4368   fixes x :: real and n :: nat
  4369   assumes "\<bar>x\<bar> \<le> 1"
  4370   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  4371   (is "summable (?c x)")
  4372   by (rule summable_Leibniz(1), rule zeroseq_arctan_series[OF assms], rule monoseq_arctan_series[OF assms])
  4373 
  4374 lemma less_one_imp_sqr_less_one:
  4375   fixes x :: real
  4376   assumes "\<bar>x\<bar> < 1"
  4377   shows "x\<^sup>2 < 1"
  4378 proof -
  4379   have "\<bar>x\<^sup>2\<bar> < 1"
  4380     by (metis abs_power2 assms pos2 power2_abs power_0 power_strict_decreasing zero_eq_power2 zero_less_abs_iff)
  4381   thus ?thesis using zero_le_power2 by auto
  4382 qed
  4383 
  4384 lemma DERIV_arctan_series:
  4385   assumes "\<bar> x \<bar> < 1"
  4386   shows "DERIV (\<lambda> x'. \<Sum> k. (-1)^k * (1 / real (k*2+1) * x' ^ (k*2+1))) x :> (\<Sum> k. (-1)^k * x^(k*2))"
  4387   (is "DERIV ?arctan _ :> ?Int")
  4388 proof -
  4389   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
  4390 
  4391   have n_even: "\<And>n :: nat. even n \<Longrightarrow> 2 * (n div 2) = n"
  4392     by presburger
  4393   then have if_eq: "\<And>n x'. ?f n * real (Suc n) * x'^n =
  4394     (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
  4395     by auto
  4396 
  4397   {
  4398     fix x :: real
  4399     assume "\<bar>x\<bar> < 1"
  4400     hence "x\<^sup>2 < 1" by (rule less_one_imp_sqr_less_one)
  4401     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
  4402       by (rule summable_Leibniz(1), auto intro!: LIMSEQ_realpow_zero monoseq_realpow `x\<^sup>2 < 1` order_less_imp_le[OF `x\<^sup>2 < 1`])
  4403     hence "summable (\<lambda> n. (- 1) ^ n * x^(2*n))" unfolding power_mult .
  4404   } note summable_Integral = this
  4405 
  4406   {
  4407     fix f :: "nat \<Rightarrow> real"
  4408     have "\<And>x. f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x"
  4409     proof
  4410       fix x :: real
  4411       assume "f sums x"
  4412       from sums_if[OF sums_zero this]
  4413       show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
  4414         by auto
  4415     next
  4416       fix x :: real
  4417       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
  4418       from LIMSEQ_linear[OF this[unfolded sums_def] pos2, unfolded sum_split_even_odd[unfolded mult.commute]]
  4419       show "f sums x" unfolding sums_def by auto
  4420     qed
  4421     hence "op sums f = op sums (\<lambda> n. if even n then f (n div 2) else 0)" ..
  4422   } note sums_even = this
  4423 
  4424   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
  4425     unfolding if_eq mult.commute[of _ 2] suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
  4426     by auto
  4427 
  4428   {
  4429     fix x :: real
  4430     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
  4431       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
  4432       using n_even by auto
  4433     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)" by auto
  4434     have "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x"
  4435       unfolding if_eq' idx_eq suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
  4436       by auto
  4437   } note arctan_eq = this
  4438 
  4439   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum> n. ?f n * real (Suc n) * x^n)"
  4440   proof (rule DERIV_power_series')
  4441     show "x \<in> {- 1 <..< 1}" using `\<bar> x \<bar> < 1` by auto
  4442     {
  4443       fix x' :: real
  4444       assume x'_bounds: "x' \<in> {- 1 <..< 1}"
  4445       then have "\<bar>x'\<bar> < 1" by auto
  4446       then
  4447         have *: "summable (\<lambda>n. (- 1) ^ n * x' ^ (2 * n))"
  4448         by (rule summable_Integral)
  4449       let ?S = "\<Sum> n. (-1)^n * x'^(2 * n)"
  4450       show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)" unfolding if_eq
  4451         apply (rule sums_summable [where l="0 + ?S"])
  4452         apply (rule sums_if)
  4453         apply (rule sums_zero)
  4454         apply (rule summable_sums)
  4455         apply (rule *)
  4456         done
  4457     }
  4458   qed auto
  4459   thus ?thesis unfolding Int_eq arctan_eq .
  4460 qed
  4461 
  4462 lemma arctan_series:
  4463   assumes "\<bar> x \<bar> \<le> 1"
  4464   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  4465   (is "_ = suminf (\<lambda> n. ?c x n)")
  4466 proof -
  4467   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
  4468 
  4469   {
  4470     fix r x :: real
  4471     assume "0 < r" and "r < 1" and "\<bar> x \<bar> < r"
  4472     have "\<bar>x\<bar> < 1" using `r < 1` and `\<bar>x\<bar> < r` by auto
  4473     from DERIV_arctan_series[OF this] have "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))" .
  4474   } note DERIV_arctan_suminf = this
  4475 
  4476   {
  4477     fix x :: real
  4478     assume "\<bar>x\<bar> \<le> 1"
  4479     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
  4480   } note arctan_series_borders = this
  4481 
  4482   {
  4483     fix x :: real
  4484     assume "\<bar>x\<bar> < 1"
  4485     have "arctan x = (\<Sum>k. ?c x k)"
  4486     proof -
  4487       obtain r where "\<bar>x\<bar> < r" and "r < 1"
  4488         using dense[OF `\<bar>x\<bar> < 1`] by blast
  4489       hence "0 < r" and "-r < x" and "x < r" by auto
  4490 
  4491       have suminf_eq_arctan_bounded: "\<And>x a b. \<lbrakk> -r < a ; b < r ; a < b ; a \<le> x ; x \<le> b \<rbrakk> \<Longrightarrow>
  4492         suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  4493       proof -
  4494         fix x a b
  4495         assume "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b"
  4496         hence "\<bar>x\<bar> < r" by auto
  4497         show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  4498         proof (rule DERIV_isconst2[of "a" "b"])
  4499           show "a < b" and "a \<le> x" and "x \<le> b"
  4500             using `a < b` `a \<le> x` `x \<le> b` by auto
  4501           have "\<forall>x. -r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  4502           proof (rule allI, rule impI)
  4503             fix x
  4504             assume "-r < x \<and> x < r"
  4505             hence "\<bar>x\<bar> < r" by auto
  4506             hence "\<bar>x\<bar> < 1" using `r < 1` by auto
  4507             have "\<bar> - (x\<^sup>2) \<bar> < 1"
  4508               using less_one_imp_sqr_less_one[OF `\<bar>x\<bar> < 1`] by auto
  4509             hence "(\<lambda> n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
  4510               unfolding real_norm_def[symmetric] by (rule geometric_sums)
  4511             hence "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
  4512               unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
  4513             hence suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
  4514               using sums_unique unfolding inverse_eq_divide by auto
  4515             have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
  4516               unfolding suminf_c'_eq_geom
  4517               by (rule DERIV_arctan_suminf[OF `0 < r` `r < 1` `\<bar>x\<bar> < r`])
  4518             from DERIV_diff [OF this DERIV_arctan]
  4519             show "DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  4520               by auto
  4521           qed
  4522           hence DERIV_in_rball: "\<forall> y. a \<le> y \<and> y \<le> b \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) y :> 0"
  4523             using `-r < a` `b < r` by auto
  4524           thus "\<forall> y. a < y \<and> y < b \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) y :> 0"
  4525             using `\<bar>x\<bar> < r` by auto
  4526           show "\<forall> y. a \<le> y \<and> y \<le> b \<longrightarrow> isCont (\<lambda> x. suminf (?c x) - arctan x) y"
  4527             using DERIV_in_rball DERIV_isCont by auto
  4528         qed
  4529       qed
  4530 
  4531       have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
  4532         unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
  4533         by auto
  4534 
  4535       have "suminf (?c x) - arctan x = 0"
  4536       proof (cases "x = 0")
  4537         case True
  4538         thus ?thesis using suminf_arctan_zero by auto
  4539       next
  4540         case False
  4541         hence "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>" by auto
  4542         have "suminf (?c (-\<bar>x\<bar>)) - arctan (-\<bar>x\<bar>) = suminf (?c 0) - arctan 0"
  4543           by (rule suminf_eq_arctan_bounded[where x1="0" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
  4544             (simp_all only: `\<bar>x\<bar> < r` `-\<bar>x\<bar> < \<bar>x\<bar>` neg_less_iff_less)
  4545         moreover
  4546         have "suminf (?c x) - arctan x = suminf (?c (-\<bar>x\<bar>)) - arctan (-\<bar>x\<bar>)"
  4547           by (rule suminf_eq_arctan_bounded[where x1="x" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>"])
  4548              (simp_all only: `\<bar>x\<bar> < r` `-\<bar>x\<bar> < \<bar>x\<bar>` neg_less_iff_less)
  4549         ultimately
  4550         show ?thesis using suminf_arctan_zero by auto
  4551       qed
  4552       thus ?thesis by auto
  4553     qed
  4554   } note when_less_one = this
  4555 
  4556   show "arctan x = suminf (\<lambda> n. ?c x n)"
  4557   proof (cases "\<bar>x\<bar> < 1")
  4558     case True
  4559     thus ?thesis by (rule when_less_one)
  4560   next
  4561     case False
  4562     hence "\<bar>x\<bar> = 1" using `\<bar>x\<bar> \<le> 1` by auto
  4563     let ?a = "\<lambda>x n. \<bar>1 / real (n*2+1) * x^(n*2+1)\<bar>"
  4564     let ?diff = "\<lambda> x n. \<bar> arctan x - (\<Sum> i<n. ?c x i)\<bar>"
  4565     {
  4566       fix n :: nat
  4567       have "0 < (1 :: real)" by auto
  4568       moreover
  4569       {
  4570         fix x :: real
  4571         assume "0 < x" and "x < 1"
  4572         hence "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1" by auto
  4573         from `0 < x` have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
  4574           by auto
  4575         note bounds = mp[OF arctan_series_borders(2)[OF `\<bar>x\<bar> \<le> 1`] this, unfolded when_less_one[OF `\<bar>x\<bar> < 1`, symmetric], THEN spec]
  4576         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
  4577           by (rule mult_pos_pos, auto simp only: zero_less_power[OF `0 < x`], auto)
  4578         hence a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
  4579           by (rule abs_of_pos)
  4580         have "?diff x n \<le> ?a x n"
  4581         proof (cases "even n")
  4582           case True
  4583           hence sgn_pos: "(-1)^n = (1::real)" by auto
  4584           from `even n` obtain m where "n = 2 * m" ..
  4585           then have "2 * m = n" ..
  4586           from bounds[of m, unfolded this atLeastAtMost_iff]
  4587           have "\<bar>arctan x - (\<Sum>i<n. (?c x i))\<bar> \<le> (\<Sum>i<n + 1. (?c x i)) - (\<Sum>i<n. (?c x i))"
  4588             by auto
  4589           also have "\<dots> = ?c x n" unfolding One_nat_def by auto
  4590           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
  4591           finally show ?thesis .
  4592         next
  4593           case False
  4594           hence sgn_neg: "(-1)^n = (-1::real)" by auto
  4595           from `odd n` obtain m where "n = 2 * m + 1" ..
  4596           then have m_def: "2 * m + 1 = n" ..
  4597           hence m_plus: "2 * (m + 1) = n + 1" by auto
  4598           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
  4599           have "\<bar>arctan x - (\<Sum>i<n. (?c x i))\<bar> \<le> (\<Sum>i<n. (?c x i)) - (\<Sum>i<n+1. (?c x i))"
  4600             by auto
  4601           also have "\<dots> = - ?c x n" unfolding One_nat_def by auto
  4602           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
  4603           finally show ?thesis .
  4604         qed
  4605         hence "0 \<le> ?a x n - ?diff x n" by auto
  4606       }
  4607       hence "\<forall> x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
  4608       moreover have "\<And>x. isCont (\<lambda> x. ?a x n - ?diff x n) x"
  4609         unfolding diff_conv_add_uminus divide_inverse
  4610         by (auto intro!: isCont_add isCont_rabs isCont_ident isCont_minus isCont_arctan
  4611           isCont_inverse isCont_mult isCont_power isCont_const isCont_setsum
  4612           simp del: add_uminus_conv_diff)
  4613       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
  4614         by (rule LIM_less_bound)
  4615       hence "?diff 1 n \<le> ?a 1 n" by auto
  4616     }
  4617     have "?a 1 ----> 0"
  4618       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
  4619       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
  4620     have "?diff 1 ----> 0"
  4621     proof (rule LIMSEQ_I)
  4622       fix r :: real
  4623       assume "0 < r"
  4624       obtain N :: nat where N_I: "\<And>n. N \<le> n \<Longrightarrow> ?a 1 n < r"
  4625         using LIMSEQ_D[OF `?a 1 ----> 0` `0 < r`] by auto
  4626       {
  4627         fix n
  4628         assume "N \<le> n" from `?diff 1 n \<le> ?a 1 n` N_I[OF this]
  4629         have "norm (?diff 1 n - 0) < r" by auto
  4630       }
  4631       thus "\<exists> N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
  4632     qed
  4633     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
  4634     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
  4635     hence "arctan 1 = (\<Sum> i. ?c 1 i)" by (rule sums_unique)
  4636 
  4637     show ?thesis
  4638     proof (cases "x = 1")
  4639       case True
  4640       then show ?thesis by (simp add: `arctan 1 = (\<Sum> i. ?c 1 i)`)
  4641     next
  4642       case False
  4643       hence "x = -1" using `\<bar>x\<bar> = 1` by auto
  4644 
  4645       have "- (pi / 2) < 0" using pi_gt_zero by auto
  4646       have "- (2 * pi) < 0" using pi_gt_zero by auto
  4647 
  4648       have c_minus_minus: "\<And>i. ?c (- 1) i = - ?c 1 i"
  4649         unfolding One_nat_def by auto
  4650 
  4651       have "arctan (- 1) = arctan (tan (-(pi / 4)))"
  4652         unfolding tan_45 tan_minus ..
  4653       also have "\<dots> = - (pi / 4)"
  4654         by (rule arctan_tan, auto simp add: order_less_trans[OF `- (pi / 2) < 0` pi_gt_zero])
  4655       also have "\<dots> = - (arctan (tan (pi / 4)))"
  4656         unfolding neg_equal_iff_equal by (rule arctan_tan[symmetric], auto simp add: order_less_trans[OF `- (2 * pi) < 0` pi_gt_zero])
  4657       also have "\<dots> = - (arctan 1)"
  4658         unfolding tan_45 ..
  4659       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
  4660         using `arctan 1 = (\<Sum> i. ?c 1 i)` by auto
  4661       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
  4662         using suminf_minus[OF sums_summable[OF `(?c 1) sums (arctan 1)`]]
  4663         unfolding c_minus_minus by auto
  4664       finally show ?thesis using `x = -1` by auto
  4665     qed
  4666   qed
  4667 qed
  4668 
  4669 lemma arctan_half:
  4670   fixes x :: real
  4671   shows "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
  4672 proof -
  4673   obtain y where low: "- (pi / 2) < y" and high: "y < pi / 2" and y_eq: "tan y = x"
  4674     using tan_total by blast
  4675   hence low2: "- (pi / 2) < y / 2" and high2: "y / 2 < pi / 2"
  4676     by auto
  4677 
  4678   have "0 < cos y" using cos_gt_zero_pi[OF low high] .
  4679   hence "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
  4680     by auto
  4681 
  4682   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  4683     unfolding tan_def power_divide ..
  4684   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  4685     using `cos y \<noteq> 0` by auto
  4686   also have "\<dots> = 1 / (cos y)\<^sup>2"
  4687     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
  4688   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
  4689 
  4690   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
  4691     unfolding tan_def using `cos y \<noteq> 0` by (simp add: field_simps)
  4692   also have "\<dots> = tan y / (1 + 1 / cos y)"
  4693     using `cos y \<noteq> 0` unfolding add_divide_distrib by auto
  4694   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
  4695     unfolding cos_sqrt ..
  4696   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
  4697     unfolding real_sqrt_divide by auto
  4698   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
  4699     unfolding `1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2` .
  4700 
  4701   have "arctan x = y"
  4702     using arctan_tan low high y_eq by auto
  4703   also have "\<dots> = 2 * (arctan (tan (y/2)))"
  4704     using arctan_tan[OF low2 high2] by auto
  4705   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
  4706     unfolding tan_half by auto
  4707   finally show ?thesis
  4708     unfolding eq `tan y = x` .
  4709 qed
  4710 
  4711 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
  4712   by (simp only: arctan_less_iff)
  4713 
  4714 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
  4715   by (simp only: arctan_le_iff)
  4716 
  4717 lemma arctan_inverse:
  4718   assumes "x \<noteq> 0"
  4719   shows "arctan (1 / x) = sgn x * pi / 2 - arctan x"
  4720 proof (rule arctan_unique)
  4721   show "- (pi / 2) < sgn x * pi / 2 - arctan x"
  4722     using arctan_bounded [of x] assms
  4723     unfolding sgn_real_def
  4724     apply (auto simp add: algebra_simps)
  4725     apply (drule zero_less_arctan_iff [THEN iffD2])
  4726     apply arith
  4727     done
  4728   show "sgn x * pi / 2 - arctan x < pi / 2"
  4729     using arctan_bounded [of "- x"] assms
  4730     unfolding sgn_real_def arctan_minus
  4731     by (auto simp add: algebra_simps)
  4732   show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
  4733     unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
  4734     unfolding sgn_real_def
  4735     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
  4736 qed
  4737 
  4738 theorem pi_series: "pi / 4 = (\<Sum> k. (-1)^k * 1 / real (k*2+1))" (is "_ = ?SUM")
  4739 proof -
  4740   have "pi / 4 = arctan 1" using arctan_one by auto
  4741   also have "\<dots> = ?SUM" using arctan_series[of 1] by auto
  4742   finally show ?thesis by auto
  4743 qed
  4744 
  4745 
  4746 subsection {* Existence of Polar Coordinates *}
  4747 
  4748 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
  4749   apply (rule power2_le_imp_le [OF _ zero_le_one])
  4750   apply (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
  4751   done
  4752 
  4753 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  4754   by (simp add: abs_le_iff)
  4755 
  4756 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
  4757   by (simp add: sin_arccos abs_le_iff)
  4758 
  4759 lemmas cos_arccos_lemma1 = cos_arccos_abs [OF cos_x_y_le_one]
  4760 
  4761 lemmas sin_arccos_lemma1 = sin_arccos_abs [OF cos_x_y_le_one]
  4762 
  4763 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a & y = r * sin a"
  4764 proof -
  4765   have polar_ex1: "\<And>y. 0 < y \<Longrightarrow> \<exists>r a. x = r * cos a & y = r * sin a"
  4766     apply (rule_tac x = "sqrt (x\<^sup>2 + y\<^sup>2)" in exI)
  4767     apply (rule_tac x = "arccos (x / sqrt (x\<^sup>2 + y\<^sup>2))" in exI)
  4768     apply (simp add: cos_arccos_lemma1 sin_arccos_lemma1 power_divide
  4769                      real_sqrt_mult [symmetric] right_diff_distrib)
  4770     done
  4771   show ?thesis
  4772   proof (cases "0::real" y rule: linorder_cases)
  4773     case less
  4774       then show ?thesis by (rule polar_ex1)
  4775   next
  4776     case equal
  4777       then show ?thesis
  4778         by (force simp add: intro!: cos_zero sin_zero)
  4779   next
  4780     case greater
  4781       then show ?thesis
  4782      using polar_ex1 [where y="-y"]
  4783     by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
  4784   qed
  4785 qed
  4786 
  4787 end