src/HOL/Transcendental.thy
author paulson <lp15@cam.ac.uk>
Tue Apr 25 16:39:54 2017 +0100 (2017-04-25)
changeset 65578 e4997c181cce
parent 65552 f533820e7248
child 65583 8d53b3bebab4
permissions -rw-r--r--
New material from PNT proof, as well as more default [simp] declarations. Also removed duplicate theorems about geometric series
     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 \<open>Power Series, Transcendental Functions etc.\<close>
     8 
     9 theory Transcendental
    10 imports Series Deriv NthRoot
    11 begin
    12 
    13 text \<open>A fact theorem on reals.\<close>
    14 
    15 lemma square_fact_le_2_fact: "fact n * fact n \<le> (fact (2 * n) :: real)"
    16 proof (induct n)
    17   case 0
    18   then show ?case by simp
    19 next
    20   case (Suc n)
    21   have "(fact (Suc n)) * (fact (Suc n)) = of_nat (Suc n) * of_nat (Suc n) * (fact n * fact n :: real)"
    22     by (simp add: field_simps)
    23   also have "\<dots> \<le> of_nat (Suc n) * of_nat (Suc n) * fact (2 * n)"
    24     by (rule mult_left_mono [OF Suc]) simp
    25   also have "\<dots> \<le> of_nat (Suc (Suc (2 * n))) * of_nat (Suc (2 * n)) * fact (2 * n)"
    26     by (rule mult_right_mono)+ (auto simp: field_simps)
    27   also have "\<dots> = fact (2 * Suc n)" by (simp add: field_simps)
    28   finally show ?case .
    29 qed
    30 
    31 lemma fact_in_Reals: "fact n \<in> \<real>"
    32   by (induction n) auto
    33 
    34 lemma of_real_fact [simp]: "of_real (fact n) = fact n"
    35   by (metis of_nat_fact of_real_of_nat_eq)
    36 
    37 lemma pochhammer_of_real: "pochhammer (of_real x) n = of_real (pochhammer x n)"
    38   by (simp add: pochhammer_prod)
    39 
    40 lemma norm_fact [simp]: "norm (fact n :: 'a::real_normed_algebra_1) = fact n"
    41 proof -
    42   have "(fact n :: 'a) = of_real (fact n)"
    43     by simp
    44   also have "norm \<dots> = fact n"
    45     by (subst norm_of_real) simp
    46   finally show ?thesis .
    47 qed
    48 
    49 lemma root_test_convergence:
    50   fixes f :: "nat \<Rightarrow> 'a::banach"
    51   assumes f: "(\<lambda>n. root n (norm (f n))) \<longlonglongrightarrow> x" \<comment> "could be weakened to lim sup"
    52     and "x < 1"
    53   shows "summable f"
    54 proof -
    55   have "0 \<le> x"
    56     by (rule LIMSEQ_le[OF tendsto_const f]) (auto intro!: exI[of _ 1])
    57   from \<open>x < 1\<close> obtain z where z: "x < z" "z < 1"
    58     by (metis dense)
    59   from f \<open>x < z\<close> have "eventually (\<lambda>n. root n (norm (f n)) < z) sequentially"
    60     by (rule order_tendstoD)
    61   then have "eventually (\<lambda>n. norm (f n) \<le> z^n) sequentially"
    62     using eventually_ge_at_top
    63   proof eventually_elim
    64     fix n
    65     assume less: "root n (norm (f n)) < z" and n: "1 \<le> n"
    66     from power_strict_mono[OF less, of n] n show "norm (f n) \<le> z ^ n"
    67       by simp
    68   qed
    69   then show "summable f"
    70     unfolding eventually_sequentially
    71     using z \<open>0 \<le> x\<close> by (auto intro!: summable_comparison_test[OF _  summable_geometric])
    72 qed
    73 
    74 subsection \<open>More facts about binomial coefficients\<close>
    75 
    76 text \<open>
    77   These facts could have been proven before, but having real numbers
    78   makes the proofs a lot easier.
    79 \<close>
    80 
    81 lemma central_binomial_odd:
    82   "odd n \<Longrightarrow> n choose (Suc (n div 2)) = n choose (n div 2)"
    83 proof -
    84   assume "odd n"
    85   hence "Suc (n div 2) \<le> n" by presburger
    86   hence "n choose (Suc (n div 2)) = n choose (n - Suc (n div 2))"
    87     by (rule binomial_symmetric)
    88   also from \<open>odd n\<close> have "n - Suc (n div 2) = n div 2" by presburger
    89   finally show ?thesis .
    90 qed
    91 
    92 lemma binomial_less_binomial_Suc:
    93   assumes k: "k < n div 2"
    94   shows   "n choose k < n choose (Suc k)"
    95 proof -
    96   from k have k': "k \<le> n" "Suc k \<le> n" by simp_all
    97   from k' have "real (n choose k) = fact n / (fact k * fact (n - k))"
    98     by (simp add: binomial_fact)
    99   also from k' have "n - k = Suc (n - Suc k)" by simp
   100   also from k' have "fact \<dots> = (real n - real k) * fact (n - Suc k)"
   101     by (subst fact_Suc) (simp_all add: of_nat_diff)
   102   also from k have "fact k = fact (Suc k) / (real k + 1)" by (simp add: field_simps)
   103   also have "fact n / (fact (Suc k) / (real k + 1) * ((real n - real k) * fact (n - Suc k))) =
   104                (n choose (Suc k)) * ((real k + 1) / (real n - real k))"
   105     using k by (simp add: divide_simps binomial_fact)
   106   also from assms have "(real k + 1) / (real n - real k) < 1" by simp
   107   finally show ?thesis using k by (simp add: mult_less_cancel_left)
   108 qed
   109 
   110 lemma binomial_strict_mono:
   111   assumes "k < k'" "2*k' \<le> n"
   112   shows   "n choose k < n choose k'"
   113 proof -
   114   from assms have "k \<le> k' - 1" by simp
   115   thus ?thesis
   116   proof (induction rule: inc_induct)
   117     case base
   118     with assms binomial_less_binomial_Suc[of "k' - 1" n]
   119       show ?case by simp
   120   next
   121     case (step k)
   122     from step.prems step.hyps assms have "n choose k < n choose (Suc k)"
   123       by (intro binomial_less_binomial_Suc) simp_all
   124     also have "\<dots> < n choose k'" by (rule step.IH)
   125     finally show ?case .
   126   qed
   127 qed
   128 
   129 lemma binomial_mono:
   130   assumes "k \<le> k'" "2*k' \<le> n"
   131   shows   "n choose k \<le> n choose k'"
   132   using assms binomial_strict_mono[of k k' n] by (cases "k = k'") simp_all
   133 
   134 lemma binomial_strict_antimono:
   135   assumes "k < k'" "2 * k \<ge> n" "k' \<le> n"
   136   shows   "n choose k > n choose k'"
   137 proof -
   138   from assms have "n choose (n - k) > n choose (n - k')"
   139     by (intro binomial_strict_mono) (simp_all add: algebra_simps)
   140   with assms show ?thesis by (simp add: binomial_symmetric [symmetric])
   141 qed
   142 
   143 lemma binomial_antimono:
   144   assumes "k \<le> k'" "k \<ge> n div 2" "k' \<le> n"
   145   shows   "n choose k \<ge> n choose k'"
   146 proof (cases "k = k'")
   147   case False
   148   note not_eq = False
   149   show ?thesis
   150   proof (cases "k = n div 2 \<and> odd n")
   151     case False
   152     with assms(2) have "2*k \<ge> n" by presburger
   153     with not_eq assms binomial_strict_antimono[of k k' n]
   154       show ?thesis by simp
   155   next
   156     case True
   157     have "n choose k' \<le> n choose (Suc (n div 2))"
   158     proof (cases "k' = Suc (n div 2)")
   159       case False
   160       with assms True not_eq have "Suc (n div 2) < k'" by simp
   161       with assms binomial_strict_antimono[of "Suc (n div 2)" k' n] True
   162         show ?thesis by auto
   163     qed simp_all
   164     also from True have "\<dots> = n choose k" by (simp add: central_binomial_odd)
   165     finally show ?thesis .
   166   qed
   167 qed simp_all
   168 
   169 lemma binomial_maximum: "n choose k \<le> n choose (n div 2)"
   170 proof -
   171   have "k \<le> n div 2 \<longleftrightarrow> 2*k \<le> n" by linarith
   172   consider "2*k \<le> n" | "2*k \<ge> n" "k \<le> n" | "k > n" by linarith
   173   thus ?thesis
   174   proof cases
   175     case 1
   176     thus ?thesis by (intro binomial_mono) linarith+
   177   next
   178     case 2
   179     thus ?thesis by (intro binomial_antimono) simp_all
   180   qed (simp_all add: binomial_eq_0)
   181 qed
   182 
   183 lemma binomial_maximum': "(2*n) choose k \<le> (2*n) choose n"
   184   using binomial_maximum[of "2*n"] by simp
   185 
   186 lemma central_binomial_lower_bound:
   187   assumes "n > 0"
   188   shows   "4^n / (2*real n) \<le> real ((2*n) choose n)"
   189 proof -
   190   from binomial[of 1 1 "2*n"]
   191     have "4 ^ n = (\<Sum>k=0..2*n. (2*n) choose k)"
   192     by (simp add: power_mult power2_eq_square One_nat_def [symmetric] del: One_nat_def)
   193   also have "{0..2*n} = {0<..<2*n} \<union> {0,2*n}" by auto
   194   also have "(\<Sum>k\<in>\<dots>. (2*n) choose k) =
   195                (\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) + (\<Sum>k\<in>{0,2*n}. (2*n) choose k)"
   196     by (subst sum.union_disjoint) auto
   197   also have "(\<Sum>k\<in>{0,2*n}. (2*n) choose k) \<le> (\<Sum>k\<le>1. (n choose k)\<^sup>2)"
   198     by (cases n) simp_all
   199   also from assms have "\<dots> \<le> (\<Sum>k\<le>n. (n choose k)\<^sup>2)"
   200     by (intro sum_mono3) auto
   201   also have "\<dots> = (2*n) choose n" by (rule choose_square_sum)
   202   also have "(\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) \<le> (\<Sum>k\<in>{0<..<2*n}. (2*n) choose n)"
   203     by (intro sum_mono binomial_maximum')
   204   also have "\<dots> = card {0<..<2*n} * ((2*n) choose n)" by simp
   205   also have "card {0<..<2*n} \<le> 2*n - 1" by (cases n) simp_all
   206   also have "(2 * n - 1) * (2 * n choose n) + (2 * n choose n) = ((2*n) choose n) * (2*n)"
   207     using assms by (simp add: algebra_simps)
   208   finally have "4 ^ n \<le> (2 * n choose n) * (2 * n)" by simp_all
   209   hence "real (4 ^ n) \<le> real ((2 * n choose n) * (2 * n))"
   210     by (subst of_nat_le_iff)
   211   with assms show ?thesis by (simp add: field_simps)
   212 qed
   213 
   214 
   215 subsection \<open>Properties of Power Series\<close>
   216 
   217 lemma powser_zero [simp]: "(\<Sum>n. f n * 0 ^ n) = f 0"
   218   for f :: "nat \<Rightarrow> 'a::real_normed_algebra_1"
   219 proof -
   220   have "(\<Sum>n<1. f n * 0 ^ n) = (\<Sum>n. f n * 0 ^ n)"
   221     by (subst suminf_finite[where N="{0}"]) (auto simp: power_0_left)
   222   then show ?thesis by simp
   223 qed
   224 
   225 lemma powser_sums_zero: "(\<lambda>n. a n * 0^n) sums a 0"
   226   for a :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   227   using sums_finite [of "{0}" "\<lambda>n. a n * 0 ^ n"]
   228   by simp
   229 
   230 lemma powser_sums_zero_iff [simp]: "(\<lambda>n. a n * 0^n) sums x \<longleftrightarrow> a 0 = x"
   231   for a :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   232   using powser_sums_zero sums_unique2 by blast
   233 
   234 text \<open>
   235   Power series has a circle or radius of convergence: if it sums for \<open>x\<close>,
   236   then it sums absolutely for \<open>z\<close> with @{term "\<bar>z\<bar> < \<bar>x\<bar>"}.\<close>
   237 
   238 lemma powser_insidea:
   239   fixes x z :: "'a::real_normed_div_algebra"
   240   assumes 1: "summable (\<lambda>n. f n * x^n)"
   241     and 2: "norm z < norm x"
   242   shows "summable (\<lambda>n. norm (f n * z ^ n))"
   243 proof -
   244   from 2 have x_neq_0: "x \<noteq> 0" by clarsimp
   245   from 1 have "(\<lambda>n. f n * x^n) \<longlonglongrightarrow> 0"
   246     by (rule summable_LIMSEQ_zero)
   247   then have "convergent (\<lambda>n. f n * x^n)"
   248     by (rule convergentI)
   249   then have "Cauchy (\<lambda>n. f n * x^n)"
   250     by (rule convergent_Cauchy)
   251   then have "Bseq (\<lambda>n. f n * x^n)"
   252     by (rule Cauchy_Bseq)
   253   then obtain K where 3: "0 < K" and 4: "\<forall>n. norm (f n * x^n) \<le> K"
   254     by (auto simp add: Bseq_def)
   255   have "\<exists>N. \<forall>n\<ge>N. norm (norm (f n * z ^ n)) \<le> K * norm (z ^ n) * inverse (norm (x^n))"
   256   proof (intro exI allI impI)
   257     fix n :: nat
   258     assume "0 \<le> n"
   259     have "norm (norm (f n * z ^ n)) * norm (x^n) =
   260           norm (f n * x^n) * norm (z ^ n)"
   261       by (simp add: norm_mult abs_mult)
   262     also have "\<dots> \<le> K * norm (z ^ n)"
   263       by (simp only: mult_right_mono 4 norm_ge_zero)
   264     also have "\<dots> = K * norm (z ^ n) * (inverse (norm (x^n)) * norm (x^n))"
   265       by (simp add: x_neq_0)
   266     also have "\<dots> = K * norm (z ^ n) * inverse (norm (x^n)) * norm (x^n)"
   267       by (simp only: mult.assoc)
   268     finally show "norm (norm (f n * z ^ n)) \<le> K * norm (z ^ n) * inverse (norm (x^n))"
   269       by (simp add: mult_le_cancel_right x_neq_0)
   270   qed
   271   moreover have "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
   272   proof -
   273     from 2 have "norm (norm (z * inverse x)) < 1"
   274       using x_neq_0
   275       by (simp add: norm_mult nonzero_norm_inverse divide_inverse [where 'a=real, symmetric])
   276     then have "summable (\<lambda>n. norm (z * inverse x) ^ n)"
   277       by (rule summable_geometric)
   278     then have "summable (\<lambda>n. K * norm (z * inverse x) ^ n)"
   279       by (rule summable_mult)
   280     then show "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
   281       using x_neq_0
   282       by (simp add: norm_mult nonzero_norm_inverse power_mult_distrib
   283           power_inverse norm_power mult.assoc)
   284   qed
   285   ultimately show "summable (\<lambda>n. norm (f n * z ^ n))"
   286     by (rule summable_comparison_test)
   287 qed
   288 
   289 lemma powser_inside:
   290   fixes f :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
   291   shows
   292     "summable (\<lambda>n. f n * (x^n)) \<Longrightarrow> norm z < norm x \<Longrightarrow>
   293       summable (\<lambda>n. f n * (z ^ n))"
   294   by (rule powser_insidea [THEN summable_norm_cancel])
   295 
   296 lemma powser_times_n_limit_0:
   297   fixes x :: "'a::{real_normed_div_algebra,banach}"
   298   assumes "norm x < 1"
   299     shows "(\<lambda>n. of_nat n * x ^ n) \<longlonglongrightarrow> 0"
   300 proof -
   301   have "norm x / (1 - norm x) \<ge> 0"
   302     using assms by (auto simp: divide_simps)
   303   moreover obtain N where N: "norm x / (1 - norm x) < of_int N"
   304     using ex_le_of_int by (meson ex_less_of_int)
   305   ultimately have N0: "N>0"
   306     by auto
   307   then have *: "real_of_int (N + 1) * norm x / real_of_int N < 1"
   308     using N assms by (auto simp: field_simps)
   309   have **: "real_of_int N * (norm x * (real_of_nat (Suc n) * norm (x ^ n))) \<le>
   310       real_of_nat n * (norm x * ((1 + N) * norm (x ^ n)))" if "N \<le> int n" for n :: nat
   311   proof -
   312     from that have "real_of_int N * real_of_nat (Suc n) \<le> real_of_nat n * real_of_int (1 + N)"
   313       by (simp add: algebra_simps)
   314     then have "(real_of_int N * real_of_nat (Suc n)) * (norm x * norm (x ^ n)) \<le>
   315         (real_of_nat n *  (1 + N)) * (norm x * norm (x ^ n))"
   316       using N0 mult_mono by fastforce
   317     then show ?thesis
   318       by (simp add: algebra_simps)
   319   qed
   320   show ?thesis using *
   321     by (rule summable_LIMSEQ_zero [OF summable_ratio_test, where N1="nat N"])
   322       (simp add: N0 norm_mult field_simps ** del: of_nat_Suc of_int_add)
   323 qed
   324 
   325 corollary lim_n_over_pown:
   326   fixes x :: "'a::{real_normed_field,banach}"
   327   shows "1 < norm x \<Longrightarrow> ((\<lambda>n. of_nat n / x^n) \<longlongrightarrow> 0) sequentially"
   328   using powser_times_n_limit_0 [of "inverse x"]
   329   by (simp add: norm_divide divide_simps)
   330 
   331 lemma sum_split_even_odd:
   332   fixes f :: "nat \<Rightarrow> real"
   333   shows "(\<Sum>i<2 * n. if even i then f i else g i) = (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1))"
   334 proof (induct n)
   335   case 0
   336   then show ?case by simp
   337 next
   338   case (Suc n)
   339   have "(\<Sum>i<2 * Suc n. if even i then f i else g i) =
   340     (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1)) + (f (2 * n) + g (2 * n + 1))"
   341     using Suc.hyps unfolding One_nat_def by auto
   342   also have "\<dots> = (\<Sum>i<Suc n. f (2 * i)) + (\<Sum>i<Suc n. g (2 * i + 1))"
   343     by auto
   344   finally show ?case .
   345 qed
   346 
   347 lemma sums_if':
   348   fixes g :: "nat \<Rightarrow> real"
   349   assumes "g sums x"
   350   shows "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
   351   unfolding sums_def
   352 proof (rule LIMSEQ_I)
   353   fix r :: real
   354   assume "0 < r"
   355   from \<open>g sums x\<close>[unfolded sums_def, THEN LIMSEQ_D, OF this]
   356   obtain no where no_eq: "\<And>n. n \<ge> no \<Longrightarrow> (norm (sum g {..<n} - x) < r)"
   357     by blast
   358 
   359   let ?SUM = "\<lambda> m. \<Sum>i<m. if even i then 0 else g ((i - 1) div 2)"
   360   have "(norm (?SUM m - x) < r)" if "m \<ge> 2 * no" for m
   361   proof -
   362     from that have "m div 2 \<ge> no" by auto
   363     have sum_eq: "?SUM (2 * (m div 2)) = sum g {..< m div 2}"
   364       using sum_split_even_odd by auto
   365     then have "(norm (?SUM (2 * (m div 2)) - x) < r)"
   366       using no_eq unfolding sum_eq using \<open>m div 2 \<ge> no\<close> by auto
   367     moreover
   368     have "?SUM (2 * (m div 2)) = ?SUM m"
   369     proof (cases "even m")
   370       case True
   371       then show ?thesis
   372         by (auto simp add: even_two_times_div_two)
   373     next
   374       case False
   375       then have eq: "Suc (2 * (m div 2)) = m" by simp
   376       then have "even (2 * (m div 2))" using \<open>odd m\<close> by auto
   377       have "?SUM m = ?SUM (Suc (2 * (m div 2)))" unfolding eq ..
   378       also have "\<dots> = ?SUM (2 * (m div 2))" using \<open>even (2 * (m div 2))\<close> by auto
   379       finally show ?thesis by auto
   380     qed
   381     ultimately show ?thesis by auto
   382   qed
   383   then show "\<exists>no. \<forall> m \<ge> no. norm (?SUM m - x) < r"
   384     by blast
   385 qed
   386 
   387 lemma sums_if:
   388   fixes g :: "nat \<Rightarrow> real"
   389   assumes "g sums x" and "f sums y"
   390   shows "(\<lambda> n. if even n then f (n div 2) else g ((n - 1) div 2)) sums (x + y)"
   391 proof -
   392   let ?s = "\<lambda> n. if even n then 0 else f ((n - 1) div 2)"
   393   have if_sum: "(if B then (0 :: real) else E) + (if B then T else 0) = (if B then T else E)"
   394     for B T E
   395     by (cases B) auto
   396   have g_sums: "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
   397     using sums_if'[OF \<open>g sums x\<close>] .
   398   have if_eq: "\<And>B T E. (if \<not> B then T else E) = (if B then E else T)"
   399     by auto
   400   have "?s sums y" using sums_if'[OF \<open>f sums y\<close>] .
   401   from this[unfolded sums_def, THEN LIMSEQ_Suc]
   402   have "(\<lambda>n. if even n then f (n div 2) else 0) sums y"
   403     by (simp add: lessThan_Suc_eq_insert_0 sum_atLeast1_atMost_eq image_Suc_lessThan
   404         if_eq sums_def cong del: if_weak_cong)
   405   from sums_add[OF g_sums this] show ?thesis
   406     by (simp only: if_sum)
   407 qed
   408 
   409 subsection \<open>Alternating series test / Leibniz formula\<close>
   410 (* FIXME: generalise these results from the reals via type classes? *)
   411 
   412 lemma sums_alternating_upper_lower:
   413   fixes a :: "nat \<Rightarrow> real"
   414   assumes mono: "\<And>n. a (Suc n) \<le> a n"
   415     and a_pos: "\<And>n. 0 \<le> a n"
   416     and "a \<longlonglongrightarrow> 0"
   417   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) \<longlonglongrightarrow> l) \<and>
   418              ((\<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) \<longlonglongrightarrow> l)"
   419   (is "\<exists>l. ((\<forall>n. ?f n \<le> l) \<and> _) \<and> ((\<forall>n. l \<le> ?g n) \<and> _)")
   420 proof (rule nested_sequence_unique)
   421   have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" by auto
   422 
   423   show "\<forall>n. ?f n \<le> ?f (Suc n)"
   424   proof
   425     show "?f n \<le> ?f (Suc n)" for n
   426       using mono[of "2*n"] by auto
   427   qed
   428   show "\<forall>n. ?g (Suc n) \<le> ?g n"
   429   proof
   430     show "?g (Suc n) \<le> ?g n" for n
   431       using mono[of "Suc (2*n)"] by auto
   432   qed
   433   show "\<forall>n. ?f n \<le> ?g n"
   434   proof
   435     show "?f n \<le> ?g n" for n
   436       using fg_diff a_pos by auto
   437   qed
   438   show "(\<lambda>n. ?f n - ?g n) \<longlonglongrightarrow> 0"
   439     unfolding fg_diff
   440   proof (rule LIMSEQ_I)
   441     fix r :: real
   442     assume "0 < r"
   443     with \<open>a \<longlonglongrightarrow> 0\<close>[THEN LIMSEQ_D] obtain N where "\<And> n. n \<ge> N \<Longrightarrow> norm (a n - 0) < r"
   444       by auto
   445     then have "\<forall>n \<ge> N. norm (- a (2 * n) - 0) < r"
   446       by auto
   447     then show "\<exists>N. \<forall>n \<ge> N. norm (- a (2 * n) - 0) < r"
   448       by auto
   449   qed
   450 qed
   451 
   452 lemma summable_Leibniz':
   453   fixes a :: "nat \<Rightarrow> real"
   454   assumes a_zero: "a \<longlonglongrightarrow> 0"
   455     and a_pos: "\<And>n. 0 \<le> a n"
   456     and a_monotone: "\<And>n. a (Suc n) \<le> a n"
   457   shows summable: "summable (\<lambda> n. (-1)^n * a n)"
   458     and "\<And>n. (\<Sum>i<2*n. (-1)^i*a i) \<le> (\<Sum>i. (-1)^i*a i)"
   459     and "(\<lambda>n. \<Sum>i<2*n. (-1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (-1)^i*a i)"
   460     and "\<And>n. (\<Sum>i. (-1)^i*a i) \<le> (\<Sum>i<2*n+1. (-1)^i*a i)"
   461     and "(\<lambda>n. \<Sum>i<2*n+1. (-1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (-1)^i*a i)"
   462 proof -
   463   let ?S = "\<lambda>n. (-1)^n * a n"
   464   let ?P = "\<lambda>n. \<Sum>i<n. ?S i"
   465   let ?f = "\<lambda>n. ?P (2 * n)"
   466   let ?g = "\<lambda>n. ?P (2 * n + 1)"
   467   obtain l :: real
   468     where below_l: "\<forall> n. ?f n \<le> l"
   469       and "?f \<longlonglongrightarrow> l"
   470       and above_l: "\<forall> n. l \<le> ?g n"
   471       and "?g \<longlonglongrightarrow> l"
   472     using sums_alternating_upper_lower[OF a_monotone a_pos a_zero] by blast
   473 
   474   let ?Sa = "\<lambda>m. \<Sum>n<m. ?S n"
   475   have "?Sa \<longlonglongrightarrow> l"
   476   proof (rule LIMSEQ_I)
   477     fix r :: real
   478     assume "0 < r"
   479     with \<open>?f \<longlonglongrightarrow> l\<close>[THEN LIMSEQ_D]
   480     obtain f_no where f: "\<And>n. n \<ge> f_no \<Longrightarrow> norm (?f n - l) < r"
   481       by auto
   482     from \<open>0 < r\<close> \<open>?g \<longlonglongrightarrow> l\<close>[THEN LIMSEQ_D]
   483     obtain g_no where g: "\<And>n. n \<ge> g_no \<Longrightarrow> norm (?g n - l) < r"
   484       by auto
   485     have "norm (?Sa n - l) < r" if "n \<ge> (max (2 * f_no) (2 * g_no))" for n
   486     proof -
   487       from that have "n \<ge> 2 * f_no" and "n \<ge> 2 * g_no" by auto
   488       show ?thesis
   489       proof (cases "even n")
   490         case True
   491         then have n_eq: "2 * (n div 2) = n"
   492           by (simp add: even_two_times_div_two)
   493         with \<open>n \<ge> 2 * f_no\<close> have "n div 2 \<ge> f_no"
   494           by auto
   495         from f[OF this] show ?thesis
   496           unfolding n_eq atLeastLessThanSuc_atLeastAtMost .
   497       next
   498         case False
   499         then have "even (n - 1)" by simp
   500         then have n_eq: "2 * ((n - 1) div 2) = n - 1"
   501           by (simp add: even_two_times_div_two)
   502         then have range_eq: "n - 1 + 1 = n"
   503           using odd_pos[OF False] by auto
   504         from n_eq \<open>n \<ge> 2 * g_no\<close> have "(n - 1) div 2 \<ge> g_no"
   505           by auto
   506         from g[OF this] show ?thesis
   507           by (simp only: n_eq range_eq)
   508       qed
   509     qed
   510     then show "\<exists>no. \<forall>n \<ge> no. norm (?Sa n - l) < r" by blast
   511   qed
   512   then have sums_l: "(\<lambda>i. (-1)^i * a i) sums l"
   513     by (simp only: sums_def)
   514   then show "summable ?S"
   515     by (auto simp: summable_def)
   516 
   517   have "l = suminf ?S" by (rule sums_unique[OF sums_l])
   518 
   519   fix n
   520   show "suminf ?S \<le> ?g n"
   521     unfolding sums_unique[OF sums_l, symmetric] using above_l by auto
   522   show "?f n \<le> suminf ?S"
   523     unfolding sums_unique[OF sums_l, symmetric] using below_l by auto
   524   show "?g \<longlonglongrightarrow> suminf ?S"
   525     using \<open>?g \<longlonglongrightarrow> l\<close> \<open>l = suminf ?S\<close> by auto
   526   show "?f \<longlonglongrightarrow> suminf ?S"
   527     using \<open>?f \<longlonglongrightarrow> l\<close> \<open>l = suminf ?S\<close> by auto
   528 qed
   529 
   530 theorem summable_Leibniz:
   531   fixes a :: "nat \<Rightarrow> real"
   532   assumes a_zero: "a \<longlonglongrightarrow> 0"
   533     and "monoseq a"
   534   shows "summable (\<lambda> n. (-1)^n * a n)" (is "?summable")
   535     and "0 < a 0 \<longrightarrow>
   536       (\<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")
   537     and "a 0 < 0 \<longrightarrow>
   538       (\<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")
   539     and "(\<lambda>n. \<Sum>i<2*n. (- 1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (- 1)^i*a i)" (is "?f")
   540     and "(\<lambda>n. \<Sum>i<2*n+1. (- 1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (- 1)^i*a i)" (is "?g")
   541 proof -
   542   have "?summable \<and> ?pos \<and> ?neg \<and> ?f \<and> ?g"
   543   proof (cases "(\<forall>n. 0 \<le> a n) \<and> (\<forall>m. \<forall>n\<ge>m. a n \<le> a m)")
   544     case True
   545     then have ord: "\<And>n m. m \<le> n \<Longrightarrow> a n \<le> a m"
   546       and ge0: "\<And>n. 0 \<le> a n"
   547       by auto
   548     have mono: "a (Suc n) \<le> a n" for n
   549       using ord[where n="Suc n" and m=n] by auto
   550     note leibniz = summable_Leibniz'[OF \<open>a \<longlonglongrightarrow> 0\<close> ge0]
   551     from leibniz[OF mono]
   552     show ?thesis using \<open>0 \<le> a 0\<close> by auto
   553   next
   554     let ?a = "\<lambda>n. - a n"
   555     case False
   556     with monoseq_le[OF \<open>monoseq a\<close> \<open>a \<longlonglongrightarrow> 0\<close>]
   557     have "(\<forall> n. a n \<le> 0) \<and> (\<forall>m. \<forall>n\<ge>m. a m \<le> a n)" by auto
   558     then have ord: "\<And>n m. m \<le> n \<Longrightarrow> ?a n \<le> ?a m" and ge0: "\<And> n. 0 \<le> ?a n"
   559       by auto
   560     have monotone: "?a (Suc n) \<le> ?a n" for n
   561       using ord[where n="Suc n" and m=n] by auto
   562     note leibniz =
   563       summable_Leibniz'[OF _ ge0, of "\<lambda>x. x",
   564         OF tendsto_minus[OF \<open>a \<longlonglongrightarrow> 0\<close>, unfolded minus_zero] monotone]
   565     have "summable (\<lambda> n. (-1)^n * ?a n)"
   566       using leibniz(1) by auto
   567     then obtain l where "(\<lambda> n. (-1)^n * ?a n) sums l"
   568       unfolding summable_def by auto
   569     from this[THEN sums_minus] have "(\<lambda> n. (-1)^n * a n) sums -l"
   570       by auto
   571     then have ?summable by (auto simp: summable_def)
   572     moreover
   573     have "\<bar>- a - - b\<bar> = \<bar>a - b\<bar>" for a b :: real
   574       unfolding minus_diff_minus by auto
   575 
   576     from suminf_minus[OF leibniz(1), unfolded mult_minus_right minus_minus]
   577     have move_minus: "(\<Sum>n. - ((- 1) ^ n * a n)) = - (\<Sum>n. (- 1) ^ n * a n)"
   578       by auto
   579 
   580     have ?pos using \<open>0 \<le> ?a 0\<close> by auto
   581     moreover have ?neg
   582       using leibniz(2,4)
   583       unfolding mult_minus_right sum_negf move_minus neg_le_iff_le
   584       by auto
   585     moreover have ?f and ?g
   586       using leibniz(3,5)[unfolded mult_minus_right sum_negf move_minus, THEN tendsto_minus_cancel]
   587       by auto
   588     ultimately show ?thesis by auto
   589   qed
   590   then show ?summable and ?pos and ?neg and ?f and ?g
   591     by safe
   592 qed
   593 
   594 
   595 subsection \<open>Term-by-Term Differentiability of Power Series\<close>
   596 
   597 definition diffs :: "(nat \<Rightarrow> 'a::ring_1) \<Rightarrow> nat \<Rightarrow> 'a"
   598   where "diffs c = (\<lambda>n. of_nat (Suc n) * c (Suc n))"
   599 
   600 text \<open>Lemma about distributing negation over it.\<close>
   601 lemma diffs_minus: "diffs (\<lambda>n. - c n) = (\<lambda>n. - diffs c n)"
   602   by (simp add: diffs_def)
   603 
   604 lemma diffs_equiv:
   605   fixes x :: "'a::{real_normed_vector,ring_1}"
   606   shows "summable (\<lambda>n. diffs c n * x^n) \<Longrightarrow>
   607     (\<lambda>n. of_nat n * c n * x^(n - Suc 0)) sums (\<Sum>n. diffs c n * x^n)"
   608   unfolding diffs_def
   609   by (simp add: summable_sums sums_Suc_imp)
   610 
   611 lemma lemma_termdiff1:
   612   fixes z :: "'a :: {monoid_mult,comm_ring}"
   613   shows "(\<Sum>p<m. (((z + h) ^ (m - p)) * (z ^ p)) - (z ^ m)) =
   614     (\<Sum>p<m. (z ^ p) * (((z + h) ^ (m - p)) - (z ^ (m - p))))"
   615   by (auto simp add: algebra_simps power_add [symmetric])
   616 
   617 lemma sumr_diff_mult_const2: "sum f {..<n} - of_nat n * r = (\<Sum>i<n. f i - r)"
   618   for r :: "'a::ring_1"
   619   by (simp add: sum_subtractf)
   620 
   621 lemma lemma_realpow_rev_sumr:
   622   "(\<Sum>p<Suc n. (x ^ p) * (y ^ (n - p))) = (\<Sum>p<Suc n. (x ^ (n - p)) * (y ^ p))"
   623   by (subst nat_diff_sum_reindex[symmetric]) simp
   624 
   625 lemma lemma_termdiff2:
   626   fixes h :: "'a::field"
   627   assumes h: "h \<noteq> 0"
   628   shows "((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0) =
   629     h * (\<Sum>p< n - Suc 0. \<Sum>q< n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q))"
   630     (is "?lhs = ?rhs")
   631   apply (subgoal_tac "h * ?lhs = h * ?rhs")
   632    apply (simp add: h)
   633   apply (simp add: right_diff_distrib diff_divide_distrib h)
   634   apply (simp add: mult.assoc [symmetric])
   635   apply (cases n)
   636   apply simp
   637   apply (simp add: diff_power_eq_sum h right_diff_distrib [symmetric] mult.assoc
   638       del: power_Suc sum_lessThan_Suc of_nat_Suc)
   639   apply (subst lemma_realpow_rev_sumr)
   640   apply (subst sumr_diff_mult_const2)
   641   apply simp
   642   apply (simp only: lemma_termdiff1 sum_distrib_left)
   643   apply (rule sum.cong [OF refl])
   644   apply (simp add: less_iff_Suc_add)
   645   apply clarify
   646   apply (simp add: sum_distrib_left diff_power_eq_sum ac_simps
   647       del: sum_lessThan_Suc power_Suc)
   648   apply (subst mult.assoc [symmetric], subst power_add [symmetric])
   649   apply (simp add: ac_simps)
   650   done
   651 
   652 lemma real_sum_nat_ivl_bounded2:
   653   fixes K :: "'a::linordered_semidom"
   654   assumes f: "\<And>p::nat. p < n \<Longrightarrow> f p \<le> K"
   655     and K: "0 \<le> K"
   656   shows "sum f {..<n-k} \<le> of_nat n * K"
   657   apply (rule order_trans [OF sum_mono])
   658    apply (rule f)
   659    apply simp
   660   apply (simp add: mult_right_mono K)
   661   done
   662 
   663 lemma lemma_termdiff3:
   664   fixes h z :: "'a::real_normed_field"
   665   assumes 1: "h \<noteq> 0"
   666     and 2: "norm z \<le> K"
   667     and 3: "norm (z + h) \<le> K"
   668   shows "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) \<le>
   669     of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
   670 proof -
   671   have "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) =
   672     norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q)) * norm h"
   673     by (metis (lifting, no_types) lemma_termdiff2 [OF 1] mult.commute norm_mult)
   674   also have "\<dots> \<le> of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2)) * norm h"
   675   proof (rule mult_right_mono [OF _ norm_ge_zero])
   676     from norm_ge_zero 2 have K: "0 \<le> K"
   677       by (rule order_trans)
   678     have le_Kn: "\<And>i j n. i + j = n \<Longrightarrow> norm ((z + h) ^ i * z ^ j) \<le> K ^ n"
   679       apply (erule subst)
   680       apply (simp only: norm_mult norm_power power_add)
   681       apply (intro mult_mono power_mono 2 3 norm_ge_zero zero_le_power K)
   682       done
   683     show "norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q)) \<le>
   684         of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2))"
   685       apply (intro
   686           order_trans [OF norm_sum]
   687           real_sum_nat_ivl_bounded2
   688           mult_nonneg_nonneg
   689           of_nat_0_le_iff
   690           zero_le_power K)
   691       apply (rule le_Kn)
   692       apply simp
   693       done
   694   qed
   695   also have "\<dots> = of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
   696     by (simp only: mult.assoc)
   697   finally show ?thesis .
   698 qed
   699 
   700 lemma lemma_termdiff4:
   701   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   702     and k :: real
   703   assumes k: "0 < k"
   704     and le: "\<And>h. h \<noteq> 0 \<Longrightarrow> norm h < k \<Longrightarrow> norm (f h) \<le> K * norm h"
   705   shows "f \<midarrow>0\<rightarrow> 0"
   706 proof (rule tendsto_norm_zero_cancel)
   707   show "(\<lambda>h. norm (f h)) \<midarrow>0\<rightarrow> 0"
   708   proof (rule real_tendsto_sandwich)
   709     show "eventually (\<lambda>h. 0 \<le> norm (f h)) (at 0)"
   710       by simp
   711     show "eventually (\<lambda>h. norm (f h) \<le> K * norm h) (at 0)"
   712       using k by (auto simp add: eventually_at dist_norm le)
   713     show "(\<lambda>h. 0) \<midarrow>(0::'a)\<rightarrow> (0::real)"
   714       by (rule tendsto_const)
   715     have "(\<lambda>h. K * norm h) \<midarrow>(0::'a)\<rightarrow> K * norm (0::'a)"
   716       by (intro tendsto_intros)
   717     then show "(\<lambda>h. K * norm h) \<midarrow>(0::'a)\<rightarrow> 0"
   718       by simp
   719   qed
   720 qed
   721 
   722 lemma lemma_termdiff5:
   723   fixes g :: "'a::real_normed_vector \<Rightarrow> nat \<Rightarrow> 'b::banach"
   724     and k :: real
   725   assumes k: "0 < k"
   726     and f: "summable f"
   727     and le: "\<And>h n. h \<noteq> 0 \<Longrightarrow> norm h < k \<Longrightarrow> norm (g h n) \<le> f n * norm h"
   728   shows "(\<lambda>h. suminf (g h)) \<midarrow>0\<rightarrow> 0"
   729 proof (rule lemma_termdiff4 [OF k])
   730   fix h :: 'a
   731   assume "h \<noteq> 0" and "norm h < k"
   732   then have 1: "\<forall>n. norm (g h n) \<le> f n * norm h"
   733     by (simp add: le)
   734   then have "\<exists>N. \<forall>n\<ge>N. norm (norm (g h n)) \<le> f n * norm h"
   735     by simp
   736   moreover from f have 2: "summable (\<lambda>n. f n * norm h)"
   737     by (rule summable_mult2)
   738   ultimately have 3: "summable (\<lambda>n. norm (g h n))"
   739     by (rule summable_comparison_test)
   740   then have "norm (suminf (g h)) \<le> (\<Sum>n. norm (g h n))"
   741     by (rule summable_norm)
   742   also from 1 3 2 have "(\<Sum>n. norm (g h n)) \<le> (\<Sum>n. f n * norm h)"
   743     by (rule suminf_le)
   744   also from f have "(\<Sum>n. f n * norm h) = suminf f * norm h"
   745     by (rule suminf_mult2 [symmetric])
   746   finally show "norm (suminf (g h)) \<le> suminf f * norm h" .
   747 qed
   748 
   749 
   750 (* FIXME: Long proofs *)
   751 
   752 lemma termdiffs_aux:
   753   fixes x :: "'a::{real_normed_field,banach}"
   754   assumes 1: "summable (\<lambda>n. diffs (diffs c) n * K ^ n)"
   755     and 2: "norm x < norm K"
   756   shows "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<midarrow>0\<rightarrow> 0"
   757 proof -
   758   from dense [OF 2] obtain r where r1: "norm x < r" and r2: "r < norm K"
   759     by fast
   760   from norm_ge_zero r1 have r: "0 < r"
   761     by (rule order_le_less_trans)
   762   then have r_neq_0: "r \<noteq> 0" by simp
   763   show ?thesis
   764   proof (rule lemma_termdiff5)
   765     show "0 < r - norm x"
   766       using r1 by simp
   767     from r r2 have "norm (of_real r::'a) < norm K"
   768       by simp
   769     with 1 have "summable (\<lambda>n. norm (diffs (diffs c) n * (of_real r ^ n)))"
   770       by (rule powser_insidea)
   771     then have "summable (\<lambda>n. diffs (diffs (\<lambda>n. norm (c n))) n * r ^ n)"
   772       using r by (simp add: diffs_def norm_mult norm_power del: of_nat_Suc)
   773     then have "summable (\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0))"
   774       by (rule diffs_equiv [THEN sums_summable])
   775     also have "(\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0)) =
   776       (\<lambda>n. diffs (\<lambda>m. of_nat (m - Suc 0) * norm (c m) * inverse r) n * (r ^ n))"
   777       apply (rule ext)
   778       apply (simp add: diffs_def)
   779       apply (case_tac n)
   780        apply (simp_all add: r_neq_0)
   781       done
   782     finally have "summable
   783       (\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0))"
   784       by (rule diffs_equiv [THEN sums_summable])
   785     also have
   786       "(\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0)) =
   787        (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))"
   788       apply (rule ext)
   789       apply (case_tac n)
   790        apply simp
   791       apply (rename_tac nat)
   792       apply (case_tac nat)
   793        apply simp
   794       apply (simp add: r_neq_0)
   795       done
   796     finally show "summable (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))" .
   797   next
   798     fix h :: 'a
   799     fix n :: nat
   800     assume h: "h \<noteq> 0"
   801     assume "norm h < r - norm x"
   802     then have "norm x + norm h < r" by simp
   803     with norm_triangle_ineq have xh: "norm (x + h) < r"
   804       by (rule order_le_less_trans)
   805     show "norm (c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<le>
   806       norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2) * norm h"
   807       apply (simp only: norm_mult mult.assoc)
   808       apply (rule mult_left_mono [OF _ norm_ge_zero])
   809       apply (simp add: mult.assoc [symmetric])
   810       apply (metis h lemma_termdiff3 less_eq_real_def r1 xh)
   811       done
   812   qed
   813 qed
   814 
   815 lemma termdiffs:
   816   fixes K x :: "'a::{real_normed_field,banach}"
   817   assumes 1: "summable (\<lambda>n. c n * K ^ n)"
   818     and 2: "summable (\<lambda>n. (diffs c) n * K ^ n)"
   819     and 3: "summable (\<lambda>n. (diffs (diffs c)) n * K ^ n)"
   820     and 4: "norm x < norm K"
   821   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. (diffs c) n * x^n)"
   822   unfolding DERIV_def
   823 proof (rule LIM_zero_cancel)
   824   show "(\<lambda>h. (suminf (\<lambda>n. c n * (x + h) ^ n) - suminf (\<lambda>n. c n * x^n)) / h
   825             - suminf (\<lambda>n. diffs c n * x^n)) \<midarrow>0\<rightarrow> 0"
   826   proof (rule LIM_equal2)
   827     show "0 < norm K - norm x"
   828       using 4 by (simp add: less_diff_eq)
   829   next
   830     fix h :: 'a
   831     assume "norm (h - 0) < norm K - norm x"
   832     then have "norm x + norm h < norm K" by simp
   833     then have 5: "norm (x + h) < norm K"
   834       by (rule norm_triangle_ineq [THEN order_le_less_trans])
   835     have "summable (\<lambda>n. c n * x^n)"
   836       and "summable (\<lambda>n. c n * (x + h) ^ n)"
   837       and "summable (\<lambda>n. diffs c n * x^n)"
   838       using 1 2 4 5 by (auto elim: powser_inside)
   839     then have "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
   840           (\<Sum>n. (c n * (x + h) ^ n - c n * x^n) / h - of_nat n * c n * x ^ (n - Suc 0))"
   841       by (intro sums_unique sums_diff sums_divide diffs_equiv summable_sums)
   842     then show "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
   843           (\<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0)))"
   844       by (simp add: algebra_simps)
   845   next
   846     show "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<midarrow>0\<rightarrow> 0"
   847       by (rule termdiffs_aux [OF 3 4])
   848   qed
   849 qed
   850 
   851 subsection \<open>The Derivative of a Power Series Has the Same Radius of Convergence\<close>
   852 
   853 lemma termdiff_converges:
   854   fixes x :: "'a::{real_normed_field,banach}"
   855   assumes K: "norm x < K"
   856     and sm: "\<And>x. norm x < K \<Longrightarrow> summable(\<lambda>n. c n * x ^ n)"
   857   shows "summable (\<lambda>n. diffs c n * x ^ n)"
   858 proof (cases "x = 0")
   859   case True
   860   then show ?thesis
   861     using powser_sums_zero sums_summable by auto
   862 next
   863   case False
   864   then have "K > 0"
   865     using K less_trans zero_less_norm_iff by blast
   866   then obtain r :: real where r: "norm x < norm r" "norm r < K" "r > 0"
   867     using K False
   868     by (auto simp: field_simps abs_less_iff add_pos_pos intro: that [of "(norm x + K) / 2"])
   869   have "(\<lambda>n. of_nat n * (x / of_real r) ^ n) \<longlonglongrightarrow> 0"
   870     using r by (simp add: norm_divide powser_times_n_limit_0 [of "x / of_real r"])
   871   then obtain N where N: "\<And>n. n\<ge>N \<Longrightarrow> real_of_nat n * norm x ^ n < r ^ n"
   872     using r unfolding LIMSEQ_iff
   873     apply (drule_tac x=1 in spec)
   874     apply (auto simp: norm_divide norm_mult norm_power field_simps)
   875     done
   876   have "summable (\<lambda>n. (of_nat n * c n) * x ^ n)"
   877     apply (rule summable_comparison_test' [of "\<lambda>n. norm(c n * (of_real r) ^ n)" N])
   878      apply (rule powser_insidea [OF sm [of "of_real ((r+K)/2)"]])
   879     using N r norm_of_real [of "r + K", where 'a = 'a]
   880       apply (auto simp add: norm_divide norm_mult norm_power field_simps)
   881     apply (fastforce simp: less_eq_real_def)
   882     done
   883   then have "summable (\<lambda>n. (of_nat (Suc n) * c(Suc n)) * x ^ Suc n)"
   884     using summable_iff_shift [of "\<lambda>n. of_nat n * c n * x ^ n" 1]
   885     by simp
   886   then have "summable (\<lambda>n. (of_nat (Suc n) * c(Suc n)) * x ^ n)"
   887     using False summable_mult2 [of "\<lambda>n. (of_nat (Suc n) * c(Suc n) * x ^ n) * x" "inverse x"]
   888     by (simp add: mult.assoc) (auto simp: ac_simps)
   889   then show ?thesis
   890     by (simp add: diffs_def)
   891 qed
   892 
   893 lemma termdiff_converges_all:
   894   fixes x :: "'a::{real_normed_field,banach}"
   895   assumes "\<And>x. summable (\<lambda>n. c n * x^n)"
   896   shows "summable (\<lambda>n. diffs c n * x^n)"
   897   apply (rule termdiff_converges [where K = "1 + norm x"])
   898   using assms
   899    apply auto
   900   done
   901 
   902 lemma termdiffs_strong:
   903   fixes K x :: "'a::{real_normed_field,banach}"
   904   assumes sm: "summable (\<lambda>n. c n * K ^ n)"
   905     and K: "norm x < norm K"
   906   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. diffs c n * x^n)"
   907 proof -
   908   have K2: "norm ((of_real (norm K) + of_real (norm x)) / 2 :: 'a) < norm K"
   909     using K
   910     apply (auto simp: norm_divide field_simps)
   911     apply (rule le_less_trans [of _ "of_real (norm K) + of_real (norm x)"])
   912      apply (auto simp: mult_2_right norm_triangle_mono)
   913     done
   914   then have [simp]: "norm ((of_real (norm K) + of_real (norm x)) :: 'a) < norm K * 2"
   915     by simp
   916   have "summable (\<lambda>n. c n * (of_real (norm x + norm K) / 2) ^ n)"
   917     by (metis K2 summable_norm_cancel [OF powser_insidea [OF sm]] add.commute of_real_add)
   918   moreover have "\<And>x. norm x < norm K \<Longrightarrow> summable (\<lambda>n. diffs c n * x ^ n)"
   919     by (blast intro: sm termdiff_converges powser_inside)
   920   moreover have "\<And>x. norm x < norm K \<Longrightarrow> summable (\<lambda>n. diffs(diffs c) n * x ^ n)"
   921     by (blast intro: sm termdiff_converges powser_inside)
   922   ultimately show ?thesis
   923     apply (rule termdiffs [where K = "of_real (norm x + norm K) / 2"])
   924       apply (auto simp: field_simps)
   925     using K
   926     apply (simp_all add: of_real_add [symmetric] del: of_real_add)
   927     done
   928 qed
   929 
   930 lemma termdiffs_strong_converges_everywhere:
   931   fixes K x :: "'a::{real_normed_field,banach}"
   932   assumes "\<And>y. summable (\<lambda>n. c n * y ^ n)"
   933   shows "((\<lambda>x. \<Sum>n. c n * x^n) has_field_derivative (\<Sum>n. diffs c n * x^n)) (at x)"
   934   using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
   935   by (force simp del: of_real_add)
   936 
   937 lemma termdiffs_strong':
   938   fixes z :: "'a :: {real_normed_field,banach}"
   939   assumes "\<And>z. norm z < K \<Longrightarrow> summable (\<lambda>n. c n * z ^ n)"
   940   assumes "norm z < K"
   941   shows   "((\<lambda>z. \<Sum>n. c n * z^n) has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
   942 proof (rule termdiffs_strong)
   943   define L :: real where "L =  (norm z + K) / 2"
   944   have "0 \<le> norm z" by simp
   945   also note \<open>norm z < K\<close>
   946   finally have K: "K \<ge> 0" by simp
   947   from assms K have L: "L \<ge> 0" "norm z < L" "L < K" by (simp_all add: L_def)
   948   from L show "norm z < norm (of_real L :: 'a)" by simp
   949   from L show "summable (\<lambda>n. c n * of_real L ^ n)" by (intro assms(1)) simp_all
   950 qed
   951 
   952 lemma termdiffs_sums_strong:
   953   fixes z :: "'a :: {banach,real_normed_field}"
   954   assumes sums: "\<And>z. norm z < K \<Longrightarrow> (\<lambda>n. c n * z ^ n) sums f z"
   955   assumes deriv: "(f has_field_derivative f') (at z)"
   956   assumes norm: "norm z < K"
   957   shows   "(\<lambda>n. diffs c n * z ^ n) sums f'"
   958 proof -
   959   have summable: "summable (\<lambda>n. diffs c n * z^n)"
   960     by (intro termdiff_converges[OF norm] sums_summable[OF sums])
   961   from norm have "eventually (\<lambda>z. z \<in> norm -` {..<K}) (nhds z)"
   962     by (intro eventually_nhds_in_open open_vimage)
   963        (simp_all add: continuous_on_norm continuous_on_id)
   964   hence eq: "eventually (\<lambda>z. (\<Sum>n. c n * z^n) = f z) (nhds z)"
   965     by eventually_elim (insert sums, simp add: sums_iff)
   966 
   967   have "((\<lambda>z. \<Sum>n. c n * z^n) has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
   968     by (intro termdiffs_strong'[OF _ norm] sums_summable[OF sums])
   969   hence "(f has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
   970     by (subst (asm) DERIV_cong_ev[OF refl eq refl])
   971   from this and deriv have "(\<Sum>n. diffs c n * z^n) = f'" by (rule DERIV_unique)
   972   with summable show ?thesis by (simp add: sums_iff)
   973 qed
   974 
   975 lemma isCont_powser:
   976   fixes K x :: "'a::{real_normed_field,banach}"
   977   assumes "summable (\<lambda>n. c n * K ^ n)"
   978   assumes "norm x < norm K"
   979   shows "isCont (\<lambda>x. \<Sum>n. c n * x^n) x"
   980   using termdiffs_strong[OF assms] by (blast intro!: DERIV_isCont)
   981 
   982 lemmas isCont_powser' = isCont_o2[OF _ isCont_powser]
   983 
   984 lemma isCont_powser_converges_everywhere:
   985   fixes K x :: "'a::{real_normed_field,banach}"
   986   assumes "\<And>y. summable (\<lambda>n. c n * y ^ n)"
   987   shows "isCont (\<lambda>x. \<Sum>n. c n * x^n) x"
   988   using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
   989   by (force intro!: DERIV_isCont simp del: of_real_add)
   990 
   991 lemma powser_limit_0:
   992   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
   993   assumes s: "0 < s"
   994     and sm: "\<And>x. norm x < s \<Longrightarrow> (\<lambda>n. a n * x ^ n) sums (f x)"
   995   shows "(f \<longlongrightarrow> a 0) (at 0)"
   996 proof -
   997   have "summable (\<lambda>n. a n * (of_real s / 2) ^ n)"
   998     apply (rule sums_summable [where l = "f (of_real s / 2)", OF sm])
   999     using s
  1000     apply (auto simp: norm_divide)
  1001     done
  1002   then have "((\<lambda>x. \<Sum>n. a n * x ^ n) has_field_derivative (\<Sum>n. diffs a n * 0 ^ n)) (at 0)"
  1003     apply (rule termdiffs_strong)
  1004     using s
  1005     apply (auto simp: norm_divide)
  1006     done
  1007   then have "isCont (\<lambda>x. \<Sum>n. a n * x ^ n) 0"
  1008     by (blast intro: DERIV_continuous)
  1009   then have "((\<lambda>x. \<Sum>n. a n * x ^ n) \<longlongrightarrow> a 0) (at 0)"
  1010     by (simp add: continuous_within)
  1011   then show ?thesis
  1012     apply (rule Lim_transform)
  1013     apply (auto simp add: LIM_eq)
  1014     apply (rule_tac x="s" in exI)
  1015     using s
  1016     apply (auto simp: sm [THEN sums_unique])
  1017     done
  1018 qed
  1019 
  1020 lemma powser_limit_0_strong:
  1021   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
  1022   assumes s: "0 < s"
  1023     and sm: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < s \<Longrightarrow> (\<lambda>n. a n * x ^ n) sums (f x)"
  1024   shows "(f \<longlongrightarrow> a 0) (at 0)"
  1025 proof -
  1026   have *: "((\<lambda>x. if x = 0 then a 0 else f x) \<longlongrightarrow> a 0) (at 0)"
  1027     apply (rule powser_limit_0 [OF s])
  1028     apply (case_tac "x = 0")
  1029      apply (auto simp add: powser_sums_zero sm)
  1030     done
  1031   show ?thesis
  1032     apply (subst LIM_equal [where g = "(\<lambda>x. if x = 0 then a 0 else f x)"])
  1033      apply (simp_all add: *)
  1034     done
  1035 qed
  1036 
  1037 
  1038 subsection \<open>Derivability of power series\<close>
  1039 
  1040 lemma DERIV_series':
  1041   fixes f :: "real \<Rightarrow> nat \<Rightarrow> real"
  1042   assumes DERIV_f: "\<And> n. DERIV (\<lambda> x. f x n) x0 :> (f' x0 n)"
  1043     and allf_summable: "\<And> x. x \<in> {a <..< b} \<Longrightarrow> summable (f x)"
  1044     and x0_in_I: "x0 \<in> {a <..< b}"
  1045     and "summable (f' x0)"
  1046     and "summable L"
  1047     and L_def: "\<And>n x y. x \<in> {a <..< b} \<Longrightarrow> y \<in> {a <..< b} \<Longrightarrow> \<bar>f x n - f y n\<bar> \<le> L n * \<bar>x - y\<bar>"
  1048   shows "DERIV (\<lambda> x. suminf (f x)) x0 :> (suminf (f' x0))"
  1049   unfolding DERIV_def
  1050 proof (rule LIM_I)
  1051   fix r :: real
  1052   assume "0 < r" then have "0 < r/3" by auto
  1053 
  1054   obtain N_L where N_L: "\<And> n. N_L \<le> n \<Longrightarrow> \<bar> \<Sum> i. L (i + n) \<bar> < r/3"
  1055     using suminf_exist_split[OF \<open>0 < r/3\<close> \<open>summable L\<close>] by auto
  1056 
  1057   obtain N_f' where N_f': "\<And> n. N_f' \<le> n \<Longrightarrow> \<bar> \<Sum> i. f' x0 (i + n) \<bar> < r/3"
  1058     using suminf_exist_split[OF \<open>0 < r/3\<close> \<open>summable (f' x0)\<close>] by auto
  1059 
  1060   let ?N = "Suc (max N_L N_f')"
  1061   have "\<bar> \<Sum> i. f' x0 (i + ?N) \<bar> < r/3" (is "?f'_part < r/3")
  1062     and L_estimate: "\<bar> \<Sum> i. L (i + ?N) \<bar> < r/3"
  1063     using N_L[of "?N"] and N_f' [of "?N"] by auto
  1064 
  1065   let ?diff = "\<lambda>i x. (f (x0 + x) i - f x0 i) / x"
  1066 
  1067   let ?r = "r / (3 * real ?N)"
  1068   from \<open>0 < r\<close> have "0 < ?r" by simp
  1069 
  1070   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)"
  1071   define S' where "S' = Min (?s ` {..< ?N })"
  1072 
  1073   have "0 < S'"
  1074     unfolding S'_def
  1075   proof (rule iffD2[OF Min_gr_iff])
  1076     show "\<forall>x \<in> (?s ` {..< ?N }). 0 < x"
  1077     proof
  1078       fix x
  1079       assume "x \<in> ?s ` {..<?N}"
  1080       then obtain n where "x = ?s n" and "n \<in> {..<?N}"
  1081         using image_iff[THEN iffD1] by blast
  1082       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF \<open>0 < ?r\<close>, unfolded real_norm_def]
  1083       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)"
  1084         by auto
  1085       have "0 < ?s n"
  1086         by (rule someI2[where a=s]) (auto simp add: s_bound simp del: of_nat_Suc)
  1087       then show "0 < x" by (simp only: \<open>x = ?s n\<close>)
  1088     qed
  1089   qed auto
  1090 
  1091   define S where "S = min (min (x0 - a) (b - x0)) S'"
  1092   then have "0 < S" and S_a: "S \<le> x0 - a" and S_b: "S \<le> b - x0"
  1093     and "S \<le> S'" using x0_in_I and \<open>0 < S'\<close>
  1094     by auto
  1095 
  1096   have "\<bar>(suminf (f (x0 + x)) - suminf (f x0)) / x - suminf (f' x0)\<bar> < r"
  1097     if "x \<noteq> 0" and "\<bar>x\<bar> < S" for x
  1098   proof -
  1099     from that have x_in_I: "x0 + x \<in> {a <..< b}"
  1100       using S_a S_b by auto
  1101 
  1102     note diff_smbl = summable_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
  1103     note div_smbl = summable_divide[OF diff_smbl]
  1104     note all_smbl = summable_diff[OF div_smbl \<open>summable (f' x0)\<close>]
  1105     note ign = summable_ignore_initial_segment[where k="?N"]
  1106     note diff_shft_smbl = summable_diff[OF ign[OF allf_summable[OF x_in_I]] ign[OF allf_summable[OF x0_in_I]]]
  1107     note div_shft_smbl = summable_divide[OF diff_shft_smbl]
  1108     note all_shft_smbl = summable_diff[OF div_smbl ign[OF \<open>summable (f' x0)\<close>]]
  1109 
  1110     have 1: "\<bar>(\<bar>?diff (n + ?N) x\<bar>)\<bar> \<le> L (n + ?N)" for n
  1111     proof -
  1112       have "\<bar>?diff (n + ?N) x\<bar> \<le> L (n + ?N) * \<bar>(x0 + x) - x0\<bar> / \<bar>x\<bar>"
  1113         using divide_right_mono[OF L_def[OF x_in_I x0_in_I] abs_ge_zero]
  1114         by (simp only: abs_divide)
  1115       with \<open>x \<noteq> 0\<close> show ?thesis by auto
  1116     qed
  1117     note 2 = summable_rabs_comparison_test[OF _ ign[OF \<open>summable L\<close>]]
  1118     from 1 have "\<bar> \<Sum> i. ?diff (i + ?N) x \<bar> \<le> (\<Sum> i. L (i + ?N))"
  1119       by (metis (lifting) abs_idempotent
  1120           order_trans[OF summable_rabs[OF 2] suminf_le[OF _ 2 ign[OF \<open>summable L\<close>]]])
  1121     then have "\<bar>\<Sum>i. ?diff (i + ?N) x\<bar> \<le> r / 3" (is "?L_part \<le> r/3")
  1122       using L_estimate by auto
  1123 
  1124     have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n\<bar> \<le> (\<Sum>n<?N. \<bar>?diff n x - f' x0 n\<bar>)" ..
  1125     also have "\<dots> < (\<Sum>n<?N. ?r)"
  1126     proof (rule sum_strict_mono)
  1127       fix n
  1128       assume "n \<in> {..< ?N}"
  1129       have "\<bar>x\<bar> < S" using \<open>\<bar>x\<bar> < S\<close> .
  1130       also have "S \<le> S'" using \<open>S \<le> S'\<close> .
  1131       also have "S' \<le> ?s n"
  1132         unfolding S'_def
  1133       proof (rule Min_le_iff[THEN iffD2])
  1134         have "?s n \<in> (?s ` {..<?N}) \<and> ?s n \<le> ?s n"
  1135           using \<open>n \<in> {..< ?N}\<close> by auto
  1136         then show "\<exists> a \<in> (?s ` {..<?N}). a \<le> ?s n"
  1137           by blast
  1138       qed auto
  1139       finally have "\<bar>x\<bar> < ?s n" .
  1140 
  1141       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF \<open>0 < ?r\<close>,
  1142           unfolded real_norm_def diff_0_right, unfolded some_eq_ex[symmetric], THEN conjunct2]
  1143       have "\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < ?s n \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r" .
  1144       with \<open>x \<noteq> 0\<close> and \<open>\<bar>x\<bar> < ?s n\<close> show "\<bar>?diff n x - f' x0 n\<bar> < ?r"
  1145         by blast
  1146     qed auto
  1147     also have "\<dots> = of_nat (card {..<?N}) * ?r"
  1148       by (rule sum_constant)
  1149     also have "\<dots> = real ?N * ?r"
  1150       by simp
  1151     also have "\<dots> = r/3"
  1152       by (auto simp del: of_nat_Suc)
  1153     finally have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n \<bar> < r / 3" (is "?diff_part < r / 3") .
  1154 
  1155     from suminf_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
  1156     have "\<bar>(suminf (f (x0 + x)) - (suminf (f x0))) / x - suminf (f' x0)\<bar> =
  1157         \<bar>\<Sum>n. ?diff n x - f' x0 n\<bar>"
  1158       unfolding suminf_diff[OF div_smbl \<open>summable (f' x0)\<close>, symmetric]
  1159       using suminf_divide[OF diff_smbl, symmetric] by auto
  1160     also have "\<dots> \<le> ?diff_part + \<bar>(\<Sum>n. ?diff (n + ?N) x) - (\<Sum> n. f' x0 (n + ?N))\<bar>"
  1161       unfolding suminf_split_initial_segment[OF all_smbl, where k="?N"]
  1162       unfolding suminf_diff[OF div_shft_smbl ign[OF \<open>summable (f' x0)\<close>]]
  1163       apply (subst (5) add.commute)
  1164       apply (rule abs_triangle_ineq)
  1165       done
  1166     also have "\<dots> \<le> ?diff_part + ?L_part + ?f'_part"
  1167       using abs_triangle_ineq4 by auto
  1168     also have "\<dots> < r /3 + r/3 + r/3"
  1169       using \<open>?diff_part < r/3\<close> \<open>?L_part \<le> r/3\<close> and \<open>?f'_part < r/3\<close>
  1170       by (rule add_strict_mono [OF add_less_le_mono])
  1171     finally show ?thesis
  1172       by auto
  1173   qed
  1174   then show "\<exists>s > 0. \<forall> x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow>
  1175       norm (((\<Sum>n. f (x0 + x) n) - (\<Sum>n. f x0 n)) / x - (\<Sum>n. f' x0 n)) < r"
  1176     using \<open>0 < S\<close> by auto
  1177 qed
  1178 
  1179 lemma DERIV_power_series':
  1180   fixes f :: "nat \<Rightarrow> real"
  1181   assumes converges: "\<And>x. x \<in> {-R <..< R} \<Longrightarrow> summable (\<lambda>n. f n * real (Suc n) * x^n)"
  1182     and x0_in_I: "x0 \<in> {-R <..< R}"
  1183     and "0 < R"
  1184   shows "DERIV (\<lambda>x. (\<Sum>n. f n * x^(Suc n))) x0 :> (\<Sum>n. f n * real (Suc n) * x0^n)"
  1185     (is "DERIV (\<lambda>x. suminf (?f x)) x0 :> suminf (?f' x0)")
  1186 proof -
  1187   have for_subinterval: "DERIV (\<lambda>x. suminf (?f x)) x0 :> suminf (?f' x0)"
  1188     if "0 < R'" and "R' < R" and "-R' < x0" and "x0 < R'" for R'
  1189   proof -
  1190     from that have "x0 \<in> {-R' <..< R'}" and "R' \<in> {-R <..< R}" and "x0 \<in> {-R <..< R}"
  1191       by auto
  1192     show ?thesis
  1193     proof (rule DERIV_series')
  1194       show "summable (\<lambda> n. \<bar>f n * real (Suc n) * R'^n\<bar>)"
  1195       proof -
  1196         have "(R' + R) / 2 < R" and "0 < (R' + R) / 2"
  1197           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by (auto simp: field_simps)
  1198         then have in_Rball: "(R' + R) / 2 \<in> {-R <..< R}"
  1199           using \<open>R' < R\<close> by auto
  1200         have "norm R' < norm ((R' + R) / 2)"
  1201           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by (auto simp: field_simps)
  1202         from powser_insidea[OF converges[OF in_Rball] this] show ?thesis
  1203           by auto
  1204       qed
  1205     next
  1206       fix n x y
  1207       assume "x \<in> {-R' <..< R'}" and "y \<in> {-R' <..< R'}"
  1208       show "\<bar>?f x n - ?f y n\<bar> \<le> \<bar>f n * real (Suc n) * R'^n\<bar> * \<bar>x-y\<bar>"
  1209       proof -
  1210         have "\<bar>f n * x ^ (Suc n) - f n * y ^ (Suc n)\<bar> =
  1211           (\<bar>f n\<bar> * \<bar>x-y\<bar>) * \<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar>"
  1212           unfolding right_diff_distrib[symmetric] diff_power_eq_sum abs_mult
  1213           by auto
  1214         also have "\<dots> \<le> (\<bar>f n\<bar> * \<bar>x-y\<bar>) * (\<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>)"
  1215         proof (rule mult_left_mono)
  1216           have "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> (\<Sum>p<Suc n. \<bar>x ^ p * y ^ (n - p)\<bar>)"
  1217             by (rule sum_abs)
  1218           also have "\<dots> \<le> (\<Sum>p<Suc n. R' ^ n)"
  1219           proof (rule sum_mono)
  1220             fix p
  1221             assume "p \<in> {..<Suc n}"
  1222             then have "p \<le> n" by auto
  1223             have "\<bar>x^n\<bar> \<le> R'^n" if  "x \<in> {-R'<..<R'}" for n and x :: real
  1224             proof -
  1225               from that have "\<bar>x\<bar> \<le> R'" by auto
  1226               then show ?thesis
  1227                 unfolding power_abs by (rule power_mono) auto
  1228             qed
  1229             from mult_mono[OF this[OF \<open>x \<in> {-R'<..<R'}\<close>, of p] this[OF \<open>y \<in> {-R'<..<R'}\<close>, of "n-p"]]
  1230               and \<open>0 < R'\<close>
  1231             have "\<bar>x^p * y^(n - p)\<bar> \<le> R'^p * R'^(n - p)"
  1232               unfolding abs_mult by auto
  1233             then show "\<bar>x^p * y^(n - p)\<bar> \<le> R'^n"
  1234               unfolding power_add[symmetric] using \<open>p \<le> n\<close> by auto
  1235           qed
  1236           also have "\<dots> = real (Suc n) * R' ^ n"
  1237             unfolding sum_constant card_atLeastLessThan by auto
  1238           finally show "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> \<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>"
  1239             unfolding abs_of_nonneg[OF zero_le_power[OF less_imp_le[OF \<open>0 < R'\<close>]]]
  1240             by linarith
  1241           show "0 \<le> \<bar>f n\<bar> * \<bar>x - y\<bar>"
  1242             unfolding abs_mult[symmetric] by auto
  1243         qed
  1244         also have "\<dots> = \<bar>f n * real (Suc n) * R' ^ n\<bar> * \<bar>x - y\<bar>"
  1245           unfolding abs_mult mult.assoc[symmetric] by algebra
  1246         finally show ?thesis .
  1247       qed
  1248     next
  1249       show "DERIV (\<lambda>x. ?f x n) x0 :> ?f' x0 n" for n
  1250         by (auto intro!: derivative_eq_intros simp del: power_Suc)
  1251     next
  1252       fix x
  1253       assume "x \<in> {-R' <..< R'}"
  1254       then have "R' \<in> {-R <..< R}" and "norm x < norm R'"
  1255         using assms \<open>R' < R\<close> by auto
  1256       have "summable (\<lambda>n. f n * x^n)"
  1257       proof (rule summable_comparison_test, intro exI allI impI)
  1258         fix n
  1259         have le: "\<bar>f n\<bar> * 1 \<le> \<bar>f n\<bar> * real (Suc n)"
  1260           by (rule mult_left_mono) auto
  1261         show "norm (f n * x^n) \<le> norm (f n * real (Suc n) * x^n)"
  1262           unfolding real_norm_def abs_mult
  1263           using le mult_right_mono by fastforce
  1264       qed (rule powser_insidea[OF converges[OF \<open>R' \<in> {-R <..< R}\<close>] \<open>norm x < norm R'\<close>])
  1265       from this[THEN summable_mult2[where c=x], simplified mult.assoc, simplified mult.commute]
  1266       show "summable (?f x)" by auto
  1267     next
  1268       show "summable (?f' x0)"
  1269         using converges[OF \<open>x0 \<in> {-R <..< R}\<close>] .
  1270       show "x0 \<in> {-R' <..< R'}"
  1271         using \<open>x0 \<in> {-R' <..< R'}\<close> .
  1272     qed
  1273   qed
  1274   let ?R = "(R + \<bar>x0\<bar>) / 2"
  1275   have "\<bar>x0\<bar> < ?R"
  1276     using assms by (auto simp: field_simps)
  1277   then have "- ?R < x0"
  1278   proof (cases "x0 < 0")
  1279     case True
  1280     then have "- x0 < ?R"
  1281       using \<open>\<bar>x0\<bar> < ?R\<close> by auto
  1282     then show ?thesis
  1283       unfolding neg_less_iff_less[symmetric, of "- x0"] by auto
  1284   next
  1285     case False
  1286     have "- ?R < 0" using assms by auto
  1287     also have "\<dots> \<le> x0" using False by auto
  1288     finally show ?thesis .
  1289   qed
  1290   then have "0 < ?R" "?R < R" "- ?R < x0" and "x0 < ?R"
  1291     using assms by (auto simp: field_simps)
  1292   from for_subinterval[OF this] show ?thesis .
  1293 qed
  1294 
  1295 lemma geometric_deriv_sums:
  1296   fixes z :: "'a :: {real_normed_field,banach}"
  1297   assumes "norm z < 1"
  1298   shows   "(\<lambda>n. of_nat (Suc n) * z ^ n) sums (1 / (1 - z)^2)"
  1299 proof -
  1300   have "(\<lambda>n. diffs (\<lambda>n. 1) n * z^n) sums (1 / (1 - z)^2)"
  1301   proof (rule termdiffs_sums_strong)
  1302     fix z :: 'a assume "norm z < 1"
  1303     thus "(\<lambda>n. 1 * z^n) sums (1 / (1 - z))" by (simp add: geometric_sums)
  1304   qed (insert assms, auto intro!: derivative_eq_intros simp: power2_eq_square)
  1305   thus ?thesis unfolding diffs_def by simp
  1306 qed
  1307 
  1308 lemma isCont_pochhammer [continuous_intros]: "isCont (\<lambda>z. pochhammer z n) z"
  1309   for z :: "'a::real_normed_field"
  1310   by (induct n) (auto simp: pochhammer_rec')
  1311 
  1312 lemma continuous_on_pochhammer [continuous_intros]: "continuous_on A (\<lambda>z. pochhammer z n)"
  1313   for A :: "'a::real_normed_field set"
  1314   by (intro continuous_at_imp_continuous_on ballI isCont_pochhammer)
  1315 
  1316 
  1317 subsection \<open>Exponential Function\<close>
  1318 
  1319 definition exp :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  1320   where "exp = (\<lambda>x. \<Sum>n. x^n /\<^sub>R fact n)"
  1321 
  1322 lemma summable_exp_generic:
  1323   fixes x :: "'a::{real_normed_algebra_1,banach}"
  1324   defines S_def: "S \<equiv> \<lambda>n. x^n /\<^sub>R fact n"
  1325   shows "summable S"
  1326 proof -
  1327   have S_Suc: "\<And>n. S (Suc n) = (x * S n) /\<^sub>R (Suc n)"
  1328     unfolding S_def by (simp del: mult_Suc)
  1329   obtain r :: real where r0: "0 < r" and r1: "r < 1"
  1330     using dense [OF zero_less_one] by fast
  1331   obtain N :: nat where N: "norm x < real N * r"
  1332     using ex_less_of_nat_mult r0 by auto
  1333   from r1 show ?thesis
  1334   proof (rule summable_ratio_test [rule_format])
  1335     fix n :: nat
  1336     assume n: "N \<le> n"
  1337     have "norm x \<le> real N * r"
  1338       using N by (rule order_less_imp_le)
  1339     also have "real N * r \<le> real (Suc n) * r"
  1340       using r0 n by (simp add: mult_right_mono)
  1341     finally have "norm x * norm (S n) \<le> real (Suc n) * r * norm (S n)"
  1342       using norm_ge_zero by (rule mult_right_mono)
  1343     then have "norm (x * S n) \<le> real (Suc n) * r * norm (S n)"
  1344       by (rule order_trans [OF norm_mult_ineq])
  1345     then have "norm (x * S n) / real (Suc n) \<le> r * norm (S n)"
  1346       by (simp add: pos_divide_le_eq ac_simps)
  1347     then show "norm (S (Suc n)) \<le> r * norm (S n)"
  1348       by (simp add: S_Suc inverse_eq_divide)
  1349   qed
  1350 qed
  1351 
  1352 lemma summable_norm_exp: "summable (\<lambda>n. norm (x^n /\<^sub>R fact n))"
  1353   for x :: "'a::{real_normed_algebra_1,banach}"
  1354 proof (rule summable_norm_comparison_test [OF exI, rule_format])
  1355   show "summable (\<lambda>n. norm x^n /\<^sub>R fact n)"
  1356     by (rule summable_exp_generic)
  1357   show "norm (x^n /\<^sub>R fact n) \<le> norm x^n /\<^sub>R fact n" for n
  1358     by (simp add: norm_power_ineq)
  1359 qed
  1360 
  1361 lemma summable_exp: "summable (\<lambda>n. inverse (fact n) * x^n)"
  1362   for x :: "'a::{real_normed_field,banach}"
  1363   using summable_exp_generic [where x=x]
  1364   by (simp add: scaleR_conv_of_real nonzero_of_real_inverse)
  1365 
  1366 lemma exp_converges: "(\<lambda>n. x^n /\<^sub>R fact n) sums exp x"
  1367   unfolding exp_def by (rule summable_exp_generic [THEN summable_sums])
  1368 
  1369 lemma exp_fdiffs:
  1370   "diffs (\<lambda>n. inverse (fact n)) = (\<lambda>n. inverse (fact n :: 'a::{real_normed_field,banach}))"
  1371   by (simp add: diffs_def mult_ac nonzero_inverse_mult_distrib nonzero_of_real_inverse
  1372       del: mult_Suc of_nat_Suc)
  1373 
  1374 lemma diffs_of_real: "diffs (\<lambda>n. of_real (f n)) = (\<lambda>n. of_real (diffs f n))"
  1375   by (simp add: diffs_def)
  1376 
  1377 lemma DERIV_exp [simp]: "DERIV exp x :> exp x"
  1378   unfolding exp_def scaleR_conv_of_real
  1379   apply (rule DERIV_cong)
  1380    apply (rule termdiffs [where K="of_real (1 + norm x)"])
  1381       apply (simp_all only: diffs_of_real scaleR_conv_of_real exp_fdiffs)
  1382      apply (rule exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real])+
  1383   apply (simp del: of_real_add)
  1384   done
  1385 
  1386 declare DERIV_exp[THEN DERIV_chain2, derivative_intros]
  1387   and DERIV_exp[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  1388 
  1389 lemma norm_exp: "norm (exp x) \<le> exp (norm x)"
  1390 proof -
  1391   from summable_norm[OF summable_norm_exp, of x]
  1392   have "norm (exp x) \<le> (\<Sum>n. inverse (fact n) * norm (x^n))"
  1393     by (simp add: exp_def)
  1394   also have "\<dots> \<le> exp (norm x)"
  1395     using summable_exp_generic[of "norm x"] summable_norm_exp[of x]
  1396     by (auto simp: exp_def intro!: suminf_le norm_power_ineq)
  1397   finally show ?thesis .
  1398 qed
  1399 
  1400 lemma isCont_exp: "isCont exp x"
  1401   for x :: "'a::{real_normed_field,banach}"
  1402   by (rule DERIV_exp [THEN DERIV_isCont])
  1403 
  1404 lemma isCont_exp' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. exp (f x)) a"
  1405   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1406   by (rule isCont_o2 [OF _ isCont_exp])
  1407 
  1408 lemma tendsto_exp [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. exp (f x)) \<longlongrightarrow> exp a) F"
  1409   for f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1410   by (rule isCont_tendsto_compose [OF isCont_exp])
  1411 
  1412 lemma continuous_exp [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. exp (f x))"
  1413   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1414   unfolding continuous_def by (rule tendsto_exp)
  1415 
  1416 lemma continuous_on_exp [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. exp (f x))"
  1417   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
  1418   unfolding continuous_on_def by (auto intro: tendsto_exp)
  1419 
  1420 
  1421 subsubsection \<open>Properties of the Exponential Function\<close>
  1422 
  1423 lemma exp_zero [simp]: "exp 0 = 1"
  1424   unfolding exp_def by (simp add: scaleR_conv_of_real)
  1425 
  1426 lemma exp_series_add_commuting:
  1427   fixes x y :: "'a::{real_normed_algebra_1,banach}"
  1428   defines S_def: "S \<equiv> \<lambda>x n. x^n /\<^sub>R fact n"
  1429   assumes comm: "x * y = y * x"
  1430   shows "S (x + y) n = (\<Sum>i\<le>n. S x i * S y (n - i))"
  1431 proof (induct n)
  1432   case 0
  1433   show ?case
  1434     unfolding S_def by simp
  1435 next
  1436   case (Suc n)
  1437   have S_Suc: "\<And>x n. S x (Suc n) = (x * S x n) /\<^sub>R real (Suc n)"
  1438     unfolding S_def by (simp del: mult_Suc)
  1439   then have times_S: "\<And>x n. x * S x n = real (Suc n) *\<^sub>R S x (Suc n)"
  1440     by simp
  1441   have S_comm: "\<And>n. S x n * y = y * S x n"
  1442     by (simp add: power_commuting_commutes comm S_def)
  1443 
  1444   have "real (Suc n) *\<^sub>R S (x + y) (Suc n) = (x + y) * S (x + y) n"
  1445     by (simp only: times_S)
  1446   also have "\<dots> = (x + y) * (\<Sum>i\<le>n. S x i * S y (n - i))"
  1447     by (simp only: Suc)
  1448   also have "\<dots> = x * (\<Sum>i\<le>n. S x i * S y (n - i)) + y * (\<Sum>i\<le>n. S x i * S y (n - i))"
  1449     by (rule distrib_right)
  1450   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n - i)) + (\<Sum>i\<le>n. S x i * y * S y (n - i))"
  1451     by (simp add: sum_distrib_left ac_simps S_comm)
  1452   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n - i)) + (\<Sum>i\<le>n. S x i * (y * S y (n - i)))"
  1453     by (simp add: ac_simps)
  1454   also have "\<dots> = (\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n - i))) +
  1455       (\<Sum>i\<le>n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))"
  1456     by (simp add: times_S Suc_diff_le)
  1457   also have "(\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n - i))) =
  1458       (\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n - i)))"
  1459     by (subst sum_atMost_Suc_shift) simp
  1460   also have "(\<Sum>i\<le>n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i))) =
  1461       (\<Sum>i\<le>Suc n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))"
  1462     by simp
  1463   also have "(\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n - i))) +
  1464         (\<Sum>i\<le>Suc n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i))) =
  1465       (\<Sum>i\<le>Suc n. real (Suc n) *\<^sub>R (S x i * S y (Suc n - i)))"
  1466     by (simp only: sum.distrib [symmetric] scaleR_left_distrib [symmetric]
  1467         of_nat_add [symmetric]) simp
  1468   also have "\<dots> = real (Suc n) *\<^sub>R (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
  1469     by (simp only: scaleR_right.sum)
  1470   finally show "S (x + y) (Suc n) = (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
  1471     by (simp del: sum_cl_ivl_Suc)
  1472 qed
  1473 
  1474 lemma exp_add_commuting: "x * y = y * x \<Longrightarrow> exp (x + y) = exp x * exp y"
  1475   by (simp only: exp_def Cauchy_product summable_norm_exp exp_series_add_commuting)
  1476 
  1477 lemma exp_times_arg_commute: "exp A * A = A * exp A"
  1478   by (simp add: exp_def suminf_mult[symmetric] summable_exp_generic power_commutes suminf_mult2)
  1479 
  1480 lemma exp_add: "exp (x + y) = exp x * exp y"
  1481   for x y :: "'a::{real_normed_field,banach}"
  1482   by (rule exp_add_commuting) (simp add: ac_simps)
  1483 
  1484 lemma exp_double: "exp(2 * z) = exp z ^ 2"
  1485   by (simp add: exp_add_commuting mult_2 power2_eq_square)
  1486 
  1487 lemmas mult_exp_exp = exp_add [symmetric]
  1488 
  1489 lemma exp_of_real: "exp (of_real x) = of_real (exp x)"
  1490   unfolding exp_def
  1491   apply (subst suminf_of_real)
  1492    apply (rule summable_exp_generic)
  1493   apply (simp add: scaleR_conv_of_real)
  1494   done
  1495 
  1496 lemmas of_real_exp = exp_of_real[symmetric]
  1497 
  1498 corollary exp_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> exp z \<in> \<real>"
  1499   by (metis Reals_cases Reals_of_real exp_of_real)
  1500 
  1501 lemma exp_not_eq_zero [simp]: "exp x \<noteq> 0"
  1502 proof
  1503   have "exp x * exp (- x) = 1"
  1504     by (simp add: exp_add_commuting[symmetric])
  1505   also assume "exp x = 0"
  1506   finally show False by simp
  1507 qed
  1508 
  1509 lemma exp_minus_inverse [simp]: "exp x * exp (- x) = 1"
  1510   by (simp add: exp_add_commuting[symmetric])
  1511 
  1512 lemma exp_minus: "exp (- x) = inverse (exp x)"
  1513   for x :: "'a::{real_normed_field,banach}"
  1514   by (intro inverse_unique [symmetric] exp_minus_inverse)
  1515 
  1516 lemma exp_diff: "exp (x - y) = exp x / exp y"
  1517   for x :: "'a::{real_normed_field,banach}"
  1518   using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)
  1519 
  1520 lemma exp_of_nat_mult [simp]: "exp (of_nat n * x) = exp x ^ n"
  1521   for x :: "'a::{real_normed_field,banach}"
  1522   by (induct n) (auto simp add: distrib_left exp_add mult.commute)
  1523 
  1524 corollary exp_of_nat2_mult [simp]: "exp (x * of_nat n) = exp x ^ n"
  1525   for x :: "'a::{real_normed_field,banach}"
  1526   by (metis exp_of_nat_mult mult_of_nat_commute)
  1527 
  1528 lemma exp_sum: "finite I \<Longrightarrow> exp (sum f I) = prod (\<lambda>x. exp (f x)) I"
  1529   by (induct I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)
  1530 
  1531 lemma exp_divide_power_eq [simp]:
  1532   fixes x :: "'a::{real_normed_field,banach}"
  1533   assumes "n > 0"
  1534   shows "exp (x / of_nat n) ^ n = exp x"
  1535   using assms
  1536 proof (induction n arbitrary: x)
  1537   case 0
  1538   then show ?case by simp
  1539 next
  1540   case (Suc n)
  1541   show ?case
  1542   proof (cases "n = 0")
  1543     case True
  1544     then show ?thesis by simp
  1545   next
  1546     case False
  1547     then have [simp]: "x * of_nat n / (1 + of_nat n) / of_nat n = x / (1 + of_nat n)"
  1548       by simp
  1549     have [simp]: "x / (1 + of_nat n) + x * of_nat n / (1 + of_nat n) = x"
  1550       apply (simp add: divide_simps)
  1551       using of_nat_eq_0_iff apply (fastforce simp: distrib_left)
  1552       done
  1553     show ?thesis
  1554       using Suc.IH [of "x * of_nat n / (1 + of_nat n)"] False
  1555       by (simp add: exp_add [symmetric])
  1556   qed
  1557 qed
  1558 
  1559 
  1560 subsubsection \<open>Properties of the Exponential Function on Reals\<close>
  1561 
  1562 text \<open>Comparisons of @{term "exp x"} with zero.\<close>
  1563 
  1564 text \<open>Proof: because every exponential can be seen as a square.\<close>
  1565 lemma exp_ge_zero [simp]: "0 \<le> exp x"
  1566   for x :: real
  1567 proof -
  1568   have "0 \<le> exp (x/2) * exp (x/2)"
  1569     by simp
  1570   then show ?thesis
  1571     by (simp add: exp_add [symmetric])
  1572 qed
  1573 
  1574 lemma exp_gt_zero [simp]: "0 < exp x"
  1575   for x :: real
  1576   by (simp add: order_less_le)
  1577 
  1578 lemma not_exp_less_zero [simp]: "\<not> exp x < 0"
  1579   for x :: real
  1580   by (simp add: not_less)
  1581 
  1582 lemma not_exp_le_zero [simp]: "\<not> exp x \<le> 0"
  1583   for x :: real
  1584   by (simp add: not_le)
  1585 
  1586 lemma abs_exp_cancel [simp]: "\<bar>exp x\<bar> = exp x"
  1587   for x :: real
  1588   by simp
  1589 
  1590 text \<open>Strict monotonicity of exponential.\<close>
  1591 
  1592 lemma exp_ge_add_one_self_aux:
  1593   fixes x :: real
  1594   assumes "0 \<le> x"
  1595   shows "1 + x \<le> exp x"
  1596   using order_le_imp_less_or_eq [OF assms]
  1597 proof
  1598   assume "0 < x"
  1599   have "1 + x \<le> (\<Sum>n<2. inverse (fact n) * x^n)"
  1600     by (auto simp add: numeral_2_eq_2)
  1601   also have "\<dots> \<le> (\<Sum>n. inverse (fact n) * x^n)"
  1602     apply (rule sum_le_suminf [OF summable_exp])
  1603     using \<open>0 < x\<close>
  1604     apply (auto  simp add:  zero_le_mult_iff)
  1605     done
  1606   finally show "1 + x \<le> exp x"
  1607     by (simp add: exp_def)
  1608 next
  1609   assume "0 = x"
  1610   then show "1 + x \<le> exp x"
  1611     by auto
  1612 qed
  1613 
  1614 lemma exp_gt_one: "0 < x \<Longrightarrow> 1 < exp x"
  1615   for x :: real
  1616 proof -
  1617   assume x: "0 < x"
  1618   then have "1 < 1 + x" by simp
  1619   also from x have "1 + x \<le> exp x"
  1620     by (simp add: exp_ge_add_one_self_aux)
  1621   finally show ?thesis .
  1622 qed
  1623 
  1624 lemma exp_less_mono:
  1625   fixes x y :: real
  1626   assumes "x < y"
  1627   shows "exp x < exp y"
  1628 proof -
  1629   from \<open>x < y\<close> have "0 < y - x" by simp
  1630   then have "1 < exp (y - x)" by (rule exp_gt_one)
  1631   then have "1 < exp y / exp x" by (simp only: exp_diff)
  1632   then show "exp x < exp y" by simp
  1633 qed
  1634 
  1635 lemma exp_less_cancel: "exp x < exp y \<Longrightarrow> x < y"
  1636   for x y :: real
  1637   unfolding linorder_not_le [symmetric]
  1638   by (auto simp add: order_le_less exp_less_mono)
  1639 
  1640 lemma exp_less_cancel_iff [iff]: "exp x < exp y \<longleftrightarrow> x < y"
  1641   for x y :: real
  1642   by (auto intro: exp_less_mono exp_less_cancel)
  1643 
  1644 lemma exp_le_cancel_iff [iff]: "exp x \<le> exp y \<longleftrightarrow> x \<le> y"
  1645   for x y :: real
  1646   by (auto simp add: linorder_not_less [symmetric])
  1647 
  1648 lemma exp_inj_iff [iff]: "exp x = exp y \<longleftrightarrow> x = y"
  1649   for x y :: real
  1650   by (simp add: order_eq_iff)
  1651 
  1652 text \<open>Comparisons of @{term "exp x"} with one.\<close>
  1653 
  1654 lemma one_less_exp_iff [simp]: "1 < exp x \<longleftrightarrow> 0 < x"
  1655   for x :: real
  1656   using exp_less_cancel_iff [where x = 0 and y = x] by simp
  1657 
  1658 lemma exp_less_one_iff [simp]: "exp x < 1 \<longleftrightarrow> x < 0"
  1659   for x :: real
  1660   using exp_less_cancel_iff [where x = x and y = 0] by simp
  1661 
  1662 lemma one_le_exp_iff [simp]: "1 \<le> exp x \<longleftrightarrow> 0 \<le> x"
  1663   for x :: real
  1664   using exp_le_cancel_iff [where x = 0 and y = x] by simp
  1665 
  1666 lemma exp_le_one_iff [simp]: "exp x \<le> 1 \<longleftrightarrow> x \<le> 0"
  1667   for x :: real
  1668   using exp_le_cancel_iff [where x = x and y = 0] by simp
  1669 
  1670 lemma exp_eq_one_iff [simp]: "exp x = 1 \<longleftrightarrow> x = 0"
  1671   for x :: real
  1672   using exp_inj_iff [where x = x and y = 0] by simp
  1673 
  1674 lemma lemma_exp_total: "1 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x \<le> y - 1 \<and> exp x = y"
  1675   for y :: real
  1676 proof (rule IVT)
  1677   assume "1 \<le> y"
  1678   then have "0 \<le> y - 1" by simp
  1679   then have "1 + (y - 1) \<le> exp (y - 1)"
  1680     by (rule exp_ge_add_one_self_aux)
  1681   then show "y \<le> exp (y - 1)" by simp
  1682 qed (simp_all add: le_diff_eq)
  1683 
  1684 lemma exp_total: "0 < y \<Longrightarrow> \<exists>x. exp x = y"
  1685   for y :: real
  1686 proof (rule linorder_le_cases [of 1 y])
  1687   assume "1 \<le> y"
  1688   then show "\<exists>x. exp x = y"
  1689     by (fast dest: lemma_exp_total)
  1690 next
  1691   assume "0 < y" and "y \<le> 1"
  1692   then have "1 \<le> inverse y"
  1693     by (simp add: one_le_inverse_iff)
  1694   then obtain x where "exp x = inverse y"
  1695     by (fast dest: lemma_exp_total)
  1696   then have "exp (- x) = y"
  1697     by (simp add: exp_minus)
  1698   then show "\<exists>x. exp x = y" ..
  1699 qed
  1700 
  1701 
  1702 subsection \<open>Natural Logarithm\<close>
  1703 
  1704 class ln = real_normed_algebra_1 + banach +
  1705   fixes ln :: "'a \<Rightarrow> 'a"
  1706   assumes ln_one [simp]: "ln 1 = 0"
  1707 
  1708 definition powr :: "'a \<Rightarrow> 'a \<Rightarrow> 'a::ln"  (infixr "powr" 80)
  1709   \<comment> \<open>exponentation via ln and exp\<close>
  1710   where  [code del]: "x powr a \<equiv> if x = 0 then 0 else exp (a * ln x)"
  1711 
  1712 lemma powr_0 [simp]: "0 powr z = 0"
  1713   by (simp add: powr_def)
  1714 
  1715 
  1716 instantiation real :: ln
  1717 begin
  1718 
  1719 definition ln_real :: "real \<Rightarrow> real"
  1720   where "ln_real x = (THE u. exp u = x)"
  1721 
  1722 instance
  1723   by intro_classes (simp add: ln_real_def)
  1724 
  1725 end
  1726 
  1727 lemma powr_eq_0_iff [simp]: "w powr z = 0 \<longleftrightarrow> w = 0"
  1728   by (simp add: powr_def)
  1729 
  1730 lemma ln_exp [simp]: "ln (exp x) = x"
  1731   for x :: real
  1732   by (simp add: ln_real_def)
  1733 
  1734 lemma exp_ln [simp]: "0 < x \<Longrightarrow> exp (ln x) = x"
  1735   for x :: real
  1736   by (auto dest: exp_total)
  1737 
  1738 lemma exp_ln_iff [simp]: "exp (ln x) = x \<longleftrightarrow> 0 < x"
  1739   for x :: real
  1740   by (metis exp_gt_zero exp_ln)
  1741 
  1742 lemma ln_unique: "exp y = x \<Longrightarrow> ln x = y"
  1743   for x :: real
  1744   by (erule subst) (rule ln_exp)
  1745 
  1746 lemma ln_mult [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x * y) = ln x + ln y"
  1747   for x :: real
  1748   by (rule ln_unique) (simp add: exp_add)
  1749 
  1750 lemma ln_prod: "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i > 0) \<Longrightarrow> ln (prod f I) = sum (\<lambda>x. ln(f x)) I"
  1751   for f :: "'a \<Rightarrow> real"
  1752   by (induct I rule: finite_induct) (auto simp: ln_mult prod_pos)
  1753 
  1754 lemma ln_inverse [simp]: "0 < x \<Longrightarrow> ln (inverse x) = - ln x"
  1755   for x :: real
  1756   by (rule ln_unique) (simp add: exp_minus)
  1757 
  1758 lemma ln_div: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x / y) = ln x - ln y"
  1759   for x :: real
  1760   by (rule ln_unique) (simp add: exp_diff)
  1761 
  1762 lemma ln_realpow [simp]: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
  1763   by (rule ln_unique) simp
  1764 
  1765 lemma ln_less_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x < ln y \<longleftrightarrow> x < y"
  1766   for x :: real
  1767   by (subst exp_less_cancel_iff [symmetric]) simp
  1768 
  1769 lemma ln_le_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x \<le> ln y \<longleftrightarrow> x \<le> y"
  1770   for x :: real
  1771   by (simp add: linorder_not_less [symmetric])
  1772 
  1773 lemma ln_inj_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x = ln y \<longleftrightarrow> x = y"
  1774   for x :: real
  1775   by (simp add: order_eq_iff)
  1776 
  1777 lemma ln_add_one_self_le_self [simp]: "0 \<le> x \<Longrightarrow> ln (1 + x) \<le> x"
  1778   for x :: real
  1779   by (rule exp_le_cancel_iff [THEN iffD1]) (simp add: exp_ge_add_one_self_aux)
  1780 
  1781 lemma ln_less_self [simp]: "0 < x \<Longrightarrow> ln x < x"
  1782   for x :: real
  1783   by (rule order_less_le_trans [where y = "ln (1 + x)"]) simp_all
  1784 
  1785 lemma ln_ge_iff: "\<And>x::real. 0 < x \<Longrightarrow> y \<le> ln x \<longleftrightarrow> exp y \<le> x"
  1786   using exp_le_cancel_iff exp_total by force
  1787 
  1788 lemma ln_ge_zero [simp]: "1 \<le> x \<Longrightarrow> 0 \<le> ln x"
  1789   for x :: real
  1790   using ln_le_cancel_iff [of 1 x] by simp
  1791 
  1792 lemma ln_ge_zero_imp_ge_one: "0 \<le> ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> x"
  1793   for x :: real
  1794   using ln_le_cancel_iff [of 1 x] by simp
  1795 
  1796 lemma ln_ge_zero_iff [simp]: "0 < x \<Longrightarrow> 0 \<le> ln x \<longleftrightarrow> 1 \<le> x"
  1797   for x :: real
  1798   using ln_le_cancel_iff [of 1 x] by simp
  1799 
  1800 lemma ln_less_zero_iff [simp]: "0 < x \<Longrightarrow> ln x < 0 \<longleftrightarrow> x < 1"
  1801   for x :: real
  1802   using ln_less_cancel_iff [of x 1] by simp
  1803 
  1804 lemma ln_le_zero_iff [simp]: "0 < x \<Longrightarrow> ln x \<le> 0 \<longleftrightarrow> x \<le> 1"
  1805   for x :: real
  1806   by (metis less_numeral_extra(1) ln_le_cancel_iff ln_one)
  1807 
  1808 lemma ln_gt_zero: "1 < x \<Longrightarrow> 0 < ln x"
  1809   for x :: real
  1810   using ln_less_cancel_iff [of 1 x] by simp
  1811 
  1812 lemma ln_gt_zero_imp_gt_one: "0 < ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 < x"
  1813   for x :: real
  1814   using ln_less_cancel_iff [of 1 x] by simp
  1815 
  1816 lemma ln_gt_zero_iff [simp]: "0 < x \<Longrightarrow> 0 < ln x \<longleftrightarrow> 1 < x"
  1817   for x :: real
  1818   using ln_less_cancel_iff [of 1 x] by simp
  1819 
  1820 lemma ln_eq_zero_iff [simp]: "0 < x \<Longrightarrow> ln x = 0 \<longleftrightarrow> x = 1"
  1821   for x :: real
  1822   using ln_inj_iff [of x 1] by simp
  1823 
  1824 lemma ln_less_zero: "0 < x \<Longrightarrow> x < 1 \<Longrightarrow> ln x < 0"
  1825   for x :: real
  1826   by simp
  1827 
  1828 lemma ln_neg_is_const: "x \<le> 0 \<Longrightarrow> ln x = (THE x. False)"
  1829   for x :: real
  1830   by (auto simp: ln_real_def intro!: arg_cong[where f = The])
  1831 
  1832 lemma isCont_ln:
  1833   fixes x :: real
  1834   assumes "x \<noteq> 0"
  1835   shows "isCont ln x"
  1836 proof (cases "0 < x")
  1837   case True
  1838   then have "isCont ln (exp (ln x))"
  1839     by (intro isCont_inv_fun[where d = "\<bar>x\<bar>" and f = exp]) auto
  1840   with True show ?thesis
  1841     by simp
  1842 next
  1843   case False
  1844   with \<open>x \<noteq> 0\<close> show "isCont ln x"
  1845     unfolding isCont_def
  1846     by (subst filterlim_cong[OF _ refl, of _ "nhds (ln 0)" _ "\<lambda>_. ln 0"])
  1847        (auto simp: ln_neg_is_const not_less eventually_at dist_real_def
  1848          intro!: exI[of _ "\<bar>x\<bar>"])
  1849 qed
  1850 
  1851 lemma tendsto_ln [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. ln (f x)) \<longlongrightarrow> ln a) F"
  1852   for a :: real
  1853   by (rule isCont_tendsto_compose [OF isCont_ln])
  1854 
  1855 lemma continuous_ln:
  1856   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. ln (f x :: real))"
  1857   unfolding continuous_def by (rule tendsto_ln)
  1858 
  1859 lemma isCont_ln' [continuous_intros]:
  1860   "continuous (at x) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x) (\<lambda>x. ln (f x :: real))"
  1861   unfolding continuous_at by (rule tendsto_ln)
  1862 
  1863 lemma continuous_within_ln [continuous_intros]:
  1864   "continuous (at x within s) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. ln (f x :: real))"
  1865   unfolding continuous_within by (rule tendsto_ln)
  1866 
  1867 lemma continuous_on_ln [continuous_intros]:
  1868   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. f x \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. ln (f x :: real))"
  1869   unfolding continuous_on_def by (auto intro: tendsto_ln)
  1870 
  1871 lemma DERIV_ln: "0 < x \<Longrightarrow> DERIV ln x :> inverse x"
  1872   for x :: real
  1873   by (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
  1874     (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)
  1875 
  1876 lemma DERIV_ln_divide: "0 < x \<Longrightarrow> DERIV ln x :> 1 / x"
  1877   for x :: real
  1878   by (rule DERIV_ln[THEN DERIV_cong]) (simp_all add: divide_inverse)
  1879 
  1880 declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
  1881   and DERIV_ln_divide[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  1882 
  1883 lemma ln_series:
  1884   assumes "0 < x" and "x < 2"
  1885   shows "ln x = (\<Sum> n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
  1886     (is "ln x = suminf (?f (x - 1))")
  1887 proof -
  1888   let ?f' = "\<lambda>x n. (-1)^n * (x - 1)^n"
  1889 
  1890   have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
  1891   proof (rule DERIV_isconst3 [where x = x])
  1892     fix x :: real
  1893     assume "x \<in> {0 <..< 2}"
  1894     then have "0 < x" and "x < 2" by auto
  1895     have "norm (1 - x) < 1"
  1896       using \<open>0 < x\<close> and \<open>x < 2\<close> by auto
  1897     have "1 / x = 1 / (1 - (1 - x))" by auto
  1898     also have "\<dots> = (\<Sum> n. (1 - x)^n)"
  1899       using geometric_sums[OF \<open>norm (1 - x) < 1\<close>] by (rule sums_unique)
  1900     also have "\<dots> = suminf (?f' x)"
  1901       unfolding power_mult_distrib[symmetric]
  1902       by (rule arg_cong[where f=suminf], rule arg_cong[where f="op ^"], auto)
  1903     finally have "DERIV ln x :> suminf (?f' x)"
  1904       using DERIV_ln[OF \<open>0 < x\<close>] unfolding divide_inverse by auto
  1905     moreover
  1906     have repos: "\<And> h x :: real. h - 1 + x = h + x - 1" by auto
  1907     have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :>
  1908       (\<Sum>n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
  1909     proof (rule DERIV_power_series')
  1910       show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1"
  1911         using \<open>0 < x\<close> \<open>x < 2\<close> by auto
  1912     next
  1913       fix x :: real
  1914       assume "x \<in> {- 1<..<1}"
  1915       then have "norm (-x) < 1" by auto
  1916       show "summable (\<lambda>n. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
  1917         unfolding One_nat_def
  1918         by (auto simp add: power_mult_distrib[symmetric] summable_geometric[OF \<open>norm (-x) < 1\<close>])
  1919     qed
  1920     then have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)"
  1921       unfolding One_nat_def by auto
  1922     then have "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)"
  1923       unfolding DERIV_def repos .
  1924     ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> suminf (?f' x) - suminf (?f' x)"
  1925       by (rule DERIV_diff)
  1926     then show "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> 0" by auto
  1927   qed (auto simp add: assms)
  1928   then show ?thesis by auto
  1929 qed
  1930 
  1931 lemma exp_first_terms:
  1932   fixes x :: "'a::{real_normed_algebra_1,banach}"
  1933   shows "exp x = (\<Sum>n<k. inverse(fact n) *\<^sub>R (x ^ n)) + (\<Sum>n. inverse(fact (n + k)) *\<^sub>R (x ^ (n + k)))"
  1934 proof -
  1935   have "exp x = suminf (\<lambda>n. inverse(fact n) *\<^sub>R (x^n))"
  1936     by (simp add: exp_def)
  1937   also from summable_exp_generic have "\<dots> = (\<Sum> n. inverse(fact(n+k)) *\<^sub>R (x ^ (n + k))) +
  1938     (\<Sum> n::nat<k. inverse(fact n) *\<^sub>R (x^n))" (is "_ = _ + ?a")
  1939     by (rule suminf_split_initial_segment)
  1940   finally show ?thesis by simp
  1941 qed
  1942 
  1943 lemma exp_first_term: "exp x = 1 + (\<Sum>n. inverse (fact (Suc n)) *\<^sub>R (x ^ Suc n))"
  1944   for x :: "'a::{real_normed_algebra_1,banach}"
  1945   using exp_first_terms[of x 1] by simp
  1946 
  1947 lemma exp_first_two_terms: "exp x = 1 + x + (\<Sum>n. inverse (fact (n + 2)) *\<^sub>R (x ^ (n + 2)))"
  1948   for x :: "'a::{real_normed_algebra_1,banach}"
  1949   using exp_first_terms[of x 2] by (simp add: eval_nat_numeral)
  1950 
  1951 lemma exp_bound:
  1952   fixes x :: real
  1953   assumes a: "0 \<le> x"
  1954     and b: "x \<le> 1"
  1955   shows "exp x \<le> 1 + x + x\<^sup>2"
  1956 proof -
  1957   have aux1: "inverse (fact (n + 2)) * x ^ (n + 2) \<le> (x\<^sup>2/2) * ((1/2)^n)" for n :: nat
  1958   proof -
  1959     have "(2::nat) * 2 ^ n \<le> fact (n + 2)"
  1960       by (induct n) simp_all
  1961     then have "real ((2::nat) * 2 ^ n) \<le> real_of_nat (fact (n + 2))"
  1962       by (simp only: of_nat_le_iff)
  1963     then have "((2::real) * 2 ^ n) \<le> fact (n + 2)"
  1964       unfolding of_nat_fact by simp
  1965     then have "inverse (fact (n + 2)) \<le> inverse ((2::real) * 2 ^ n)"
  1966       by (rule le_imp_inverse_le) simp
  1967     then have "inverse (fact (n + 2)) \<le> 1/(2::real) * (1/2)^n"
  1968       by (simp add: power_inverse [symmetric])
  1969     then have "inverse (fact (n + 2)) * (x^n * x\<^sup>2) \<le> 1/2 * (1/2)^n * (1 * x\<^sup>2)"
  1970       by (rule mult_mono) (rule mult_mono, simp_all add: power_le_one a b)
  1971     then show ?thesis
  1972       unfolding power_add by (simp add: ac_simps del: fact_Suc)
  1973   qed
  1974   have "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1 / 2)))"
  1975     by (intro sums_mult geometric_sums) simp
  1976   then have aux2: "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums x\<^sup>2"
  1977     by simp
  1978   have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> x\<^sup>2"
  1979   proof -
  1980     have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> suminf (\<lambda>n. (x\<^sup>2/2) * ((1/2)^n))"
  1981       apply (rule suminf_le)
  1982         apply (rule allI)
  1983         apply (rule aux1)
  1984        apply (rule summable_exp [THEN summable_ignore_initial_segment])
  1985       apply (rule sums_summable)
  1986       apply (rule aux2)
  1987       done
  1988     also have "\<dots> = x\<^sup>2"
  1989       by (rule sums_unique [THEN sym]) (rule aux2)
  1990     finally show ?thesis .
  1991   qed
  1992   then show ?thesis
  1993     unfolding exp_first_two_terms by auto
  1994 qed
  1995 
  1996 corollary exp_half_le2: "exp(1/2) \<le> (2::real)"
  1997   using exp_bound [of "1/2"]
  1998   by (simp add: field_simps)
  1999 
  2000 corollary exp_le: "exp 1 \<le> (3::real)"
  2001   using exp_bound [of 1]
  2002   by (simp add: field_simps)
  2003 
  2004 lemma exp_bound_half: "norm z \<le> 1/2 \<Longrightarrow> norm (exp z) \<le> 2"
  2005   by (blast intro: order_trans intro!: exp_half_le2 norm_exp)
  2006 
  2007 lemma exp_bound_lemma:
  2008   assumes "norm z \<le> 1/2"
  2009   shows "norm (exp z) \<le> 1 + 2 * norm z"
  2010 proof -
  2011   have *: "(norm z)\<^sup>2 \<le> norm z * 1"
  2012     unfolding power2_eq_square
  2013     apply (rule mult_left_mono)
  2014     using assms
  2015      apply auto
  2016     done
  2017   show ?thesis
  2018     apply (rule order_trans [OF norm_exp])
  2019     apply (rule order_trans [OF exp_bound])
  2020     using assms *
  2021       apply auto
  2022     done
  2023 qed
  2024 
  2025 lemma real_exp_bound_lemma: "0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> exp x \<le> 1 + 2 * x"
  2026   for x :: real
  2027   using exp_bound_lemma [of x] by simp
  2028 
  2029 lemma ln_one_minus_pos_upper_bound:
  2030   fixes x :: real
  2031   assumes a: "0 \<le> x" and b: "x < 1"
  2032   shows "ln (1 - x) \<le> - x"
  2033 proof -
  2034   have "(1 - x) * (1 + x + x\<^sup>2) = 1 - x^3"
  2035     by (simp add: algebra_simps power2_eq_square power3_eq_cube)
  2036   also have "\<dots> \<le> 1"
  2037     by (auto simp add: a)
  2038   finally have "(1 - x) * (1 + x + x\<^sup>2) \<le> 1" .
  2039   moreover have c: "0 < 1 + x + x\<^sup>2"
  2040     by (simp add: add_pos_nonneg a)
  2041   ultimately have "1 - x \<le> 1 / (1 + x + x\<^sup>2)"
  2042     by (elim mult_imp_le_div_pos)
  2043   also have "\<dots> \<le> 1 / exp x"
  2044     by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
  2045         real_sqrt_pow2_iff real_sqrt_power)
  2046   also have "\<dots> = exp (- x)"
  2047     by (auto simp add: exp_minus divide_inverse)
  2048   finally have "1 - x \<le> exp (- x)" .
  2049   also have "1 - x = exp (ln (1 - x))"
  2050     by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
  2051   finally have "exp (ln (1 - x)) \<le> exp (- x)" .
  2052   then show ?thesis
  2053     by (auto simp only: exp_le_cancel_iff)
  2054 qed
  2055 
  2056 lemma exp_ge_add_one_self [simp]: "1 + x \<le> exp x"
  2057   for x :: real
  2058   apply (cases "0 \<le> x")
  2059    apply (erule exp_ge_add_one_self_aux)
  2060   apply (cases "x \<le> -1")
  2061    apply (subgoal_tac "1 + x \<le> 0")
  2062     apply (erule order_trans)
  2063     apply simp
  2064    apply simp
  2065   apply (subgoal_tac "1 + x = exp (ln (1 + x))")
  2066    apply (erule ssubst)
  2067    apply (subst exp_le_cancel_iff)
  2068    apply (subgoal_tac "ln (1 - (- x)) \<le> - (- x)")
  2069     apply simp
  2070    apply (rule ln_one_minus_pos_upper_bound)
  2071     apply auto
  2072   done
  2073 
  2074 lemma ln_one_plus_pos_lower_bound:
  2075   fixes x :: real
  2076   assumes a: "0 \<le> x" and b: "x \<le> 1"
  2077   shows "x - x\<^sup>2 \<le> ln (1 + x)"
  2078 proof -
  2079   have "exp (x - x\<^sup>2) = exp x / exp (x\<^sup>2)"
  2080     by (rule exp_diff)
  2081   also have "\<dots> \<le> (1 + x + x\<^sup>2) / exp (x \<^sup>2)"
  2082     by (metis a b divide_right_mono exp_bound exp_ge_zero)
  2083   also have "\<dots> \<le> (1 + x + x\<^sup>2) / (1 + x\<^sup>2)"
  2084     by (simp add: a divide_left_mono add_pos_nonneg)
  2085   also from a have "\<dots> \<le> 1 + x"
  2086     by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
  2087   finally have "exp (x - x\<^sup>2) \<le> 1 + x" .
  2088   also have "\<dots> = exp (ln (1 + x))"
  2089   proof -
  2090     from a have "0 < 1 + x" by auto
  2091     then show ?thesis
  2092       by (auto simp only: exp_ln_iff [THEN sym])
  2093   qed
  2094   finally have "exp (x - x\<^sup>2) \<le> exp (ln (1 + x))" .
  2095   then show ?thesis
  2096     by (metis exp_le_cancel_iff)
  2097 qed
  2098 
  2099 lemma ln_one_minus_pos_lower_bound:
  2100   fixes x :: real
  2101   assumes a: "0 \<le> x" and b: "x \<le> 1 / 2"
  2102   shows "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
  2103 proof -
  2104   from b have c: "x < 1" by auto
  2105   then have "ln (1 - x) = - ln (1 + x / (1 - x))"
  2106     apply (subst ln_inverse [symmetric])
  2107      apply (simp add: field_simps)
  2108     apply (rule arg_cong [where f=ln])
  2109     apply (simp add: field_simps)
  2110     done
  2111   also have "- (x / (1 - x)) \<le> \<dots>"
  2112   proof -
  2113     have "ln (1 + x / (1 - x)) \<le> x / (1 - x)"
  2114       using a c by (intro ln_add_one_self_le_self) auto
  2115     then show ?thesis
  2116       by auto
  2117   qed
  2118   also have "- (x / (1 - x)) = - x / (1 - x)"
  2119     by auto
  2120   finally have d: "- x / (1 - x) \<le> ln (1 - x)" .
  2121   have "0 < 1 - x" using a b by simp
  2122   then have e: "- x - 2 * x\<^sup>2 \<le> - x / (1 - x)"
  2123     using mult_right_le_one_le[of "x * x" "2 * x"] a b
  2124     by (simp add: field_simps power2_eq_square)
  2125   from e d show "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
  2126     by (rule order_trans)
  2127 qed
  2128 
  2129 lemma ln_add_one_self_le_self2:
  2130   fixes x :: real
  2131   shows "-1 < x \<Longrightarrow> ln (1 + x) \<le> x"
  2132   apply (subgoal_tac "ln (1 + x) \<le> ln (exp x)")
  2133    apply simp
  2134   apply (subst ln_le_cancel_iff)
  2135     apply auto
  2136   done
  2137 
  2138 lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
  2139   fixes x :: real
  2140   assumes x: "0 \<le> x" and x1: "x \<le> 1"
  2141   shows "\<bar>ln (1 + x) - x\<bar> \<le> x\<^sup>2"
  2142 proof -
  2143   from x have "ln (1 + x) \<le> x"
  2144     by (rule ln_add_one_self_le_self)
  2145   then have "ln (1 + x) - x \<le> 0"
  2146     by simp
  2147   then have "\<bar>ln(1 + x) - x\<bar> = - (ln(1 + x) - x)"
  2148     by (rule abs_of_nonpos)
  2149   also have "\<dots> = x - ln (1 + x)"
  2150     by simp
  2151   also have "\<dots> \<le> x\<^sup>2"
  2152   proof -
  2153     from x x1 have "x - x\<^sup>2 \<le> ln (1 + x)"
  2154       by (intro ln_one_plus_pos_lower_bound)
  2155     then show ?thesis
  2156       by simp
  2157   qed
  2158   finally show ?thesis .
  2159 qed
  2160 
  2161 lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
  2162   fixes x :: real
  2163   assumes a: "-(1 / 2) \<le> x" and b: "x \<le> 0"
  2164   shows "\<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
  2165 proof -
  2166   have "\<bar>ln (1 + x) - x\<bar> = x - ln (1 - (- x))"
  2167     apply (subst abs_of_nonpos)
  2168      apply simp
  2169      apply (rule ln_add_one_self_le_self2)
  2170     using a apply auto
  2171     done
  2172   also have "\<dots> \<le> 2 * x\<^sup>2"
  2173     apply (subgoal_tac "- (-x) - 2 * (-x)\<^sup>2 \<le> ln (1 - (- x))")
  2174      apply (simp add: algebra_simps)
  2175     apply (rule ln_one_minus_pos_lower_bound)
  2176     using a b apply auto
  2177     done
  2178   finally show ?thesis .
  2179 qed
  2180 
  2181 lemma abs_ln_one_plus_x_minus_x_bound:
  2182   fixes x :: real
  2183   shows "\<bar>x\<bar> \<le> 1 / 2 \<Longrightarrow> \<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
  2184   apply (cases "0 \<le> x")
  2185    apply (rule order_trans)
  2186     apply (rule abs_ln_one_plus_x_minus_x_bound_nonneg)
  2187      apply auto
  2188   apply (rule abs_ln_one_plus_x_minus_x_bound_nonpos)
  2189    apply auto
  2190   done
  2191 
  2192 lemma ln_x_over_x_mono:
  2193   fixes x :: real
  2194   assumes x: "exp 1 \<le> x" "x \<le> y"
  2195   shows "ln y / y \<le> ln x / x"
  2196 proof -
  2197   note x
  2198   moreover have "0 < exp (1::real)" by simp
  2199   ultimately have a: "0 < x" and b: "0 < y"
  2200     by (fast intro: less_le_trans order_trans)+
  2201   have "x * ln y - x * ln x = x * (ln y - ln x)"
  2202     by (simp add: algebra_simps)
  2203   also have "\<dots> = x * ln (y / x)"
  2204     by (simp only: ln_div a b)
  2205   also have "y / x = (x + (y - x)) / x"
  2206     by simp
  2207   also have "\<dots> = 1 + (y - x) / x"
  2208     using x a by (simp add: field_simps)
  2209   also have "x * ln (1 + (y - x) / x) \<le> x * ((y - x) / x)"
  2210     using x a
  2211     by (intro mult_left_mono ln_add_one_self_le_self) simp_all
  2212   also have "\<dots> = y - x"
  2213     using a by simp
  2214   also have "\<dots> = (y - x) * ln (exp 1)" by simp
  2215   also have "\<dots> \<le> (y - x) * ln x"
  2216     apply (rule mult_left_mono)
  2217      apply (subst ln_le_cancel_iff)
  2218        apply fact
  2219       apply (rule a)
  2220      apply (rule x)
  2221     using x apply simp
  2222     done
  2223   also have "\<dots> = y * ln x - x * ln x"
  2224     by (rule left_diff_distrib)
  2225   finally have "x * ln y \<le> y * ln x"
  2226     by arith
  2227   then have "ln y \<le> (y * ln x) / x"
  2228     using a by (simp add: field_simps)
  2229   also have "\<dots> = y * (ln x / x)" by simp
  2230   finally show ?thesis
  2231     using b by (simp add: field_simps)
  2232 qed
  2233 
  2234 lemma ln_le_minus_one: "0 < x \<Longrightarrow> ln x \<le> x - 1"
  2235   for x :: real
  2236   using exp_ge_add_one_self[of "ln x"] by simp
  2237 
  2238 corollary ln_diff_le: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x - ln y \<le> (x - y) / y"
  2239   for x :: real
  2240   by (simp add: ln_div [symmetric] diff_divide_distrib ln_le_minus_one)
  2241 
  2242 lemma ln_eq_minus_one:
  2243   fixes x :: real
  2244   assumes "0 < x" "ln x = x - 1"
  2245   shows "x = 1"
  2246 proof -
  2247   let ?l = "\<lambda>y. ln y - y + 1"
  2248   have D: "\<And>x::real. 0 < x \<Longrightarrow> DERIV ?l x :> (1 / x - 1)"
  2249     by (auto intro!: derivative_eq_intros)
  2250 
  2251   show ?thesis
  2252   proof (cases rule: linorder_cases)
  2253     assume "x < 1"
  2254     from dense[OF \<open>x < 1\<close>] obtain a where "x < a" "a < 1" by blast
  2255     from \<open>x < a\<close> have "?l x < ?l a"
  2256     proof (rule DERIV_pos_imp_increasing, safe)
  2257       fix y
  2258       assume "x \<le> y" "y \<le> a"
  2259       with \<open>0 < x\<close> \<open>a < 1\<close> have "0 < 1 / y - 1" "0 < y"
  2260         by (auto simp: field_simps)
  2261       with D show "\<exists>z. DERIV ?l y :> z \<and> 0 < z" by blast
  2262     qed
  2263     also have "\<dots> \<le> 0"
  2264       using ln_le_minus_one \<open>0 < x\<close> \<open>x < a\<close> by (auto simp: field_simps)
  2265     finally show "x = 1" using assms by auto
  2266   next
  2267     assume "1 < x"
  2268     from dense[OF this] obtain a where "1 < a" "a < x" by blast
  2269     from \<open>a < x\<close> have "?l x < ?l a"
  2270     proof (rule DERIV_neg_imp_decreasing, safe)
  2271       fix y
  2272       assume "a \<le> y" "y \<le> x"
  2273       with \<open>1 < a\<close> have "1 / y - 1 < 0" "0 < y"
  2274         by (auto simp: field_simps)
  2275       with D show "\<exists>z. DERIV ?l y :> z \<and> z < 0"
  2276         by blast
  2277     qed
  2278     also have "\<dots> \<le> 0"
  2279       using ln_le_minus_one \<open>1 < a\<close> by (auto simp: field_simps)
  2280     finally show "x = 1" using assms by auto
  2281   next
  2282     assume "x = 1"
  2283     then show ?thesis by simp
  2284   qed
  2285 qed
  2286 
  2287 lemma ln_x_over_x_tendsto_0: "((\<lambda>x::real. ln x / x) \<longlongrightarrow> 0) at_top"
  2288 proof (rule lhospital_at_top_at_top[where f' = inverse and g' = "\<lambda>_. 1"])
  2289   from eventually_gt_at_top[of "0::real"]
  2290   show "\<forall>\<^sub>F x in at_top. (ln has_real_derivative inverse x) (at x)"
  2291     by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps)
  2292 qed (use tendsto_inverse_0 in
  2293       \<open>auto simp: filterlim_ident dest!: tendsto_mono[OF at_top_le_at_infinity]\<close>)
  2294 
  2295 lemma exp_ge_one_plus_x_over_n_power_n:
  2296   assumes "x \<ge> - real n" "n > 0"
  2297   shows "(1 + x / of_nat n) ^ n \<le> exp x"
  2298 proof (cases "x = - of_nat n")
  2299   case False
  2300   from assms False have "(1 + x / of_nat n) ^ n = exp (of_nat n * ln (1 + x / of_nat n))"
  2301     by (subst exp_of_nat_mult, subst exp_ln) (simp_all add: field_simps)
  2302   also from assms False have "ln (1 + x / real n) \<le> x / real n"
  2303     by (intro ln_add_one_self_le_self2) (simp_all add: field_simps)
  2304   with assms have "exp (of_nat n * ln (1 + x / of_nat n)) \<le> exp x"
  2305     by (simp add: field_simps del: exp_of_nat_mult)
  2306   finally show ?thesis .
  2307 next
  2308   case True
  2309   then show ?thesis by (simp add: zero_power)
  2310 qed
  2311 
  2312 lemma exp_ge_one_minus_x_over_n_power_n:
  2313   assumes "x \<le> real n" "n > 0"
  2314   shows "(1 - x / of_nat n) ^ n \<le> exp (-x)"
  2315   using exp_ge_one_plus_x_over_n_power_n[of n "-x"] assms by simp
  2316 
  2317 lemma exp_at_bot: "(exp \<longlongrightarrow> (0::real)) at_bot"
  2318   unfolding tendsto_Zfun_iff
  2319 proof (rule ZfunI, simp add: eventually_at_bot_dense)
  2320   fix r :: real
  2321   assume "0 < r"
  2322   have "exp x < r" if "x < ln r" for x
  2323   proof -
  2324     from that have "exp x < exp (ln r)"
  2325       by simp
  2326     with \<open>0 < r\<close> show ?thesis
  2327       by simp
  2328   qed
  2329   then show "\<exists>k. \<forall>n<k. exp n < r" by auto
  2330 qed
  2331 
  2332 lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
  2333   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g="ln"])
  2334     (auto intro: eventually_gt_at_top)
  2335 
  2336 lemma lim_exp_minus_1: "((\<lambda>z::'a. (exp(z) - 1) / z) \<longlongrightarrow> 1) (at 0)"
  2337   for x :: "'a::{real_normed_field,banach}"
  2338 proof -
  2339   have "((\<lambda>z::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
  2340     by (intro derivative_eq_intros | simp)+
  2341   then show ?thesis
  2342     by (simp add: Deriv.DERIV_iff2)
  2343 qed
  2344 
  2345 lemma ln_at_0: "LIM x at_right 0. ln (x::real) :> at_bot"
  2346   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  2347      (auto simp: eventually_at_filter)
  2348 
  2349 lemma ln_at_top: "LIM x at_top. ln (x::real) :> at_top"
  2350   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  2351      (auto intro: eventually_gt_at_top)
  2352 
  2353 lemma filtermap_ln_at_top: "filtermap (ln::real \<Rightarrow> real) at_top = at_top"
  2354   by (intro filtermap_fun_inverse[of exp] exp_at_top ln_at_top) auto
  2355 
  2356 lemma filtermap_exp_at_top: "filtermap (exp::real \<Rightarrow> real) at_top = at_top"
  2357   by (intro filtermap_fun_inverse[of ln] exp_at_top ln_at_top)
  2358      (auto simp: eventually_at_top_dense)
  2359 
  2360 lemma filtermap_ln_at_right: "filtermap ln (at_right (0::real)) = at_bot"
  2361   by (auto intro!: filtermap_fun_inverse[where g="\<lambda>x. exp x"] ln_at_0
  2362       simp: filterlim_at exp_at_bot)
  2363 
  2364 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) \<longlongrightarrow> (0::real)) at_top"
  2365 proof (induct k)
  2366   case 0
  2367   show "((\<lambda>x. x ^ 0 / exp x) \<longlongrightarrow> (0::real)) at_top"
  2368     by (simp add: inverse_eq_divide[symmetric])
  2369        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
  2370          at_top_le_at_infinity order_refl)
  2371 next
  2372   case (Suc k)
  2373   show ?case
  2374   proof (rule lhospital_at_top_at_top)
  2375     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
  2376       by eventually_elim (intro derivative_eq_intros, auto)
  2377     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
  2378       by eventually_elim auto
  2379     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
  2380       by auto
  2381     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
  2382     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) \<longlongrightarrow> 0) at_top"
  2383       by simp
  2384   qed (rule exp_at_top)
  2385 qed
  2386 
  2387 subsubsection\<open> A couple of simple bounds\<close>
  2388 
  2389 lemma exp_plus_inverse_exp:
  2390   fixes x::real
  2391   shows "2 \<le> exp x + inverse (exp x)"
  2392 proof -
  2393   have "2 \<le> exp x + exp (-x)"
  2394     using exp_ge_add_one_self [of x] exp_ge_add_one_self [of "-x"]
  2395     by linarith
  2396   then show ?thesis
  2397     by (simp add: exp_minus)
  2398 qed
  2399 
  2400 lemma real_le_x_sinh:
  2401   fixes x::real
  2402   assumes "0 \<le> x"
  2403   shows "x \<le> (exp x - inverse(exp x)) / 2"
  2404 proof -
  2405   have *: "exp a - inverse(exp a) - 2*a \<le> exp b - inverse(exp b) - 2*b" if "a \<le> b" for a b::real
  2406     apply (rule DERIV_nonneg_imp_nondecreasing [OF that])
  2407     using exp_plus_inverse_exp
  2408     apply (intro exI allI impI conjI derivative_eq_intros | force)+
  2409     done
  2410   show ?thesis
  2411     using*[OF assms] by simp
  2412 qed
  2413 
  2414 lemma real_le_abs_sinh:
  2415   fixes x::real
  2416   shows "abs x \<le> abs((exp x - inverse(exp x)) / 2)"
  2417 proof (cases "0 \<le> x")
  2418   case True
  2419   show ?thesis
  2420     using real_le_x_sinh [OF True] True by (simp add: abs_if)
  2421 next
  2422   case False
  2423   have "-x \<le> (exp(-x) - inverse(exp(-x))) / 2"
  2424     by (meson False linear neg_le_0_iff_le real_le_x_sinh)
  2425   also have "... \<le> \<bar>(exp x - inverse (exp x)) / 2\<bar>"
  2426     by (metis (no_types, hide_lams) abs_divide abs_le_iff abs_minus_cancel
  2427        add.inverse_inverse exp_minus minus_diff_eq order_refl)
  2428   finally show ?thesis
  2429     using False by linarith
  2430 qed
  2431 
  2432 subsection\<open>The general logarithm\<close>
  2433 
  2434 definition log :: "real \<Rightarrow> real \<Rightarrow> real"
  2435   \<comment> \<open>logarithm of @{term x} to base @{term a}\<close>
  2436   where "log a x = ln x / ln a"
  2437 
  2438 lemma tendsto_log [tendsto_intros]:
  2439   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow>
  2440     ((\<lambda>x. log (f x) (g x)) \<longlongrightarrow> log a b) F"
  2441   unfolding log_def by (intro tendsto_intros) auto
  2442 
  2443 lemma continuous_log:
  2444   assumes "continuous F f"
  2445     and "continuous F g"
  2446     and "0 < f (Lim F (\<lambda>x. x))"
  2447     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
  2448     and "0 < g (Lim F (\<lambda>x. x))"
  2449   shows "continuous F (\<lambda>x. log (f x) (g x))"
  2450   using assms unfolding continuous_def by (rule tendsto_log)
  2451 
  2452 lemma continuous_at_within_log[continuous_intros]:
  2453   assumes "continuous (at a within s) f"
  2454     and "continuous (at a within s) g"
  2455     and "0 < f a"
  2456     and "f a \<noteq> 1"
  2457     and "0 < g a"
  2458   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
  2459   using assms unfolding continuous_within by (rule tendsto_log)
  2460 
  2461 lemma isCont_log[continuous_intros, simp]:
  2462   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
  2463   shows "isCont (\<lambda>x. log (f x) (g x)) a"
  2464   using assms unfolding continuous_at by (rule tendsto_log)
  2465 
  2466 lemma continuous_on_log[continuous_intros]:
  2467   assumes "continuous_on s f" "continuous_on s g"
  2468     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
  2469   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
  2470   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
  2471 
  2472 lemma powr_one_eq_one [simp]: "1 powr a = 1"
  2473   by (simp add: powr_def)
  2474 
  2475 lemma powr_zero_eq_one [simp]: "x powr 0 = (if x = 0 then 0 else 1)"
  2476   by (simp add: powr_def)
  2477 
  2478 lemma powr_one_gt_zero_iff [simp]: "x powr 1 = x \<longleftrightarrow> 0 \<le> x"
  2479   for x :: real
  2480   by (auto simp: powr_def)
  2481 declare powr_one_gt_zero_iff [THEN iffD2, simp]
  2482 
  2483 lemma powr_mult: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
  2484   for a x y :: real
  2485   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
  2486 
  2487 lemma powr_ge_pzero [simp]: "0 \<le> x powr y"
  2488   for x y :: real
  2489   by (simp add: powr_def)
  2490 
  2491 lemma powr_divide: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
  2492   for a b x :: real
  2493   apply (simp add: divide_inverse positive_imp_inverse_positive powr_mult)
  2494   apply (simp add: powr_def exp_minus [symmetric] exp_add [symmetric] ln_inverse)
  2495   done
  2496 
  2497 lemma powr_divide2: "x powr a / x powr b = x powr (a - b)"
  2498   for a b x :: real
  2499   apply (simp add: powr_def)
  2500   apply (subst exp_diff [THEN sym])
  2501   apply (simp add: left_diff_distrib)
  2502   done
  2503 
  2504 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
  2505   for a b x :: real
  2506   by (simp add: powr_def exp_add [symmetric] distrib_right)
  2507 
  2508 lemma powr_mult_base: "0 < x \<Longrightarrow>x * x powr y = x powr (1 + y)"
  2509   for x :: real
  2510   by (auto simp: powr_add)
  2511 
  2512 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
  2513   for a b x :: real
  2514   by (simp add: powr_def)
  2515 
  2516 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
  2517   for a b x :: real
  2518   by (simp add: powr_powr mult.commute)
  2519 
  2520 lemma powr_minus: "x powr (- a) = inverse (x powr a)"
  2521   for x a :: real
  2522   by (simp add: powr_def exp_minus [symmetric])
  2523 
  2524 lemma powr_minus_divide: "x powr (- a) = 1/(x powr a)"
  2525   for x a :: real
  2526   by (simp add: divide_inverse powr_minus)
  2527 
  2528 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
  2529   for a b c :: real
  2530   by (simp add: powr_minus_divide)
  2531 
  2532 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
  2533   for a b x :: real
  2534   by (simp add: powr_def)
  2535 
  2536 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  2537   for a b x :: real
  2538   by (simp add: powr_def)
  2539 
  2540 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a < x powr b \<longleftrightarrow> a < b"
  2541   for a b x :: real
  2542   by (blast intro: powr_less_cancel powr_less_mono)
  2543 
  2544 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a \<le> x powr b \<longleftrightarrow> a \<le> b"
  2545   for a b x :: real
  2546   by (simp add: linorder_not_less [symmetric])
  2547 
  2548 lemma log_ln: "ln x = log (exp(1)) x"
  2549   by (simp add: log_def)
  2550 
  2551 lemma DERIV_log:
  2552   assumes "x > 0"
  2553   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
  2554 proof -
  2555   define lb where "lb = 1 / ln b"
  2556   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
  2557     using \<open>x > 0\<close> by (auto intro!: derivative_eq_intros)
  2558   ultimately show ?thesis
  2559     by (simp add: log_def)
  2560 qed
  2561 
  2562 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
  2563   and DERIV_log[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  2564 
  2565 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
  2566   by (simp add: powr_def log_def)
  2567 
  2568 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
  2569   by (simp add: log_def powr_def)
  2570 
  2571 lemma log_mult:
  2572   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
  2573     log a (x * y) = log a x + log a y"
  2574   by (simp add: log_def ln_mult divide_inverse distrib_right)
  2575 
  2576 lemma log_eq_div_ln_mult_log:
  2577   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  2578     log a x = (ln b/ln a) * log b x"
  2579   by (simp add: log_def divide_inverse)
  2580 
  2581 text\<open>Base 10 logarithms\<close>
  2582 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
  2583   by (simp add: log_def)
  2584 
  2585 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
  2586   by (simp add: log_def)
  2587 
  2588 lemma log_one [simp]: "log a 1 = 0"
  2589   by (simp add: log_def)
  2590 
  2591 lemma log_eq_one [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a a = 1"
  2592   by (simp add: log_def)
  2593 
  2594 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
  2595   apply (rule add_left_cancel [THEN iffD1, where a1 = "log a x"])
  2596   apply (simp add: log_mult [symmetric])
  2597   done
  2598 
  2599 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"
  2600   by (simp add: log_mult divide_inverse log_inverse)
  2601 
  2602 lemma powr_gt_zero [simp]: "0 < x powr a \<longleftrightarrow> x \<noteq> 0"
  2603   for a x :: real
  2604   by (simp add: powr_def)
  2605 
  2606 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)"
  2607   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)"
  2608   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)"
  2609   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)"
  2610   by (simp_all add: log_mult log_divide)
  2611 
  2612 lemma log_less_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
  2613   apply safe
  2614    apply (rule_tac [2] powr_less_cancel)
  2615     apply (drule_tac a = "log a x" in powr_less_mono)
  2616      apply auto
  2617   done
  2618 
  2619 lemma log_inj:
  2620   assumes "1 < b"
  2621   shows "inj_on (log b) {0 <..}"
  2622 proof (rule inj_onI, simp)
  2623   fix x y
  2624   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
  2625   show "x = y"
  2626   proof (cases rule: linorder_cases)
  2627     assume "x = y"
  2628     then show ?thesis by simp
  2629   next
  2630     assume "x < y"
  2631     then have "log b x < log b y"
  2632       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2633     then show ?thesis using * by simp
  2634   next
  2635     assume "y < x"
  2636     then have "log b y < log b x"
  2637       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2638     then show ?thesis using * by simp
  2639   qed
  2640 qed
  2641 
  2642 lemma log_le_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x \<le> log a y \<longleftrightarrow> x \<le> y"
  2643   by (simp add: linorder_not_less [symmetric])
  2644 
  2645 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
  2646   using log_less_cancel_iff[of a 1 x] by simp
  2647 
  2648 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
  2649   using log_le_cancel_iff[of a 1 x] by simp
  2650 
  2651 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
  2652   using log_less_cancel_iff[of a x 1] by simp
  2653 
  2654 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
  2655   using log_le_cancel_iff[of a x 1] by simp
  2656 
  2657 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
  2658   using log_less_cancel_iff[of a a x] by simp
  2659 
  2660 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
  2661   using log_le_cancel_iff[of a a x] by simp
  2662 
  2663 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
  2664   using log_less_cancel_iff[of a x a] by simp
  2665 
  2666 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
  2667   using log_le_cancel_iff[of a x a] by simp
  2668 
  2669 lemma le_log_iff:
  2670   fixes b x y :: real
  2671   assumes "1 < b" "x > 0"
  2672   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
  2673   using assms
  2674   apply auto
  2675    apply (metis (no_types, hide_lams) less_irrefl less_le_trans linear powr_le_cancel_iff
  2676       powr_log_cancel zero_less_one)
  2677   apply (metis not_less order.trans order_refl powr_le_cancel_iff powr_log_cancel zero_le_one)
  2678   done
  2679 
  2680 lemma less_log_iff:
  2681   assumes "1 < b" "x > 0"
  2682   shows "y < log b x \<longleftrightarrow> b powr y < x"
  2683   by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
  2684     powr_log_cancel zero_less_one)
  2685 
  2686 lemma
  2687   assumes "1 < b" "x > 0"
  2688   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
  2689     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
  2690   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
  2691   by auto
  2692 
  2693 lemmas powr_le_iff = le_log_iff[symmetric]
  2694   and powr_less_iff = le_log_iff[symmetric]
  2695   and less_powr_iff = log_less_iff[symmetric]
  2696   and le_powr_iff = log_le_iff[symmetric]
  2697 
  2698 lemma gr_one_powr[simp]:
  2699   fixes x y :: real shows "\<lbrakk> x > 1; y > 0 \<rbrakk> \<Longrightarrow> 1 < x powr y"
  2700 by(simp add: less_powr_iff)
  2701 
  2702 lemma 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)"
  2703   by (auto simp add: floor_eq_iff powr_le_iff less_powr_iff)
  2704 
  2705 lemma powr_realpow: "0 < x \<Longrightarrow> x powr (real n) = x^n"
  2706   by (induct n) (simp_all add: ac_simps powr_add)
  2707 
  2708 lemma powr_numeral [simp]: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
  2709   by (metis of_nat_numeral powr_realpow)
  2710 
  2711 lemma numeral_powr_numeral[simp]:
  2712   "(numeral m :: real) powr (numeral n :: real) = numeral m ^ (numeral n)"
  2713 by(simp add: powr_numeral)
  2714 
  2715 lemma powr_real_of_int:
  2716   "x > 0 \<Longrightarrow> x powr real_of_int n = (if n \<ge> 0 then x ^ nat n else inverse (x ^ nat (- n)))"
  2717   using powr_realpow[of x "nat n"] powr_realpow[of x "nat (-n)"]
  2718   by (auto simp: field_simps powr_minus)
  2719 
  2720 lemma powr2_sqrt[simp]: "0 < x \<Longrightarrow> sqrt x powr 2 = x"
  2721   by (simp add: powr_numeral)
  2722 
  2723 lemma powr_realpow2: "0 \<le> x \<Longrightarrow> 0 < n \<Longrightarrow> x^n = (if (x = 0) then 0 else x powr (real n))"
  2724   apply (cases "x = 0")
  2725    apply simp_all
  2726   apply (rule powr_realpow [THEN sym])
  2727   apply simp
  2728   done
  2729 
  2730 lemma powr_int:
  2731   assumes "x > 0"
  2732   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
  2733 proof (cases "i < 0")
  2734   case True
  2735   have r: "x powr i = 1 / x powr (- i)"
  2736     by (simp add: powr_minus field_simps)
  2737   show ?thesis using \<open>i < 0\<close> \<open>x > 0\<close>
  2738     by (simp add: r field_simps powr_realpow[symmetric])
  2739 next
  2740   case False
  2741   then show ?thesis
  2742     by (simp add: assms powr_realpow[symmetric])
  2743 qed
  2744 
  2745 lemma compute_powr[code]:
  2746   fixes i :: real
  2747   shows "b powr i =
  2748     (if b \<le> 0 then Code.abort (STR ''op powr with nonpositive base'') (\<lambda>_. b powr i)
  2749      else if \<lfloor>i\<rfloor> = i then (if 0 \<le> i then b ^ nat \<lfloor>i\<rfloor> else 1 / b ^ nat \<lfloor>- i\<rfloor>)
  2750      else Code.abort (STR ''op powr with non-integer exponent'') (\<lambda>_. b powr i))"
  2751   by (auto simp: powr_int)
  2752 
  2753 lemma powr_one: "0 \<le> x \<Longrightarrow> x powr 1 = x"
  2754   for x :: real
  2755   using powr_realpow [of x 1] by simp
  2756 
  2757 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
  2758   for x :: real
  2759   using powr_int [of x "- 1"] by simp
  2760 
  2761 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
  2762   for x :: real
  2763   using powr_int [of x "- numeral n"] by simp
  2764 
  2765 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
  2766   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
  2767 
  2768 lemma ln_powr: "x \<noteq> 0 \<Longrightarrow> ln (x powr y) = y * ln x"
  2769   for x :: real
  2770   by (simp add: powr_def)
  2771 
  2772 lemma ln_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> ln (root n b) =  ln b / n"
  2773   by (simp add: root_powr_inverse ln_powr)
  2774 
  2775 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
  2776   by (simp add: ln_powr ln_powr[symmetric] mult.commute)
  2777 
  2778 lemma log_root: "n > 0 \<Longrightarrow> a > 0 \<Longrightarrow> log b (root n a) =  log b a / n"
  2779   by (simp add: log_def ln_root)
  2780 
  2781 lemma log_powr: "x \<noteq> 0 \<Longrightarrow> log b (x powr y) = y * log b x"
  2782   by (simp add: log_def ln_powr)
  2783 
  2784 (* [simp] is not worth it, interferes with some proofs *)
  2785 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
  2786   by (simp add: log_powr powr_realpow [symmetric])
  2787 
  2788 lemma le_log_of_power:
  2789   assumes "1 < b" "b ^ n \<le> m"
  2790   shows "n \<le> log b m"
  2791 proof -
  2792    from assms have "0 < m"
  2793      by (metis less_trans zero_less_power less_le_trans zero_less_one)
  2794    have "n = log b (b ^ n)"
  2795      using assms(1) by (simp add: log_nat_power)
  2796    also have "\<dots> \<le> log b m"
  2797      using assms \<open>0 < m\<close> by simp
  2798    finally show ?thesis .
  2799 qed
  2800 
  2801 lemma le_log2_of_power: "2 ^ n \<le> m \<Longrightarrow> n \<le> log 2 m"
  2802   for m n :: nat
  2803   using le_log_of_power[of 2] by simp
  2804 
  2805 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
  2806   by (simp add: log_def)
  2807 
  2808 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
  2809   by (simp add: log_def ln_realpow)
  2810 
  2811 lemma log_base_powr: "a \<noteq> 0 \<Longrightarrow> log (a powr b) x = log a x / b"
  2812   by (simp add: log_def ln_powr)
  2813 
  2814 lemma log_base_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> log (root n b) x = n * (log b x)"
  2815   by (simp add: log_def ln_root)
  2816 
  2817 lemma ln_bound: "1 \<le> x \<Longrightarrow> ln x \<le> x"
  2818   for x :: real
  2819   apply (subgoal_tac "ln (1 + (x - 1)) \<le> x - 1")
  2820    apply simp
  2821   apply (rule ln_add_one_self_le_self)
  2822   apply simp
  2823   done
  2824 
  2825 lemma powr_mono: "a \<le> b \<Longrightarrow> 1 \<le> x \<Longrightarrow> x powr a \<le> x powr b"
  2826   for x :: real
  2827   apply (cases "x = 1")
  2828    apply simp
  2829   apply (cases "a = b")
  2830    apply simp
  2831   apply (rule order_less_imp_le)
  2832   apply (rule powr_less_mono)
  2833    apply auto
  2834   done
  2835 
  2836 lemma ge_one_powr_ge_zero: "1 \<le> x \<Longrightarrow> 0 \<le> a \<Longrightarrow> 1 \<le> x powr a"
  2837   for x :: real
  2838   using powr_mono by fastforce
  2839 
  2840 lemma powr_less_mono2: "0 < a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> x powr a < y powr a"
  2841   for x :: real
  2842   by (simp add: powr_def)
  2843 
  2844 lemma powr_less_mono2_neg: "a < 0 \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> y powr a < x powr a"
  2845   for x :: real
  2846   by (simp add: powr_def)
  2847 
  2848 lemma powr_mono2: "x powr a \<le> y powr a" if "0 \<le> a" "0 \<le> x" "x \<le> y"
  2849   for x :: real
  2850 proof (cases "a = 0")
  2851   case True
  2852   with that show ?thesis by simp
  2853 next
  2854   case False show ?thesis
  2855   proof (cases "x = y")
  2856     case True
  2857     then show ?thesis by simp
  2858   next
  2859     case False
  2860     then show ?thesis
  2861       by (metis dual_order.strict_iff_order powr_less_mono2 that \<open>a \<noteq> 0\<close>)
  2862   qed
  2863 qed
  2864 
  2865 lemma powr_le1: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> x powr a \<le> 1"
  2866   for x :: real
  2867   using powr_mono2 by fastforce
  2868 
  2869 lemma powr_mono2':
  2870   fixes a x y :: real
  2871   assumes "a \<le> 0" "x > 0" "x \<le> y"
  2872   shows "x powr a \<ge> y powr a"
  2873 proof -
  2874   from assms have "x powr - a \<le> y powr - a"
  2875     by (intro powr_mono2) simp_all
  2876   with assms show ?thesis
  2877     by (auto simp add: powr_minus field_simps)
  2878 qed
  2879 
  2880 lemma powr_mono_both:
  2881   fixes x :: real
  2882   assumes "0 \<le> a" "a \<le> b" "1 \<le> x" "x \<le> y"
  2883     shows "x powr a \<le> y powr b"
  2884   by (meson assms order.trans powr_mono powr_mono2 zero_le_one)
  2885 
  2886 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
  2887   for x :: real
  2888   unfolding powr_def exp_inj_iff by simp
  2889 
  2890 lemma powr_half_sqrt: "0 \<le> x \<Longrightarrow> x powr (1/2) = sqrt x"
  2891   by (simp add: powr_def root_powr_inverse sqrt_def)
  2892 
  2893 lemma ln_powr_bound: "1 \<le> x \<Longrightarrow> 0 < a \<Longrightarrow> ln x \<le> (x powr a) / a"
  2894   for x :: real
  2895   by (metis exp_gt_zero linear ln_eq_zero_iff ln_exp ln_less_self ln_powr mult.commute
  2896       mult_imp_le_div_pos not_less powr_gt_zero)
  2897 
  2898 lemma ln_powr_bound2:
  2899   fixes x :: real
  2900   assumes "1 < x" and "0 < a"
  2901   shows "(ln x) powr a \<le> (a powr a) * x"
  2902 proof -
  2903   from assms have "ln x \<le> (x powr (1 / a)) / (1 / a)"
  2904     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
  2905   also have "\<dots> = a * (x powr (1 / a))"
  2906     by simp
  2907   finally have "(ln x) powr a \<le> (a * (x powr (1 / a))) powr a"
  2908     by (metis assms less_imp_le ln_gt_zero powr_mono2)
  2909   also have "\<dots> = (a powr a) * ((x powr (1 / a)) powr a)"
  2910     using assms powr_mult by auto
  2911   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
  2912     by (rule powr_powr)
  2913   also have "\<dots> = x" using assms
  2914     by auto
  2915   finally show ?thesis .
  2916 qed
  2917 
  2918 lemma tendsto_powr:
  2919   fixes a b :: real
  2920   assumes f: "(f \<longlongrightarrow> a) F"
  2921     and g: "(g \<longlongrightarrow> b) F"
  2922     and a: "a \<noteq> 0"
  2923   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2924   unfolding powr_def
  2925 proof (rule filterlim_If)
  2926   from f show "((\<lambda>x. 0) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
  2927     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_mono dest: t1_space_nhds)
  2928   from f g a show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a)))
  2929       (inf F (principal {x. f x \<noteq> 0}))"
  2930     by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
  2931 qed
  2932 
  2933 lemma tendsto_powr'[tendsto_intros]:
  2934   fixes a :: real
  2935   assumes f: "(f \<longlongrightarrow> a) F"
  2936     and g: "(g \<longlongrightarrow> b) F"
  2937     and a: "a \<noteq> 0 \<or> (b > 0 \<and> eventually (\<lambda>x. f x \<ge> 0) F)"
  2938   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2939 proof -
  2940   from a consider "a \<noteq> 0" | "a = 0" "b > 0" "eventually (\<lambda>x. f x \<ge> 0) F"
  2941     by auto
  2942   then show ?thesis
  2943   proof cases
  2944     case 1
  2945     with f g show ?thesis by (rule tendsto_powr)
  2946   next
  2947     case 2
  2948     have "((\<lambda>x. if f x = 0 then 0 else exp (g x * ln (f x))) \<longlongrightarrow> 0) F"
  2949     proof (intro filterlim_If)
  2950       have "filterlim f (principal {0<..}) (inf F (principal {z. f z \<noteq> 0}))"
  2951         using \<open>eventually (\<lambda>x. f x \<ge> 0) F\<close>
  2952         by (auto simp add: filterlim_iff eventually_inf_principal
  2953             eventually_principal elim: eventually_mono)
  2954       moreover have "filterlim f (nhds a) (inf F (principal {z. f z \<noteq> 0}))"
  2955         by (rule tendsto_mono[OF _ f]) simp_all
  2956       ultimately have f: "filterlim f (at_right 0) (inf F (principal {x. f x \<noteq> 0}))"
  2957         by (simp add: at_within_def filterlim_inf \<open>a = 0\<close>)
  2958       have g: "(g \<longlongrightarrow> b) (inf F (principal {z. f z \<noteq> 0}))"
  2959         by (rule tendsto_mono[OF _ g]) simp_all
  2960       show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> 0) (inf F (principal {x. f x \<noteq> 0}))"
  2961         by (rule filterlim_compose[OF exp_at_bot] filterlim_tendsto_pos_mult_at_bot
  2962                  filterlim_compose[OF ln_at_0] f g \<open>b > 0\<close>)+
  2963     qed simp_all
  2964     with \<open>a = 0\<close> show ?thesis
  2965       by (simp add: powr_def)
  2966   qed
  2967 qed
  2968 
  2969 lemma continuous_powr:
  2970   assumes "continuous F f"
  2971     and "continuous F g"
  2972     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
  2973   shows "continuous F (\<lambda>x. (f x) powr (g x :: real))"
  2974   using assms unfolding continuous_def by (rule tendsto_powr)
  2975 
  2976 lemma continuous_at_within_powr[continuous_intros]:
  2977   fixes f g :: "_ \<Rightarrow> real"
  2978   assumes "continuous (at a within s) f"
  2979     and "continuous (at a within s) g"
  2980     and "f a \<noteq> 0"
  2981   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
  2982   using assms unfolding continuous_within by (rule tendsto_powr)
  2983 
  2984 lemma isCont_powr[continuous_intros, simp]:
  2985   fixes f g :: "_ \<Rightarrow> real"
  2986   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
  2987   shows "isCont (\<lambda>x. (f x) powr g x) a"
  2988   using assms unfolding continuous_at by (rule tendsto_powr)
  2989 
  2990 lemma continuous_on_powr[continuous_intros]:
  2991   fixes f g :: "_ \<Rightarrow> real"
  2992   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
  2993   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2994   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
  2995 
  2996 lemma tendsto_powr2:
  2997   fixes a :: real
  2998   assumes f: "(f \<longlongrightarrow> a) F"
  2999     and g: "(g \<longlongrightarrow> b) F"
  3000     and "\<forall>\<^sub>F x in F. 0 \<le> f x"
  3001     and b: "0 < b"
  3002   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  3003   using tendsto_powr'[of f a F g b] assms by auto
  3004 
  3005 lemma DERIV_powr:
  3006   fixes r :: real
  3007   assumes g: "DERIV g x :> m"
  3008     and pos: "g x > 0"
  3009     and f: "DERIV f x :> r"
  3010   shows "DERIV (\<lambda>x. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
  3011 proof -
  3012   have "DERIV (\<lambda>x. exp (f x * ln (g x))) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
  3013     using pos
  3014     by (auto intro!: derivative_eq_intros g pos f simp: powr_def field_simps exp_diff)
  3015   then show ?thesis
  3016   proof (rule DERIV_cong_ev[OF refl _ refl, THEN iffD1, rotated])
  3017     from DERIV_isCont[OF g] pos have "\<forall>\<^sub>F x in at x. 0 < g x"
  3018       unfolding isCont_def by (rule order_tendstoD(1))
  3019     with pos show "\<forall>\<^sub>F x in nhds x. exp (f x * ln (g x)) = g x powr f x"
  3020       by (auto simp: eventually_at_filter powr_def elim: eventually_mono)
  3021   qed
  3022 qed
  3023 
  3024 lemma DERIV_fun_powr:
  3025   fixes r :: real
  3026   assumes g: "DERIV g x :> m"
  3027     and pos: "g x > 0"
  3028   shows "DERIV (\<lambda>x. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
  3029   using DERIV_powr[OF g pos DERIV_const, of r] pos
  3030   by (simp add: powr_divide2[symmetric] field_simps)
  3031 
  3032 lemma has_real_derivative_powr:
  3033   assumes "z > 0"
  3034   shows "((\<lambda>z. z powr r) has_real_derivative r * z powr (r - 1)) (at z)"
  3035 proof (subst DERIV_cong_ev[OF refl _ refl])
  3036   from assms have "eventually (\<lambda>z. z \<noteq> 0) (nhds z)"
  3037     by (intro t1_space_nhds) auto
  3038   then show "eventually (\<lambda>z. z powr r = exp (r * ln z)) (nhds z)"
  3039     unfolding powr_def by eventually_elim simp
  3040   from assms show "((\<lambda>z. exp (r * ln z)) has_real_derivative r * z powr (r - 1)) (at z)"
  3041     by (auto intro!: derivative_eq_intros simp: powr_def field_simps exp_diff)
  3042 qed
  3043 
  3044 declare has_real_derivative_powr[THEN DERIV_chain2, derivative_intros]
  3045 
  3046 lemma tendsto_zero_powrI:
  3047   assumes "(f \<longlongrightarrow> (0::real)) F" "(g \<longlongrightarrow> b) F" "\<forall>\<^sub>F x in F. 0 \<le> f x" "0 < b"
  3048   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> 0) F"
  3049   using tendsto_powr2[OF assms] by simp
  3050 
  3051 lemma continuous_on_powr':
  3052   fixes f g :: "_ \<Rightarrow> real"
  3053   assumes "continuous_on s f" "continuous_on s g"
  3054     and "\<forall>x\<in>s. f x \<ge> 0 \<and> (f x = 0 \<longrightarrow> g x > 0)"
  3055   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  3056   unfolding continuous_on_def
  3057 proof
  3058   fix x
  3059   assume x: "x \<in> s"
  3060   from assms x show "((\<lambda>x. f x powr g x) \<longlongrightarrow> f x powr g x) (at x within s)"
  3061   proof (cases "f x = 0")
  3062     case True
  3063     from assms(3) have "eventually (\<lambda>x. f x \<ge> 0) (at x within s)"
  3064       by (auto simp: at_within_def eventually_inf_principal)
  3065     with True x assms show ?thesis
  3066       by (auto intro!: tendsto_zero_powrI[of f _ g "g x"] simp: continuous_on_def)
  3067   next
  3068     case False
  3069     with assms x show ?thesis
  3070       by (auto intro!: tendsto_powr' simp: continuous_on_def)
  3071   qed
  3072 qed
  3073 
  3074 lemma tendsto_neg_powr:
  3075   assumes "s < 0"
  3076     and f: "LIM x F. f x :> at_top"
  3077   shows "((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
  3078 proof -
  3079   have "((\<lambda>x. exp (s * ln (f x))) \<longlongrightarrow> (0::real)) F" (is "?X")
  3080     by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
  3081         filterlim_tendsto_neg_mult_at_bot assms)
  3082   also have "?X \<longleftrightarrow> ((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
  3083     using f filterlim_at_top_dense[of f F]
  3084     by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_mono)
  3085   finally show ?thesis .
  3086 qed
  3087 
  3088 lemma tendsto_exp_limit_at_right: "((\<lambda>y. (1 + x * y) powr (1 / y)) \<longlongrightarrow> exp x) (at_right 0)"
  3089   for x :: real
  3090 proof (cases "x = 0")
  3091   case True
  3092   then show ?thesis by simp
  3093 next
  3094   case False
  3095   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
  3096     by (auto intro!: derivative_eq_intros)
  3097   then have "((\<lambda>y. ln (1 + x * y) / y) \<longlongrightarrow> x) (at 0)"
  3098     by (auto simp add: has_field_derivative_def field_has_derivative_at)
  3099   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) \<longlongrightarrow> exp x) (at 0)"
  3100     by (rule tendsto_intros)
  3101   then show ?thesis
  3102   proof (rule filterlim_mono_eventually)
  3103     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
  3104       unfolding eventually_at_right[OF zero_less_one]
  3105       using False
  3106       apply (intro exI[of _ "1 / \<bar>x\<bar>"])
  3107       apply (auto simp: field_simps powr_def abs_if)
  3108       apply (metis add_less_same_cancel1 mult_less_0_iff not_less_iff_gr_or_eq zero_less_one)
  3109       done
  3110   qed (simp_all add: at_eq_sup_left_right)
  3111 qed
  3112 
  3113 lemma tendsto_exp_limit_at_top: "((\<lambda>y. (1 + x / y) powr y) \<longlongrightarrow> exp x) at_top"
  3114   for x :: real
  3115   apply (subst filterlim_at_top_to_right)
  3116   apply (simp add: inverse_eq_divide)
  3117   apply (rule tendsto_exp_limit_at_right)
  3118   done
  3119 
  3120 lemma tendsto_exp_limit_sequentially: "(\<lambda>n. (1 + x / n) ^ n) \<longlonglongrightarrow> exp x"
  3121   for x :: real
  3122 proof (rule filterlim_mono_eventually)
  3123   from reals_Archimedean2 [of "\<bar>x\<bar>"] obtain n :: nat where *: "real n > \<bar>x\<bar>" ..
  3124   then have "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
  3125     apply (intro eventually_sequentiallyI [of n])
  3126     apply (cases "x \<ge> 0")
  3127      apply (rule add_pos_nonneg)
  3128       apply (auto intro: divide_nonneg_nonneg)
  3129     apply (subgoal_tac "x / real xa > - 1")
  3130      apply (auto simp add: field_simps)
  3131     done
  3132   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
  3133     by (rule eventually_mono) (erule powr_realpow)
  3134   show "(\<lambda>n. (1 + x / real n) powr real n) \<longlonglongrightarrow> exp x"
  3135     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
  3136 qed auto
  3137 
  3138 
  3139 subsection \<open>Sine and Cosine\<close>
  3140 
  3141 definition sin_coeff :: "nat \<Rightarrow> real"
  3142   where "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
  3143 
  3144 definition cos_coeff :: "nat \<Rightarrow> real"
  3145   where "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
  3146 
  3147 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  3148   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
  3149 
  3150 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  3151   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
  3152 
  3153 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
  3154   unfolding sin_coeff_def by simp
  3155 
  3156 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
  3157   unfolding cos_coeff_def by simp
  3158 
  3159 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
  3160   unfolding cos_coeff_def sin_coeff_def
  3161   by (simp del: mult_Suc)
  3162 
  3163 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
  3164   unfolding cos_coeff_def sin_coeff_def
  3165   by (simp del: mult_Suc) (auto elim: oddE)
  3166 
  3167 lemma summable_norm_sin: "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
  3168   for x :: "'a::{real_normed_algebra_1,banach}"
  3169   unfolding sin_coeff_def
  3170   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  3171   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  3172   done
  3173 
  3174 lemma summable_norm_cos: "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
  3175   for x :: "'a::{real_normed_algebra_1,banach}"
  3176   unfolding cos_coeff_def
  3177   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  3178   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  3179   done
  3180 
  3181 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin x"
  3182   unfolding sin_def
  3183   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
  3184 
  3185 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos x"
  3186   unfolding cos_def
  3187   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
  3188 
  3189 lemma sin_of_real: "sin (of_real x) = of_real (sin x)"
  3190   for x :: real
  3191 proof -
  3192   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
  3193   proof
  3194     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n" for n
  3195       by (simp add: scaleR_conv_of_real)
  3196   qed
  3197   also have "\<dots> sums (sin (of_real x))"
  3198     by (rule sin_converges)
  3199   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
  3200   then show ?thesis
  3201     using sums_unique2 sums_of_real [OF sin_converges]
  3202     by blast
  3203 qed
  3204 
  3205 corollary sin_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> sin z \<in> \<real>"
  3206   by (metis Reals_cases Reals_of_real sin_of_real)
  3207 
  3208 lemma cos_of_real: "cos (of_real x) = of_real (cos x)"
  3209   for x :: real
  3210 proof -
  3211   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
  3212   proof
  3213     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n" for n
  3214       by (simp add: scaleR_conv_of_real)
  3215   qed
  3216   also have "\<dots> sums (cos (of_real x))"
  3217     by (rule cos_converges)
  3218   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
  3219   then show ?thesis
  3220     using sums_unique2 sums_of_real [OF cos_converges]
  3221     by blast
  3222 qed
  3223 
  3224 corollary cos_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cos z \<in> \<real>"
  3225   by (metis Reals_cases Reals_of_real cos_of_real)
  3226 
  3227 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
  3228   by (simp add: diffs_def sin_coeff_Suc del: of_nat_Suc)
  3229 
  3230 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
  3231   by (simp add: diffs_def cos_coeff_Suc del: of_nat_Suc)
  3232 
  3233 lemma sin_int_times_real: "sin (of_int m * of_real x) = of_real (sin (of_int m * x))"
  3234   by (metis sin_of_real of_real_mult of_real_of_int_eq)
  3235 
  3236 lemma cos_int_times_real: "cos (of_int m * of_real x) = of_real (cos (of_int m * x))"
  3237   by (metis cos_of_real of_real_mult of_real_of_int_eq)
  3238 
  3239 text \<open>Now at last we can get the derivatives of exp, sin and cos.\<close>
  3240 
  3241 lemma DERIV_sin [simp]: "DERIV sin x :> cos x"
  3242   for x :: "'a::{real_normed_field,banach}"
  3243   unfolding sin_def cos_def scaleR_conv_of_real
  3244   apply (rule DERIV_cong)
  3245    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  3246       apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
  3247               summable_minus_iff scaleR_conv_of_real [symmetric]
  3248               summable_norm_sin [THEN summable_norm_cancel]
  3249               summable_norm_cos [THEN summable_norm_cancel])
  3250   done
  3251 
  3252 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
  3253   and DERIV_sin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  3254 
  3255 lemma DERIV_cos [simp]: "DERIV cos x :> - sin x"
  3256   for x :: "'a::{real_normed_field,banach}"
  3257   unfolding sin_def cos_def scaleR_conv_of_real
  3258   apply (rule DERIV_cong)
  3259    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  3260       apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
  3261               diffs_sin_coeff diffs_cos_coeff
  3262               summable_minus_iff scaleR_conv_of_real [symmetric]
  3263               summable_norm_sin [THEN summable_norm_cancel]
  3264               summable_norm_cos [THEN summable_norm_cancel])
  3265   done
  3266 
  3267 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
  3268   and DERIV_cos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  3269 
  3270 lemma isCont_sin: "isCont sin x"
  3271   for x :: "'a::{real_normed_field,banach}"
  3272   by (rule DERIV_sin [THEN DERIV_isCont])
  3273 
  3274 lemma isCont_cos: "isCont cos x"
  3275   for x :: "'a::{real_normed_field,banach}"
  3276   by (rule DERIV_cos [THEN DERIV_isCont])
  3277 
  3278 lemma isCont_sin' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
  3279   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3280   by (rule isCont_o2 [OF _ isCont_sin])
  3281 
  3282 (* FIXME a context for f would be better *)
  3283 
  3284 lemma isCont_cos' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
  3285   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3286   by (rule isCont_o2 [OF _ isCont_cos])
  3287 
  3288 lemma tendsto_sin [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) \<longlongrightarrow> sin a) F"
  3289   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3290   by (rule isCont_tendsto_compose [OF isCont_sin])
  3291 
  3292 lemma tendsto_cos [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) \<longlongrightarrow> cos a) F"
  3293   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3294   by (rule isCont_tendsto_compose [OF isCont_cos])
  3295 
  3296 lemma continuous_sin [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
  3297   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3298   unfolding continuous_def by (rule tendsto_sin)
  3299 
  3300 lemma continuous_on_sin [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
  3301   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3302   unfolding continuous_on_def by (auto intro: tendsto_sin)
  3303 
  3304 lemma continuous_within_sin: "continuous (at z within s) sin"
  3305   for z :: "'a::{real_normed_field,banach}"
  3306   by (simp add: continuous_within tendsto_sin)
  3307 
  3308 lemma continuous_cos [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
  3309   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3310   unfolding continuous_def by (rule tendsto_cos)
  3311 
  3312 lemma continuous_on_cos [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
  3313   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3314   unfolding continuous_on_def by (auto intro: tendsto_cos)
  3315 
  3316 lemma continuous_within_cos: "continuous (at z within s) cos"
  3317   for z :: "'a::{real_normed_field,banach}"
  3318   by (simp add: continuous_within tendsto_cos)
  3319 
  3320 
  3321 subsection \<open>Properties of Sine and Cosine\<close>
  3322 
  3323 lemma sin_zero [simp]: "sin 0 = 0"
  3324   by (simp add: sin_def sin_coeff_def scaleR_conv_of_real)
  3325 
  3326 lemma cos_zero [simp]: "cos 0 = 1"
  3327   by (simp add: cos_def cos_coeff_def scaleR_conv_of_real)
  3328 
  3329 lemma DERIV_fun_sin: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin (g x)) x :> cos (g x) * m"
  3330   by (auto intro!: derivative_intros)
  3331 
  3332 lemma DERIV_fun_cos: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> - sin (g x) * m"
  3333   by (auto intro!: derivative_eq_intros)
  3334 
  3335 
  3336 subsection \<open>Deriving the Addition Formulas\<close>
  3337 
  3338 text \<open>The product of two cosine series.\<close>
  3339 lemma cos_x_cos_y:
  3340   fixes x :: "'a::{real_normed_field,banach}"
  3341   shows
  3342     "(\<lambda>p. \<Sum>n\<le>p.
  3343         if even p \<and> even n
  3344         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  3345       sums (cos x * cos y)"
  3346 proof -
  3347   have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p - n)) =
  3348     (if even p \<and> even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p - n)
  3349      else 0)"
  3350     if "n \<le> p" for n p :: nat
  3351   proof -
  3352     from that have *: "even n \<Longrightarrow> even p \<Longrightarrow>
  3353         (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
  3354       by (metis div_add power_add le_add_diff_inverse odd_add)
  3355     with that show ?thesis
  3356       by (auto simp: algebra_simps cos_coeff_def binomial_fact)
  3357   qed
  3358   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
  3359                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3360              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  3361     by simp
  3362   also have "\<dots> = (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n *\<^sub>R x^n) * (cos_coeff (p - n) *\<^sub>R y^(p-n)))"
  3363     by (simp add: algebra_simps)
  3364   also have "\<dots> sums (cos x * cos y)"
  3365     using summable_norm_cos
  3366     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  3367   finally show ?thesis .
  3368 qed
  3369 
  3370 text \<open>The product of two sine series.\<close>
  3371 lemma sin_x_sin_y:
  3372   fixes x :: "'a::{real_normed_field,banach}"
  3373   shows
  3374     "(\<lambda>p. \<Sum>n\<le>p.
  3375         if even p \<and> odd n
  3376         then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3377         else 0)
  3378       sums (sin x * sin y)"
  3379 proof -
  3380   have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  3381     (if even p \<and> odd n
  3382      then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3383      else 0)"
  3384     if "n \<le> p" for n p :: nat
  3385   proof -
  3386     have "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
  3387       if np: "odd n" "even p"
  3388     proof -
  3389       from \<open>n \<le> p\<close> np have *: "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
  3390         by arith+
  3391       have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
  3392         by simp
  3393       with \<open>n \<le> p\<close> np * show ?thesis
  3394         apply (simp add: power_add [symmetric] div_add [symmetric] del: div_add)
  3395         apply (metis (no_types) One_nat_def Suc_1 le_div_geq minus_minus
  3396             mult.left_neutral mult_minus_left power.simps(2) zero_less_Suc)
  3397         done
  3398     qed
  3399     then show ?thesis
  3400       using \<open>n\<le>p\<close> by (auto simp: algebra_simps sin_coeff_def binomial_fact)
  3401   qed
  3402   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
  3403                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3404              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  3405     by simp
  3406   also have "\<dots> = (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n *\<^sub>R x^n) * (sin_coeff (p - n) *\<^sub>R y^(p-n)))"
  3407     by (simp add: algebra_simps)
  3408   also have "\<dots> sums (sin x * sin y)"
  3409     using summable_norm_sin
  3410     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  3411   finally show ?thesis .
  3412 qed
  3413 
  3414 lemma sums_cos_x_plus_y:
  3415   fixes x :: "'a::{real_normed_field,banach}"
  3416   shows
  3417     "(\<lambda>p. \<Sum>n\<le>p.
  3418         if even p
  3419         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3420         else 0)
  3421       sums cos (x + y)"
  3422 proof -
  3423   have
  3424     "(\<Sum>n\<le>p.
  3425       if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3426       else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  3427     for p :: nat
  3428   proof -
  3429     have
  3430       "(\<Sum>n\<le>p. if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3431        (if even p then \<Sum>n\<le>p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  3432       by simp
  3433     also have "\<dots> =
  3434        (if even p
  3435         then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
  3436         else 0)"
  3437       by (auto simp: sum_distrib_left field_simps scaleR_conv_of_real nonzero_of_real_divide)
  3438     also have "\<dots> = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  3439       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real atLeast0AtMost)
  3440     finally show ?thesis .
  3441   qed
  3442   then have
  3443     "(\<lambda>p. \<Sum>n\<le>p.
  3444         if even p
  3445         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3446         else 0) = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
  3447     by simp
  3448    also have "\<dots> sums cos (x + y)"
  3449     by (rule cos_converges)
  3450    finally show ?thesis .
  3451 qed
  3452 
  3453 theorem cos_add:
  3454   fixes x :: "'a::{real_normed_field,banach}"
  3455   shows "cos (x + y) = cos x * cos y - sin x * sin y"
  3456 proof -
  3457   have
  3458     "(if even p \<and> even n
  3459       then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
  3460      (if even p \<and> odd n
  3461       then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3462      (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  3463     if "n \<le> p" for n p :: nat
  3464     by simp
  3465   then have
  3466     "(\<lambda>p. \<Sum>n\<le>p. (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0))
  3467       sums (cos x * cos y - sin x * sin y)"
  3468     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
  3469     by (simp add: sum_subtractf [symmetric])
  3470   then show ?thesis
  3471     by (blast intro: sums_cos_x_plus_y sums_unique2)
  3472 qed
  3473 
  3474 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin x"
  3475 proof -
  3476   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
  3477     by (auto simp: sin_coeff_def elim!: oddE)
  3478   show ?thesis
  3479     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
  3480 qed
  3481 
  3482 lemma sin_minus [simp]: "sin (- x) = - sin x"
  3483   for x :: "'a::{real_normed_algebra_1,banach}"
  3484   using sin_minus_converges [of x]
  3485   by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel]
  3486       suminf_minus sums_iff equation_minus_iff)
  3487 
  3488 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos x"
  3489 proof -
  3490   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
  3491     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
  3492   show ?thesis
  3493     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
  3494 qed
  3495 
  3496 lemma cos_minus [simp]: "cos (-x) = cos x"
  3497   for x :: "'a::{real_normed_algebra_1,banach}"
  3498   using cos_minus_converges [of x]
  3499   by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
  3500       suminf_minus sums_iff equation_minus_iff)
  3501 
  3502 lemma sin_cos_squared_add [simp]: "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
  3503   for x :: "'a::{real_normed_field,banach}"
  3504   using cos_add [of x "-x"]
  3505   by (simp add: power2_eq_square algebra_simps)
  3506 
  3507 lemma sin_cos_squared_add2 [simp]: "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
  3508   for x :: "'a::{real_normed_field,banach}"
  3509   by (subst add.commute, rule sin_cos_squared_add)
  3510 
  3511 lemma sin_cos_squared_add3 [simp]: "cos x * cos x + sin x * sin x = 1"
  3512   for x :: "'a::{real_normed_field,banach}"
  3513   using sin_cos_squared_add2 [unfolded power2_eq_square] .
  3514 
  3515 lemma sin_squared_eq: "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
  3516   for x :: "'a::{real_normed_field,banach}"
  3517   unfolding eq_diff_eq by (rule sin_cos_squared_add)
  3518 
  3519 lemma cos_squared_eq: "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
  3520   for x :: "'a::{real_normed_field,banach}"
  3521   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
  3522 
  3523 lemma abs_sin_le_one [simp]: "\<bar>sin x\<bar> \<le> 1"
  3524   for x :: real
  3525   by (rule power2_le_imp_le) (simp_all add: sin_squared_eq)
  3526 
  3527 lemma sin_ge_minus_one [simp]: "- 1 \<le> sin x"
  3528   for x :: real
  3529   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
  3530 
  3531 lemma sin_le_one [simp]: "sin x \<le> 1"
  3532   for x :: real
  3533   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
  3534 
  3535 lemma abs_cos_le_one [simp]: "\<bar>cos x\<bar> \<le> 1"
  3536   for x :: real
  3537   by (rule power2_le_imp_le) (simp_all add: cos_squared_eq)
  3538 
  3539 lemma cos_ge_minus_one [simp]: "- 1 \<le> cos x"
  3540   for x :: real
  3541   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
  3542 
  3543 lemma cos_le_one [simp]: "cos x \<le> 1"
  3544   for x :: real
  3545   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
  3546 
  3547 lemma cos_diff: "cos (x - y) = cos x * cos y + sin x * sin y"
  3548   for x :: "'a::{real_normed_field,banach}"
  3549   using cos_add [of x "- y"] by simp
  3550 
  3551 lemma cos_double: "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
  3552   for x :: "'a::{real_normed_field,banach}"
  3553   using cos_add [where x=x and y=x] by (simp add: power2_eq_square)
  3554 
  3555 lemma sin_cos_le1: "\<bar>sin x * sin y + cos x * cos y\<bar> \<le> 1"
  3556   for x :: real
  3557   using cos_diff [of x y] by (metis abs_cos_le_one add.commute)
  3558 
  3559 lemma DERIV_fun_pow: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  3560   by (auto intro!: derivative_eq_intros simp:)
  3561 
  3562 lemma DERIV_fun_exp: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. exp (g x)) x :> exp (g x) * m"
  3563   by (auto intro!: derivative_intros)
  3564 
  3565 
  3566 subsection \<open>The Constant Pi\<close>
  3567 
  3568 definition pi :: real
  3569   where "pi = 2 * (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
  3570 
  3571 text \<open>Show that there's a least positive @{term x} with @{term "cos x = 0"};
  3572    hence define pi.\<close>
  3573 
  3574 lemma sin_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
  3575   for x :: real
  3576 proof -
  3577   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
  3578     by (rule sums_group) (use sin_converges [of x, unfolded scaleR_conv_of_real] in auto)
  3579   then show ?thesis
  3580     by (simp add: sin_coeff_def ac_simps)
  3581 qed
  3582 
  3583 lemma sin_gt_zero_02:
  3584   fixes x :: real
  3585   assumes "0 < x" and "x < 2"
  3586   shows "0 < sin x"
  3587 proof -
  3588   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
  3589   have pos: "\<forall>n. 0 < ?f n"
  3590   proof
  3591     fix n :: nat
  3592     let ?k2 = "real (Suc (Suc (4 * n)))"
  3593     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
  3594     have "x * x < ?k2 * ?k3"
  3595       using assms by (intro mult_strict_mono', simp_all)
  3596     then have "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
  3597       by (intro mult_strict_right_mono zero_less_power \<open>0 < x\<close>)
  3598     then show "0 < ?f n"
  3599       by (simp add: divide_simps mult_ac del: mult_Suc)
  3600 qed
  3601   have sums: "?f sums sin x"
  3602     by (rule sin_paired [THEN sums_group]) simp
  3603   show "0 < sin x"
  3604     unfolding sums_unique [OF sums]
  3605     using sums_summable [OF sums] pos
  3606     by (rule suminf_pos)
  3607 qed
  3608 
  3609 lemma cos_double_less_one: "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
  3610   for x :: real
  3611   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
  3612 
  3613 lemma cos_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
  3614   for x :: real
  3615 proof -
  3616   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
  3617     by (rule sums_group) (use cos_converges [of x, unfolded scaleR_conv_of_real] in auto)
  3618   then show ?thesis
  3619     by (simp add: cos_coeff_def ac_simps)
  3620 qed
  3621 
  3622 lemmas realpow_num_eq_if = power_eq_if
  3623 
  3624 lemma sumr_pos_lt_pair:
  3625   fixes f :: "nat \<Rightarrow> real"
  3626   shows "summable f \<Longrightarrow>
  3627     (\<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc (Suc 0) * d) + 1))) \<Longrightarrow>
  3628     sum f {..<k} < suminf f"
  3629   apply (simp only: One_nat_def)
  3630   apply (subst suminf_split_initial_segment [where k=k])
  3631    apply assumption
  3632   apply simp
  3633   apply (drule_tac k=k in summable_ignore_initial_segment)
  3634   apply (drule_tac k="Suc (Suc 0)" in sums_group [OF summable_sums])
  3635    apply simp
  3636   apply simp
  3637   apply (metis (no_types, lifting) add.commute suminf_pos summable_def sums_unique)
  3638   done
  3639 
  3640 lemma cos_two_less_zero [simp]: "cos 2 < (0::real)"
  3641 proof -
  3642   note fact_Suc [simp del]
  3643   from sums_minus [OF cos_paired]
  3644   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
  3645     by simp
  3646   then have sm: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3647     by (rule sums_summable)
  3648   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3649     by (simp add: fact_num_eq_if realpow_num_eq_if)
  3650   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n)))) <
  3651     (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3652   proof -
  3653     {
  3654       fix d
  3655       let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
  3656       have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
  3657         unfolding of_nat_mult by (rule mult_strict_mono) (simp_all add: fact_less_mono)
  3658       then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
  3659         by (simp only: fact_Suc [of "Suc (?six4d)"] of_nat_mult of_nat_fact)
  3660       then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
  3661         by (simp add: inverse_eq_divide less_divide_eq)
  3662     }
  3663     then show ?thesis
  3664       by (force intro!: sumr_pos_lt_pair [OF sm] simp add: divide_inverse algebra_simps)
  3665   qed
  3666   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3667     by (rule order_less_trans)
  3668   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3669     by (rule sums_unique)
  3670   ultimately have "(0::real) < - cos 2" by simp
  3671   then show ?thesis by simp
  3672 qed
  3673 
  3674 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
  3675 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
  3676 
  3677 lemma cos_is_zero: "\<exists>!x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3678 proof (rule ex_ex1I)
  3679   show "\<exists>x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3680     by (rule IVT2) simp_all
  3681 next
  3682   fix x y :: real
  3683   assume x: "0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3684   assume y: "0 \<le> y \<and> y \<le> 2 \<and> cos y = 0"
  3685   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3686     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3687   from x y less_linear [of x y] show "x = y"
  3688     apply auto
  3689      apply (drule_tac f = cos in Rolle)
  3690         apply (drule_tac [5] f = cos in Rolle)
  3691            apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3692      apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3693     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3694     done
  3695 qed
  3696 
  3697 lemma pi_half: "pi/2 = (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
  3698   by (simp add: pi_def)
  3699 
  3700 lemma cos_pi_half [simp]: "cos (pi / 2) = 0"
  3701   by (simp add: pi_half cos_is_zero [THEN theI'])
  3702 
  3703 lemma cos_of_real_pi_half [simp]: "cos ((of_real pi / 2) :: 'a) = 0"
  3704   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
  3705   by (metis cos_pi_half cos_of_real eq_numeral_simps(4)
  3706       nonzero_of_real_divide of_real_0 of_real_numeral)
  3707 
  3708 lemma pi_half_gt_zero [simp]: "0 < pi / 2"
  3709   apply (rule order_le_neq_trans)
  3710    apply (simp add: pi_half cos_is_zero [THEN theI'])
  3711   apply (metis cos_pi_half cos_zero zero_neq_one)
  3712   done
  3713 
  3714 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
  3715 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
  3716 
  3717 lemma pi_half_less_two [simp]: "pi / 2 < 2"
  3718   apply (rule order_le_neq_trans)
  3719    apply (simp add: pi_half cos_is_zero [THEN theI'])
  3720   apply (metis cos_pi_half cos_two_neq_zero)
  3721   done
  3722 
  3723 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
  3724 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
  3725 
  3726 lemma pi_gt_zero [simp]: "0 < pi"
  3727   using pi_half_gt_zero by simp
  3728 
  3729 lemma pi_ge_zero [simp]: "0 \<le> pi"
  3730   by (rule pi_gt_zero [THEN order_less_imp_le])
  3731 
  3732 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
  3733   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
  3734 
  3735 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
  3736   by (simp add: linorder_not_less)
  3737 
  3738 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
  3739   by simp
  3740 
  3741 lemma m2pi_less_pi: "- (2*pi) < pi"
  3742   by simp
  3743 
  3744 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
  3745   using sin_cos_squared_add2 [where x = "pi/2"]
  3746   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
  3747   by (simp add: power2_eq_1_iff)
  3748 
  3749 lemma sin_of_real_pi_half [simp]: "sin ((of_real pi / 2) :: 'a) = 1"
  3750   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
  3751   using sin_pi_half
  3752   by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
  3753 
  3754 lemma sin_cos_eq: "sin x = cos (of_real pi / 2 - x)"
  3755   for x :: "'a::{real_normed_field,banach}"
  3756   by (simp add: cos_diff)
  3757 
  3758 lemma minus_sin_cos_eq: "- sin x = cos (x + of_real pi / 2)"
  3759   for x :: "'a::{real_normed_field,banach}"
  3760   by (simp add: cos_add nonzero_of_real_divide)
  3761 
  3762 lemma cos_sin_eq: "cos x = sin (of_real pi / 2 - x)"
  3763   for x :: "'a::{real_normed_field,banach}"
  3764   using sin_cos_eq [of "of_real pi / 2 - x"] by simp
  3765 
  3766 lemma sin_add: "sin (x + y) = sin x * cos y + cos x * sin y"
  3767   for x :: "'a::{real_normed_field,banach}"
  3768   using cos_add [of "of_real pi / 2 - x" "-y"]
  3769   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
  3770 
  3771 lemma sin_diff: "sin (x - y) = sin x * cos y - cos x * sin y"
  3772   for x :: "'a::{real_normed_field,banach}"
  3773   using sin_add [of x "- y"] by simp
  3774 
  3775 lemma sin_double: "sin(2 * x) = 2 * sin x * cos x"
  3776   for x :: "'a::{real_normed_field,banach}"
  3777   using sin_add [where x=x and y=x] by simp
  3778 
  3779 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
  3780   using cos_add [where x = "pi/2" and y = "pi/2"]
  3781   by (simp add: cos_of_real)
  3782 
  3783 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
  3784   using sin_add [where x = "pi/2" and y = "pi/2"]
  3785   by (simp add: sin_of_real)
  3786 
  3787 lemma cos_pi [simp]: "cos pi = -1"
  3788   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
  3789 
  3790 lemma sin_pi [simp]: "sin pi = 0"
  3791   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
  3792 
  3793 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
  3794   by (simp add: sin_add)
  3795 
  3796 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
  3797   by (simp add: sin_add)
  3798 
  3799 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
  3800   by (simp add: cos_add)
  3801 
  3802 lemma cos_periodic_pi2 [simp]: "cos (pi + x) = - cos x"
  3803   by (simp add: cos_add)
  3804 
  3805 lemma sin_periodic [simp]: "sin (x + 2 * pi) = sin x"
  3806   by (simp add: sin_add sin_double cos_double)
  3807 
  3808 lemma cos_periodic [simp]: "cos (x + 2 * pi) = cos x"
  3809   by (simp add: cos_add sin_double cos_double)
  3810 
  3811 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
  3812   by (induct n) (auto simp: distrib_right)
  3813 
  3814 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
  3815   by (metis cos_npi mult.commute)
  3816 
  3817 lemma sin_npi [simp]: "sin (real n * pi) = 0"
  3818   for n :: nat
  3819   by (induct n) (auto simp: distrib_right)
  3820 
  3821 lemma sin_npi2 [simp]: "sin (pi * real n) = 0"
  3822   for n :: nat
  3823   by (simp add: mult.commute [of pi])
  3824 
  3825 lemma cos_two_pi [simp]: "cos (2 * pi) = 1"
  3826   by (simp add: cos_double)
  3827 
  3828 lemma sin_two_pi [simp]: "sin (2 * pi) = 0"
  3829   by (simp add: sin_double)
  3830 
  3831 lemma sin_times_sin: "sin w * sin z = (cos (w - z) - cos (w + z)) / 2"
  3832   for w :: "'a::{real_normed_field,banach}"
  3833   by (simp add: cos_diff cos_add)
  3834 
  3835 lemma sin_times_cos: "sin w * cos z = (sin (w + z) + sin (w - z)) / 2"
  3836   for w :: "'a::{real_normed_field,banach}"
  3837   by (simp add: sin_diff sin_add)
  3838 
  3839 lemma cos_times_sin: "cos w * sin z = (sin (w + z) - sin (w - z)) / 2"
  3840   for w :: "'a::{real_normed_field,banach}"
  3841   by (simp add: sin_diff sin_add)
  3842 
  3843 lemma cos_times_cos: "cos w * cos z = (cos (w - z) + cos (w + z)) / 2"
  3844   for w :: "'a::{real_normed_field,banach}"
  3845   by (simp add: cos_diff cos_add)
  3846 
  3847 lemma sin_plus_sin: "sin w + sin z = 2 * sin ((w + z) / 2) * cos ((w - z) / 2)"
  3848   for w :: "'a::{real_normed_field,banach,field}"  (* FIXME field should not be necessary *)
  3849   apply (simp add: mult.assoc sin_times_cos)
  3850   apply (simp add: field_simps)
  3851   done
  3852 
  3853 lemma sin_diff_sin: "sin w - sin z = 2 * sin ((w - z) / 2) * cos ((w + z) / 2)"
  3854   for w :: "'a::{real_normed_field,banach,field}"
  3855   apply (simp add: mult.assoc sin_times_cos)
  3856   apply (simp add: field_simps)
  3857   done
  3858 
  3859 lemma cos_plus_cos: "cos w + cos z = 2 * cos ((w + z) / 2) * cos ((w - z) / 2)"
  3860   for w :: "'a::{real_normed_field,banach,field}"
  3861   apply (simp add: mult.assoc cos_times_cos)
  3862   apply (simp add: field_simps)
  3863   done
  3864 
  3865 lemma cos_diff_cos: "cos w - cos z = 2 * sin ((w + z) / 2) * sin ((z - w) / 2)"
  3866   for w :: "'a::{real_normed_field,banach,field}"
  3867   apply (simp add: mult.assoc sin_times_sin)
  3868   apply (simp add: field_simps)
  3869   done
  3870 
  3871 lemma cos_double_cos: "cos (2 * z) = 2 * cos z ^ 2 - 1"
  3872   for z :: "'a::{real_normed_field,banach}"
  3873   by (simp add: cos_double sin_squared_eq)
  3874 
  3875 lemma cos_double_sin: "cos (2 * z) = 1 - 2 * sin z ^ 2"
  3876   for z :: "'a::{real_normed_field,banach}"
  3877   by (simp add: cos_double sin_squared_eq)
  3878 
  3879 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
  3880   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
  3881 
  3882 lemma cos_pi_minus [simp]: "cos (pi - x) = - (cos x)"
  3883   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
  3884 
  3885 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
  3886   by (simp add: sin_diff)
  3887 
  3888 lemma cos_minus_pi [simp]: "cos (x - pi) = - (cos x)"
  3889   by (simp add: cos_diff)
  3890 
  3891 lemma sin_2pi_minus [simp]: "sin (2 * pi - x) = - (sin x)"
  3892   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
  3893 
  3894 lemma cos_2pi_minus [simp]: "cos (2 * pi - x) = cos x"
  3895   by (metis (no_types, hide_lams) cos_add cos_minus cos_two_pi sin_minus sin_two_pi
  3896       diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
  3897 
  3898 lemma sin_gt_zero2: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < sin x"
  3899   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
  3900 
  3901 lemma sin_less_zero:
  3902   assumes "- pi/2 < x" and "x < 0"
  3903   shows "sin x < 0"
  3904 proof -
  3905   have "0 < sin (- x)"
  3906     using assms by (simp only: sin_gt_zero2)
  3907   then show ?thesis by simp
  3908 qed
  3909 
  3910 lemma pi_less_4: "pi < 4"
  3911   using pi_half_less_two by auto
  3912 
  3913 lemma cos_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
  3914   by (simp add: cos_sin_eq sin_gt_zero2)
  3915 
  3916 lemma cos_gt_zero_pi: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
  3917   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
  3918   by (cases rule: linorder_cases [of x 0]) auto
  3919 
  3920 lemma cos_ge_zero: "-(pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> 0 \<le> cos x"
  3921   by (auto simp: order_le_less cos_gt_zero_pi)
  3922     (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
  3923 
  3924 lemma sin_gt_zero: "0 < x \<Longrightarrow> x < pi \<Longrightarrow> 0 < sin x"
  3925   by (simp add: sin_cos_eq cos_gt_zero_pi)
  3926 
  3927 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x < 0"
  3928   using sin_gt_zero [of "x - pi"]
  3929   by (simp add: sin_diff)
  3930 
  3931 lemma pi_ge_two: "2 \<le> pi"
  3932 proof (rule ccontr)
  3933   assume "\<not> ?thesis"
  3934   then have "pi < 2" by auto
  3935   have "\<exists>y > pi. y < 2 \<and> y < 2 * pi"
  3936   proof (cases "2 < 2 * pi")
  3937     case True
  3938     with dense[OF \<open>pi < 2\<close>] show ?thesis by auto
  3939   next
  3940     case False
  3941     have "pi < 2 * pi" by auto
  3942     from dense[OF this] and False show ?thesis by auto
  3943   qed
  3944   then obtain y where "pi < y" and "y < 2" and "y < 2 * pi"
  3945     by blast
  3946   then have "0 < sin y"
  3947     using sin_gt_zero_02 by auto
  3948   moreover have "sin y < 0"
  3949     using sin_gt_zero[of "y - pi"] \<open>pi < y\<close> and \<open>y < 2 * pi\<close> sin_periodic_pi[of "y - pi"]
  3950     by auto
  3951   ultimately show False by auto
  3952 qed
  3953 
  3954 lemma sin_ge_zero: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> sin x"
  3955   by (auto simp: order_le_less sin_gt_zero)
  3956 
  3957 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x \<le> 0"
  3958   using sin_ge_zero [of "x - pi"] by (simp add: sin_diff)
  3959 
  3960 lemma sin_pi_divide_n_ge_0 [simp]:
  3961   assumes "n \<noteq> 0"
  3962   shows "0 \<le> sin (pi / real n)"
  3963   by (rule sin_ge_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
  3964 
  3965 lemma sin_pi_divide_n_gt_0:
  3966   assumes "2 \<le> n"
  3967   shows "0 < sin (pi / real n)"
  3968   by (rule sin_gt_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
  3969 
  3970 (* FIXME: This proof is almost identical to lemma \<open>cos_is_zero\<close>.
  3971    It should be possible to factor out some of the common parts. *)
  3972 lemma cos_total:
  3973   assumes y: "- 1 \<le> y" "y \<le> 1"
  3974   shows "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
  3975 proof (rule ex_ex1I)
  3976   show "\<exists>x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
  3977     by (rule IVT2) (simp_all add: y)
  3978 next
  3979   fix a b
  3980   assume a: "0 \<le> a \<and> a \<le> pi \<and> cos a = y"
  3981   assume b: "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
  3982   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3983     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3984   from a b less_linear [of a b] show "a = b"
  3985     apply auto
  3986      apply (drule_tac f = cos in Rolle)
  3987         apply (drule_tac [5] f = cos in Rolle)
  3988            apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3989      apply (metis order_less_le_trans less_le sin_gt_zero)
  3990     apply (metis order_less_le_trans less_le sin_gt_zero)
  3991     done
  3992 qed
  3993 
  3994 lemma sin_total:
  3995   assumes y: "-1 \<le> y" "y \<le> 1"
  3996   shows "\<exists>!x. - (pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y"
  3997 proof -
  3998   from cos_total [OF y]
  3999   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
  4000     and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
  4001     by blast
  4002   show ?thesis
  4003     apply (simp add: sin_cos_eq)
  4004     apply (rule ex1I [where a="pi/2 - x"])
  4005      apply (cut_tac [2] x'="pi/2 - xa" in uniq)
  4006     using x
  4007         apply auto
  4008     done
  4009 qed
  4010 
  4011 lemma cos_zero_lemma:
  4012   assumes "0 \<le> x" "cos x = 0"
  4013   shows "\<exists>n. odd n \<and> x = of_nat n * (pi/2) \<and> n > 0"
  4014 proof -
  4015   have xle: "x < (1 + real_of_int \<lfloor>x/pi\<rfloor>) * pi"
  4016     using floor_correct [of "x/pi"]
  4017     by (simp add: add.commute divide_less_eq)
  4018   obtain n where "real n * pi \<le> x" "x < real (Suc n) * pi"
  4019     apply (rule that [of "nat \<lfloor>x/pi\<rfloor>"])
  4020     using assms
  4021      apply (simp_all add: xle)
  4022     apply (metis floor_less_iff less_irrefl mult_imp_div_pos_less not_le pi_gt_zero)
  4023     done
  4024   then have x: "0 \<le> x - n * pi" "(x - n * pi) \<le> pi" "cos (x - n * pi) = 0"
  4025     by (auto simp: algebra_simps cos_diff assms)
  4026   then have "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = 0"
  4027     by (auto simp: intro!: cos_total)
  4028   then obtain \<theta> where \<theta>: "0 \<le> \<theta>" "\<theta> \<le> pi" "cos \<theta> = 0"
  4029     and uniq: "\<And>\<phi>. 0 \<le> \<phi> \<Longrightarrow> \<phi> \<le> pi \<Longrightarrow> cos \<phi> = 0 \<Longrightarrow> \<phi> = \<theta>"
  4030     by blast
  4031   then have "x - real n * pi = \<theta>"
  4032     using x by blast
  4033   moreover have "pi/2 = \<theta>"
  4034     using pi_half_ge_zero uniq by fastforce
  4035   ultimately show ?thesis
  4036     by (rule_tac x = "Suc (2 * n)" in exI) (simp add: algebra_simps)
  4037 qed
  4038 
  4039 lemma sin_zero_lemma: "0 \<le> x \<Longrightarrow> sin x = 0 \<Longrightarrow> \<exists>n::nat. even n \<and> x = real n * (pi/2)"
  4040   using cos_zero_lemma [of "x + pi/2"]
  4041   apply (clarsimp simp add: cos_add)
  4042   apply (rule_tac x = "n - 1" in exI)
  4043   apply (simp add: algebra_simps of_nat_diff)
  4044   done
  4045 
  4046 lemma cos_zero_iff:
  4047   "cos x = 0 \<longleftrightarrow> ((\<exists>n. odd n \<and> x = real n * (pi/2)) \<or> (\<exists>n. odd n \<and> x = - (real n * (pi/2))))"
  4048   (is "?lhs = ?rhs")
  4049 proof -
  4050   have *: "cos (real n * pi / 2) = 0" if "odd n" for n :: nat
  4051   proof -
  4052     from that obtain m where "n = 2 * m + 1" ..
  4053     then show ?thesis
  4054       by (simp add: field_simps) (simp add: cos_add add_divide_distrib)
  4055   qed
  4056   show ?thesis
  4057   proof
  4058     show ?rhs if ?lhs
  4059       using that cos_zero_lemma [of x] cos_zero_lemma [of "-x"] by force
  4060     show ?lhs if ?rhs
  4061       using that by (auto dest: * simp del: eq_divide_eq_numeral1)
  4062   qed
  4063 qed
  4064 
  4065 lemma sin_zero_iff:
  4066   "sin x = 0 \<longleftrightarrow> ((\<exists>n. even n \<and> x = real n * (pi/2)) \<or> (\<exists>n. even n \<and> x = - (real n * (pi/2))))"
  4067   (is "?lhs = ?rhs")
  4068 proof
  4069   show ?rhs if ?lhs
  4070     using that sin_zero_lemma [of x] sin_zero_lemma [of "-x"] by force
  4071   show ?lhs if ?rhs
  4072     using that by (auto elim: evenE)
  4073 qed
  4074 
  4075 lemma cos_zero_iff_int: "cos x = 0 \<longleftrightarrow> (\<exists>n. odd n \<and> x = of_int n * (pi/2))"
  4076 proof safe
  4077   assume "cos x = 0"
  4078   then show "\<exists>n. odd n \<and> x = of_int n * (pi/2)"
  4079     apply (simp add: cos_zero_iff)
  4080     apply safe
  4081      apply (metis even_int_iff of_int_of_nat_eq)
  4082     apply (rule_tac x="- (int n)" in exI)
  4083     apply simp
  4084     done
  4085 next
  4086   fix n :: int
  4087   assume "odd n"
  4088   then show "cos (of_int n * (pi / 2)) = 0"
  4089     apply (simp add: cos_zero_iff)
  4090     apply (cases n rule: int_cases2)
  4091      apply simp_all
  4092     done
  4093 qed
  4094 
  4095 lemma sin_zero_iff_int: "sin x = 0 \<longleftrightarrow> (\<exists>n. even n \<and> x = of_int n * (pi/2))"
  4096 proof safe
  4097   assume "sin x = 0"
  4098   then show "\<exists>n. even n \<and> x = of_int n * (pi / 2)"
  4099     apply (simp add: sin_zero_iff)
  4100     apply safe
  4101      apply (metis even_int_iff of_int_of_nat_eq)
  4102     apply (rule_tac x="- (int n)" in exI)
  4103     apply simp
  4104     done
  4105 next
  4106   fix n :: int
  4107   assume "even n"
  4108   then show "sin (of_int n * (pi / 2)) = 0"
  4109     apply (simp add: sin_zero_iff)
  4110     apply (cases n rule: int_cases2)
  4111      apply simp_all
  4112     done
  4113 qed
  4114 
  4115 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>n::int. x = of_int n * pi)"
  4116   apply (simp only: sin_zero_iff_int)
  4117   apply (safe elim!: evenE)
  4118    apply (simp_all add: field_simps)
  4119   using dvd_triv_left apply fastforce
  4120   done
  4121 
  4122 lemma sin_npi_int [simp]: "sin (pi * of_int n) = 0"
  4123   by (simp add: sin_zero_iff_int2)
  4124 
  4125 lemma cos_monotone_0_pi:
  4126   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
  4127   shows "cos x < cos y"
  4128 proof -
  4129   have "- (x - y) < 0" using assms by auto
  4130   from MVT2[OF \<open>y < x\<close> DERIV_cos[THEN impI, THEN allI]]
  4131   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
  4132     by auto
  4133   then have "0 < z" and "z < pi"
  4134     using assms by auto
  4135   then have "0 < sin z"
  4136     using sin_gt_zero by auto
  4137   then have "cos x - cos y < 0"
  4138     unfolding cos_diff minus_mult_commute[symmetric]
  4139     using \<open>- (x - y) < 0\<close> by (rule mult_pos_neg2)
  4140   then show ?thesis by auto
  4141 qed
  4142 
  4143 lemma cos_monotone_0_pi_le:
  4144   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
  4145   shows "cos x \<le> cos y"
  4146 proof (cases "y < x")
  4147   case True
  4148   show ?thesis
  4149     using cos_monotone_0_pi[OF \<open>0 \<le> y\<close> True \<open>x \<le> pi\<close>] by auto
  4150 next
  4151   case False
  4152   then have "y = x" using \<open>y \<le> x\<close> by auto
  4153   then show ?thesis by auto
  4154 qed
  4155 
  4156 lemma cos_monotone_minus_pi_0:
  4157   assumes "- pi \<le> y" and "y < x" and "x \<le> 0"
  4158   shows "cos y < cos x"
  4159 proof -
  4160   have "0 \<le> - x" and "- x < - y" and "- y \<le> pi"
  4161     using assms by auto
  4162   from cos_monotone_0_pi[OF this] show ?thesis
  4163     unfolding cos_minus .
  4164 qed
  4165 
  4166 lemma cos_monotone_minus_pi_0':
  4167   assumes "- pi \<le> y" and "y \<le> x" and "x \<le> 0"
  4168   shows "cos y \<le> cos x"
  4169 proof (cases "y < x")
  4170   case True
  4171   show ?thesis using cos_monotone_minus_pi_0[OF \<open>-pi \<le> y\<close> True \<open>x \<le> 0\<close>]
  4172     by auto
  4173 next
  4174   case False
  4175   then have "y = x" using \<open>y \<le> x\<close> by auto
  4176   then show ?thesis by auto
  4177 qed
  4178 
  4179 lemma sin_monotone_2pi:
  4180   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
  4181   shows "sin y < sin x"
  4182   apply (simp add: sin_cos_eq)
  4183   apply (rule cos_monotone_0_pi)
  4184   using assms
  4185     apply auto
  4186   done
  4187 
  4188 lemma sin_monotone_2pi_le:
  4189   assumes "- (pi / 2) \<le> y" and "y \<le> x" and "x \<le> pi / 2"
  4190   shows "sin y \<le> sin x"
  4191   by (metis assms le_less sin_monotone_2pi)
  4192 
  4193 lemma sin_x_le_x:
  4194   fixes x :: real
  4195   assumes x: "x \<ge> 0"
  4196   shows "sin x \<le> x"
  4197 proof -
  4198   let ?f = "\<lambda>x. x - sin x"
  4199   from x have "?f x \<ge> ?f 0"
  4200     apply (rule DERIV_nonneg_imp_nondecreasing)
  4201     apply (intro allI impI exI[of _ "1 - cos x" for x])
  4202     apply (auto intro!: derivative_eq_intros simp: field_simps)
  4203     done
  4204   then show "sin x \<le> x" by simp
  4205 qed
  4206 
  4207 lemma sin_x_ge_neg_x:
  4208   fixes x :: real
  4209   assumes x: "x \<ge> 0"
  4210   shows "sin x \<ge> - x"
  4211 proof -
  4212   let ?f = "\<lambda>x. x + sin x"
  4213   from x have "?f x \<ge> ?f 0"
  4214     apply (rule DERIV_nonneg_imp_nondecreasing)
  4215     apply (intro allI impI exI[of _ "1 + cos x" for x])
  4216     apply (auto intro!: derivative_eq_intros simp: field_simps real_0_le_add_iff)
  4217     done
  4218   then show "sin x \<ge> -x" by simp
  4219 qed
  4220 
  4221 lemma abs_sin_x_le_abs_x: "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
  4222   for x :: real
  4223   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"]
  4224   by (auto simp: abs_real_def)
  4225 
  4226 
  4227 subsection \<open>More Corollaries about Sine and Cosine\<close>
  4228 
  4229 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi / 2) = (-1) ^ n"
  4230 proof -
  4231   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
  4232     by (auto simp: algebra_simps sin_add)
  4233   then show ?thesis
  4234     by (simp add: distrib_right add_divide_distrib add.commute mult.commute [of pi])
  4235 qed
  4236 
  4237 lemma cos_2npi [simp]: "cos (2 * real n * pi) = 1"
  4238   for n :: nat
  4239   by (cases "even n") (simp_all add: cos_double mult.assoc)
  4240 
  4241 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
  4242   apply (subgoal_tac "cos (pi + pi/2) = 0")
  4243    apply simp
  4244   apply (subst cos_add)
  4245   apply simp
  4246   done
  4247 
  4248 lemma sin_2npi [simp]: "sin (2 * real n * pi) = 0"
  4249   for n :: nat
  4250   by (auto simp: mult.assoc sin_double)
  4251 
  4252 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
  4253   apply (subgoal_tac "sin (pi + pi/2) = - 1")
  4254    apply simp
  4255   apply (subst sin_add)
  4256   apply simp
  4257   done
  4258 
  4259 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
  4260   by (simp only: cos_add sin_add of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
  4261 
  4262 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
  4263   by (auto intro!: derivative_eq_intros)
  4264 
  4265 lemma sin_zero_norm_cos_one:
  4266   fixes x :: "'a::{real_normed_field,banach}"
  4267   assumes "sin x = 0"
  4268   shows "norm (cos x) = 1"
  4269   using sin_cos_squared_add [of x, unfolded assms]
  4270   by (simp add: square_norm_one)
  4271 
  4272 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
  4273   using sin_zero_norm_cos_one by fastforce
  4274 
  4275 lemma cos_one_sin_zero:
  4276   fixes x :: "'a::{real_normed_field,banach}"
  4277   assumes "cos x = 1"
  4278   shows "sin x = 0"
  4279   using sin_cos_squared_add [of x, unfolded assms]
  4280   by simp
  4281 
  4282 lemma sin_times_pi_eq_0: "sin (x * pi) = 0 \<longleftrightarrow> x \<in> \<int>"
  4283   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_of_int)
  4284 
  4285 lemma cos_one_2pi: "cos x = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2 * pi) | (\<exists>n::nat. x = - (n * 2 * pi))"
  4286   (is "?lhs = ?rhs")
  4287 proof
  4288   assume ?lhs
  4289   then have "sin x = 0"
  4290     by (simp add: cos_one_sin_zero)
  4291   then show ?rhs
  4292   proof (simp only: sin_zero_iff, elim exE disjE conjE)
  4293     fix n :: nat
  4294     assume n: "even n" "x = real n * (pi/2)"
  4295     then obtain m where m: "n = 2 * m"
  4296       using dvdE by blast
  4297     then have me: "even m" using \<open>?lhs\<close> n
  4298       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  4299     show ?rhs
  4300       using m me n
  4301       by (auto simp: field_simps elim!: evenE)
  4302   next
  4303     fix n :: nat
  4304     assume n: "even n" "x = - (real n * (pi/2))"
  4305     then obtain m where m: "n = 2 * m"
  4306       using dvdE by blast
  4307     then have me: "even m" using \<open>?lhs\<close> n
  4308       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  4309     show ?rhs
  4310       using m me n
  4311       by (auto simp: field_simps elim!: evenE)
  4312   qed
  4313 next
  4314   assume ?rhs
  4315   then show "cos x = 1"
  4316     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
  4317 qed
  4318 
  4319 lemma cos_one_2pi_int: "cos x = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2 * pi)" (is "?lhs = ?rhs")
  4320 proof
  4321   assume "cos x = 1"
  4322   then show ?rhs
  4323     apply (auto simp: cos_one_2pi)
  4324      apply (metis of_int_of_nat_eq)
  4325     apply (metis mult_minus_right of_int_minus of_int_of_nat_eq)
  4326     done
  4327 next
  4328   assume ?rhs
  4329   then show "cos x = 1"
  4330     by (clarsimp simp add: cos_one_2pi) (metis mult_minus_right of_int_of_nat)
  4331 qed
  4332 
  4333 lemma cos_npi_int [simp]:
  4334   fixes n::int shows "cos (pi * of_int n) = (if even n then 1 else -1)"
  4335     by (auto simp: algebra_simps cos_one_2pi_int elim!: oddE evenE)
  4336 
  4337 lemma sin_cos_sqrt: "0 \<le> sin x \<Longrightarrow> sin x = sqrt (1 - (cos(x) ^ 2))"
  4338   using sin_squared_eq real_sqrt_unique by fastforce
  4339 
  4340 lemma sin_eq_0_pi: "- pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin x = 0 \<Longrightarrow> x = 0"
  4341   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
  4342 
  4343 lemma cos_treble_cos: "cos (3 * x) = 4 * cos x ^ 3 - 3 * cos x"
  4344   for x :: "'a::{real_normed_field,banach}"
  4345 proof -
  4346   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
  4347     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
  4348   have "cos(3 * x) = cos(2*x + x)"
  4349     by simp
  4350   also have "\<dots> = 4 * cos x ^ 3 - 3 * cos x"
  4351     apply (simp only: cos_add cos_double sin_double)
  4352     apply (simp add: * field_simps power2_eq_square power3_eq_cube)
  4353     done
  4354   finally show ?thesis .
  4355 qed
  4356 
  4357 lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
  4358 proof -
  4359   let ?c = "cos (pi / 4)"
  4360   let ?s = "sin (pi / 4)"
  4361   have nonneg: "0 \<le> ?c"
  4362     by (simp add: cos_ge_zero)
  4363   have "0 = cos (pi / 4 + pi / 4)"
  4364     by simp
  4365   also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
  4366     by (simp only: cos_add power2_eq_square)
  4367   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
  4368     by (simp add: sin_squared_eq)
  4369   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
  4370     by (simp add: power_divide)
  4371   then show ?thesis
  4372     using nonneg by (rule power2_eq_imp_eq) simp
  4373 qed
  4374 
  4375 lemma cos_30: "cos (pi / 6) = sqrt 3/2"
  4376 proof -
  4377   let ?c = "cos (pi / 6)"
  4378   let ?s = "sin (pi / 6)"
  4379   have pos_c: "0 < ?c"
  4380     by (rule cos_gt_zero) simp_all
  4381   have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
  4382     by simp
  4383   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
  4384     by (simp only: cos_add sin_add)
  4385   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
  4386     by (simp add: algebra_simps power2_eq_square)
  4387   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
  4388     using pos_c by (simp add: sin_squared_eq power_divide)
  4389   then show ?thesis
  4390     using pos_c [THEN order_less_imp_le]
  4391     by (rule power2_eq_imp_eq) simp
  4392 qed
  4393 
  4394 lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
  4395   by (simp add: sin_cos_eq cos_45)
  4396 
  4397 lemma sin_60: "sin (pi / 3) = sqrt 3/2"
  4398   by (simp add: sin_cos_eq cos_30)
  4399 
  4400 lemma cos_60: "cos (pi / 3) = 1 / 2"
  4401   apply (rule power2_eq_imp_eq)
  4402     apply (simp add: cos_squared_eq sin_60 power_divide)
  4403    apply (rule cos_ge_zero)
  4404     apply (rule order_trans [where y=0])
  4405      apply simp_all
  4406   done
  4407 
  4408 lemma sin_30: "sin (pi / 6) = 1 / 2"
  4409   by (simp add: sin_cos_eq cos_60)
  4410 
  4411 lemma cos_integer_2pi: "n \<in> \<int> \<Longrightarrow> cos(2 * pi * n) = 1"
  4412   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute)
  4413 
  4414 lemma sin_integer_2pi: "n \<in> \<int> \<Longrightarrow> sin(2 * pi * n) = 0"
  4415   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
  4416 
  4417 lemma cos_int_2npi [simp]: "cos (2 * of_int n * pi) = 1"
  4418   for n :: int
  4419   by (simp add: cos_one_2pi_int)
  4420 
  4421 lemma sin_int_2npi [simp]: "sin (2 * of_int n * pi) = 0"
  4422   for n :: int
  4423   by (metis Ints_of_int mult.assoc mult.commute sin_integer_2pi)
  4424 
  4425 lemma sincos_principal_value: "\<exists>y. (- pi < y \<and> y \<le> pi) \<and> (sin y = sin x \<and> cos y = cos x)"
  4426   apply (rule exI [where x="pi - (2 * pi) * frac ((pi - x) / (2 * pi))"])
  4427   apply (auto simp: field_simps frac_lt_1)
  4428    apply (simp_all add: frac_def divide_simps)
  4429    apply (simp_all add: add_divide_distrib diff_divide_distrib)
  4430    apply (simp_all add: sin_diff cos_diff mult.assoc [symmetric] cos_integer_2pi sin_integer_2pi)
  4431   done
  4432 
  4433 
  4434 subsection \<open>Tangent\<close>
  4435 
  4436 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4437   where "tan = (\<lambda>x. sin x / cos x)"
  4438 
  4439 lemma tan_of_real: "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
  4440   by (simp add: tan_def sin_of_real cos_of_real)
  4441 
  4442 lemma tan_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> tan z \<in> \<real>"
  4443   for z :: "'a::{real_normed_field,banach}"
  4444   by (simp add: tan_def)
  4445 
  4446 lemma tan_zero [simp]: "tan 0 = 0"
  4447   by (simp add: tan_def)
  4448 
  4449 lemma tan_pi [simp]: "tan pi = 0"
  4450   by (simp add: tan_def)
  4451 
  4452 lemma tan_npi [simp]: "tan (real n * pi) = 0"
  4453   for n :: nat
  4454   by (simp add: tan_def)
  4455 
  4456 lemma tan_minus [simp]: "tan (- x) = - tan x"
  4457   by (simp add: tan_def)
  4458 
  4459 lemma tan_periodic [simp]: "tan (x + 2 * pi) = tan x"
  4460   by (simp add: tan_def)
  4461 
  4462 lemma lemma_tan_add1: "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
  4463   by (simp add: tan_def cos_add field_simps)
  4464 
  4465 lemma add_tan_eq: "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> tan x + tan y = sin(x + y)/(cos x * cos y)"
  4466   for x :: "'a::{real_normed_field,banach}"
  4467   by (simp add: tan_def sin_add field_simps)
  4468 
  4469 lemma tan_add:
  4470   "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> cos (x + y) \<noteq> 0 \<Longrightarrow> tan (x + y) = (tan x + tan y)/(1 - tan x * tan y)"
  4471   for x :: "'a::{real_normed_field,banach}"
  4472   by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
  4473 
  4474 lemma tan_double: "cos x \<noteq> 0 \<Longrightarrow> cos (2 * x) \<noteq> 0 \<Longrightarrow> tan (2 * x) = (2 * tan x) / (1 - (tan x)\<^sup>2)"
  4475   for x :: "'a::{real_normed_field,banach}"
  4476   using tan_add [of x x] by (simp add: power2_eq_square)
  4477 
  4478 lemma tan_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < tan x"
  4479   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  4480 
  4481 lemma tan_less_zero:
  4482   assumes "- pi/2 < x" and "x < 0"
  4483   shows "tan x < 0"
  4484 proof -
  4485   have "0 < tan (- x)"
  4486     using assms by (simp only: tan_gt_zero)
  4487   then show ?thesis by simp
  4488 qed
  4489 
  4490 lemma tan_half: "tan x = sin (2 * x) / (cos (2 * x) + 1)"
  4491   for x :: "'a::{real_normed_field,banach,field}"
  4492   unfolding tan_def sin_double cos_double sin_squared_eq
  4493   by (simp add: power2_eq_square)
  4494 
  4495 lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
  4496   unfolding tan_def by (simp add: sin_30 cos_30)
  4497 
  4498 lemma tan_45: "tan (pi / 4) = 1"
  4499   unfolding tan_def by (simp add: sin_45 cos_45)
  4500 
  4501 lemma tan_60: "tan (pi / 3) = sqrt 3"
  4502   unfolding tan_def by (simp add: sin_60 cos_60)
  4503 
  4504 lemma DERIV_tan [simp]: "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
  4505   for x :: "'a::{real_normed_field,banach}"
  4506   unfolding tan_def
  4507   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
  4508 
  4509 lemma isCont_tan: "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
  4510   for x :: "'a::{real_normed_field,banach}"
  4511   by (rule DERIV_tan [THEN DERIV_isCont])
  4512 
  4513 lemma isCont_tan' [simp,continuous_intros]:
  4514   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  4515   shows "isCont f a \<Longrightarrow> cos (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
  4516   by (rule isCont_o2 [OF _ isCont_tan])
  4517 
  4518 lemma tendsto_tan [tendsto_intros]:
  4519   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4520   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cos a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tan (f x)) \<longlongrightarrow> tan a) F"
  4521   by (rule isCont_tendsto_compose [OF isCont_tan])
  4522 
  4523 lemma continuous_tan:
  4524   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4525   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
  4526   unfolding continuous_def by (rule tendsto_tan)
  4527 
  4528 lemma continuous_on_tan [continuous_intros]:
  4529   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4530   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
  4531   unfolding continuous_on_def by (auto intro: tendsto_tan)
  4532 
  4533 lemma continuous_within_tan [continuous_intros]:
  4534   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4535   shows "continuous (at x within s) f \<Longrightarrow>
  4536     cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
  4537   unfolding continuous_within by (rule tendsto_tan)
  4538 
  4539 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) \<midarrow>pi/2\<rightarrow> 0"
  4540   by (rule LIM_cong_limit, (rule tendsto_intros)+, simp_all)
  4541 
  4542 lemma lemma_tan_total: "0 < y \<Longrightarrow> \<exists>x. 0 < x \<and> x < pi/2 \<and> y < tan x"
  4543   apply (insert LIM_cos_div_sin)
  4544   apply (simp only: LIM_eq)
  4545   apply (drule_tac x = "inverse y" in spec)
  4546   apply safe
  4547    apply force
  4548   apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero])
  4549   apply safe
  4550   apply (rule_tac x = "(pi/2) - e" in exI)
  4551   apply (simp (no_asm_simp))
  4552   apply (drule_tac x = "(pi/2) - e" in spec)
  4553   apply (auto simp add: tan_def sin_diff cos_diff)
  4554   apply (rule inverse_less_iff_less [THEN iffD1])
  4555     apply (auto simp add: divide_inverse)
  4556    apply (rule mult_pos_pos)
  4557     apply (subgoal_tac [3] "0 < sin e \<and> 0 < cos e")
  4558      apply (auto intro: cos_gt_zero sin_gt_zero2 simp: mult.commute)
  4559   done
  4560 
  4561 lemma tan_total_pos: "0 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x < pi/2 \<and> tan x = y"
  4562   apply (frule order_le_imp_less_or_eq)
  4563   apply safe
  4564    prefer 2 apply force
  4565   apply (drule lemma_tan_total)
  4566   apply safe
  4567   apply (cut_tac f = tan and a = 0 and b = x and y = y in IVT_objl)
  4568   apply (auto intro!: DERIV_tan [THEN DERIV_isCont])
  4569   apply (drule_tac y = xa in order_le_imp_less_or_eq)
  4570   apply (auto dest: cos_gt_zero)
  4571   done
  4572 
  4573 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
  4574   apply (insert linorder_linear [of 0 y])
  4575   apply safe
  4576    apply (drule tan_total_pos)
  4577    apply (cut_tac [2] y="-y" in tan_total_pos)
  4578     apply safe
  4579     apply (rule_tac [3] x = "-x" in exI)
  4580     apply (auto del: exI intro!: exI)
  4581   done
  4582 
  4583 lemma tan_total: "\<exists>! x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
  4584   apply (insert lemma_tan_total1 [where y = y])
  4585   apply auto
  4586   apply hypsubst_thin
  4587   apply (cut_tac x = xa and y = y in linorder_less_linear)
  4588   apply auto
  4589    apply (subgoal_tac [2] "\<exists>z. y < z \<and> z < xa \<and> DERIV tan z :> 0")
  4590     apply (subgoal_tac "\<exists>z. xa < z \<and> z < y \<and> DERIV tan z :> 0")
  4591      apply (rule_tac [4] Rolle)
  4592         apply (rule_tac [2] Rolle)
  4593            apply (auto del: exI intro!: DERIV_tan DERIV_isCont exI
  4594             simp add: real_differentiable_def)
  4595        apply (rule_tac [!] DERIV_tan asm_rl)
  4596        apply (auto dest!: DERIV_unique [OF _ DERIV_tan]
  4597         simp add: cos_gt_zero_pi [THEN less_imp_neq, THEN not_sym])
  4598   done
  4599 
  4600 lemma tan_monotone:
  4601   assumes "- (pi / 2) < y" and "y < x" and "x < pi / 2"
  4602   shows "tan y < tan x"
  4603 proof -
  4604   have "\<forall>x'. y \<le> x' \<and> x' \<le> x \<longrightarrow> DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4605   proof (rule allI, rule impI)
  4606     fix x' :: real
  4607     assume "y \<le> x' \<and> x' \<le> x"
  4608     then have "-(pi/2) < x'" and "x' < pi/2"
  4609       using assms by auto
  4610     from cos_gt_zero_pi[OF this]
  4611     have "cos x' \<noteq> 0" by auto
  4612     then show "DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4613       by (rule DERIV_tan)
  4614   qed
  4615   from MVT2[OF \<open>y < x\<close> this]
  4616   obtain z where "y < z" and "z < x"
  4617     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
  4618   then have "- (pi / 2) < z" and "z < pi / 2"
  4619     using assms by auto
  4620   then have "0 < cos z"
  4621     using cos_gt_zero_pi by auto
  4622   then have inv_pos: "0 < inverse ((cos z)\<^sup>2)"
  4623     by auto
  4624   have "0 < x - y" using \<open>y < x\<close> by auto
  4625   with inv_pos have "0 < tan x - tan y"
  4626     unfolding tan_diff by auto
  4627   then show ?thesis by auto
  4628 qed
  4629 
  4630 lemma tan_monotone':
  4631   assumes "- (pi / 2) < y"
  4632     and "y < pi / 2"
  4633     and "- (pi / 2) < x"
  4634     and "x < pi / 2"
  4635   shows "y < x \<longleftrightarrow> tan y < tan x"
  4636 proof
  4637   assume "y < x"
  4638   then show "tan y < tan x"
  4639     using tan_monotone and \<open>- (pi / 2) < y\<close> and \<open>x < pi / 2\<close> by auto
  4640 next
  4641   assume "tan y < tan x"
  4642   show "y < x"
  4643   proof (rule ccontr)
  4644     assume "\<not> ?thesis"
  4645     then have "x \<le> y" by auto
  4646     then have "tan x \<le> tan y"
  4647     proof (cases "x = y")
  4648       case True
  4649       then show ?thesis by auto
  4650     next
  4651       case False
  4652       then have "x < y" using \<open>x \<le> y\<close> by auto
  4653       from tan_monotone[OF \<open>- (pi/2) < x\<close> this \<open>y < pi / 2\<close>] show ?thesis
  4654         by auto
  4655     qed
  4656     then show False
  4657       using \<open>tan y < tan x\<close> by auto
  4658   qed
  4659 qed
  4660 
  4661 lemma tan_inverse: "1 / (tan y) = tan (pi / 2 - y)"
  4662   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
  4663 
  4664 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
  4665   by (simp add: tan_def)
  4666 
  4667 lemma tan_periodic_nat[simp]: "tan (x + real n * pi) = tan x"
  4668   for n :: nat
  4669 proof (induct n arbitrary: x)
  4670   case 0
  4671   then show ?case by simp
  4672 next
  4673   case (Suc n)
  4674   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
  4675     unfolding Suc_eq_plus1 of_nat_add  distrib_right by auto
  4676   show ?case
  4677     unfolding split_pi_off using Suc by auto
  4678 qed
  4679 
  4680 lemma tan_periodic_int[simp]: "tan (x + of_int i * pi) = tan x"
  4681 proof (cases "0 \<le> i")
  4682   case True
  4683   then have i_nat: "of_int i = of_int (nat i)" by auto
  4684   show ?thesis unfolding i_nat
  4685     by (metis of_int_of_nat_eq tan_periodic_nat)
  4686 next
  4687   case False
  4688   then have i_nat: "of_int i = - of_int (nat (- i))" by auto
  4689   have "tan x = tan (x + of_int i * pi - of_int i * pi)"
  4690     by auto
  4691   also have "\<dots> = tan (x + of_int i * pi)"
  4692     unfolding i_nat mult_minus_left diff_minus_eq_add
  4693     by (metis of_int_of_nat_eq tan_periodic_nat)
  4694   finally show ?thesis by auto
  4695 qed
  4696 
  4697 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
  4698   using tan_periodic_int[of _ "numeral n" ] by simp
  4699 
  4700 lemma tan_minus_45: "tan (-(pi/4)) = -1"
  4701   unfolding tan_def by (simp add: sin_45 cos_45)
  4702 
  4703 lemma tan_diff:
  4704   "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> cos (x - y) \<noteq> 0 \<Longrightarrow> tan (x - y) = (tan x - tan y)/(1 + tan x * tan y)"
  4705   for x :: "'a::{real_normed_field,banach}"
  4706   using tan_add [of x "-y"] by simp
  4707 
  4708 lemma tan_pos_pi2_le: "0 \<le> x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
  4709   using less_eq_real_def tan_gt_zero by auto
  4710 
  4711 lemma cos_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> cos x = 1 / sqrt (1 + tan x ^ 2)"
  4712   using cos_gt_zero_pi [of x]
  4713   by (simp add: divide_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
  4714 
  4715 lemma sin_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> sin x = tan x / sqrt (1 + tan x ^ 2)"
  4716   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
  4717   by (force simp add: divide_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
  4718 
  4719 lemma tan_mono_le: "-(pi/2) < x \<Longrightarrow> x \<le> y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y"
  4720   using less_eq_real_def tan_monotone by auto
  4721 
  4722 lemma tan_mono_lt_eq:
  4723   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x < tan y \<longleftrightarrow> x < y"
  4724   using tan_monotone' by blast
  4725 
  4726 lemma tan_mono_le_eq:
  4727   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y \<longleftrightarrow> x \<le> y"
  4728   by (meson tan_mono_le not_le tan_monotone)
  4729 
  4730 lemma tan_bound_pi2: "\<bar>x\<bar> < pi/4 \<Longrightarrow> \<bar>tan x\<bar> < 1"
  4731   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
  4732   by (auto simp: abs_if split: if_split_asm)
  4733 
  4734 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
  4735   by (simp add: tan_def sin_diff cos_diff)
  4736 
  4737 
  4738 subsection \<open>Cotangent\<close>
  4739 
  4740 definition cot :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4741   where "cot = (\<lambda>x. cos x / sin x)"
  4742 
  4743 lemma cot_of_real: "of_real (cot x) = (cot (of_real x) :: 'a::{real_normed_field,banach})"
  4744   by (simp add: cot_def sin_of_real cos_of_real)
  4745 
  4746 lemma cot_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cot z \<in> \<real>"
  4747   for z :: "'a::{real_normed_field,banach}"
  4748   by (simp add: cot_def)
  4749 
  4750 lemma cot_zero [simp]: "cot 0 = 0"
  4751   by (simp add: cot_def)
  4752 
  4753 lemma cot_pi [simp]: "cot pi = 0"
  4754   by (simp add: cot_def)
  4755 
  4756 lemma cot_npi [simp]: "cot (real n * pi) = 0"
  4757   for n :: nat
  4758   by (simp add: cot_def)
  4759 
  4760 lemma cot_minus [simp]: "cot (- x) = - cot x"
  4761   by (simp add: cot_def)
  4762 
  4763 lemma cot_periodic [simp]: "cot (x + 2 * pi) = cot x"
  4764   by (simp add: cot_def)
  4765 
  4766 lemma cot_altdef: "cot x = inverse (tan x)"
  4767   by (simp add: cot_def tan_def)
  4768 
  4769 lemma tan_altdef: "tan x = inverse (cot x)"
  4770   by (simp add: cot_def tan_def)
  4771 
  4772 lemma tan_cot': "tan (pi/2 - x) = cot x"
  4773   by (simp add: tan_cot cot_altdef)
  4774 
  4775 lemma cot_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cot x"
  4776   by (simp add: cot_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  4777 
  4778 lemma cot_less_zero:
  4779   assumes lb: "- pi/2 < x" and "x < 0"
  4780   shows "cot x < 0"
  4781 proof -
  4782   have "0 < cot (- x)"
  4783     using assms by (simp only: cot_gt_zero)
  4784   then show ?thesis by simp
  4785 qed
  4786 
  4787 lemma DERIV_cot [simp]: "sin x \<noteq> 0 \<Longrightarrow> DERIV cot x :> -inverse ((sin x)\<^sup>2)"
  4788   for x :: "'a::{real_normed_field,banach}"
  4789   unfolding cot_def using cos_squared_eq[of x]
  4790   by (auto intro!: derivative_eq_intros) (simp add: divide_inverse power2_eq_square)
  4791 
  4792 lemma isCont_cot: "sin x \<noteq> 0 \<Longrightarrow> isCont cot x"
  4793   for x :: "'a::{real_normed_field,banach}"
  4794   by (rule DERIV_cot [THEN DERIV_isCont])
  4795 
  4796 lemma isCont_cot' [simp,continuous_intros]:
  4797   "isCont f a \<Longrightarrow> sin (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. cot (f x)) a"
  4798   for a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  4799   by (rule isCont_o2 [OF _ isCont_cot])
  4800 
  4801 lemma tendsto_cot [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> sin a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. cot (f x)) \<longlongrightarrow> cot a) F"
  4802   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4803   by (rule isCont_tendsto_compose [OF isCont_cot])
  4804 
  4805 lemma continuous_cot:
  4806   "continuous F f \<Longrightarrow> sin (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. cot (f x))"
  4807   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4808   unfolding continuous_def by (rule tendsto_cot)
  4809 
  4810 lemma continuous_on_cot [continuous_intros]:
  4811   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4812   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. sin (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. cot (f x))"
  4813   unfolding continuous_on_def by (auto intro: tendsto_cot)
  4814 
  4815 lemma continuous_within_cot [continuous_intros]:
  4816   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4817   shows "continuous (at x within s) f \<Longrightarrow> sin (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. cot (f x))"
  4818   unfolding continuous_within by (rule tendsto_cot)
  4819 
  4820 
  4821 subsection \<open>Inverse Trigonometric Functions\<close>
  4822 
  4823 definition arcsin :: "real \<Rightarrow> real"
  4824   where "arcsin y = (THE x. -(pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y)"
  4825 
  4826 definition arccos :: "real \<Rightarrow> real"
  4827   where "arccos y = (THE x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y)"
  4828 
  4829 definition arctan :: "real \<Rightarrow> real"
  4830   where "arctan y = (THE x. -(pi/2) < x \<and> x < pi/2 \<and> tan x = y)"
  4831 
  4832 lemma arcsin: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2 \<and> sin (arcsin y) = y"
  4833   unfolding arcsin_def by (rule theI' [OF sin_total])
  4834 
  4835 lemma arcsin_pi: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi \<and> sin (arcsin y) = y"
  4836   by (drule (1) arcsin) (force intro: order_trans)
  4837 
  4838 lemma sin_arcsin [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin (arcsin y) = y"
  4839   by (blast dest: arcsin)
  4840 
  4841 lemma arcsin_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2"
  4842   by (blast dest: arcsin)
  4843 
  4844 lemma arcsin_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y"
  4845   by (blast dest: arcsin)
  4846 
  4847 lemma arcsin_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
  4848   by (blast dest: arcsin)
  4849 
  4850 lemma arcsin_lt_bounded: "- 1 < y \<Longrightarrow> y < 1 \<Longrightarrow> - (pi/2) < arcsin y \<and> arcsin y < pi/2"
  4851   apply (frule order_less_imp_le)
  4852   apply (frule_tac y = y in order_less_imp_le)
  4853   apply (frule arcsin_bounded)
  4854    apply safe
  4855     apply simp
  4856    apply (drule_tac y = "arcsin y" in order_le_imp_less_or_eq)
  4857    apply (drule_tac [2] y = "pi/2" in order_le_imp_less_or_eq)
  4858    apply safe
  4859    apply (drule_tac [!] f = sin in arg_cong)
  4860    apply auto
  4861   done
  4862 
  4863 lemma arcsin_sin: "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> arcsin (sin x) = x"
  4864   apply (unfold arcsin_def)
  4865   apply (rule the1_equality)
  4866    apply (rule sin_total)
  4867     apply auto
  4868   done
  4869 
  4870 lemma arcsin_0 [simp]: "arcsin 0 = 0"
  4871   using arcsin_sin [of 0] by simp
  4872 
  4873 lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
  4874   using arcsin_sin [of "pi/2"] by simp
  4875 
  4876 lemma arcsin_minus_1 [simp]: "arcsin (- 1) = - (pi/2)"
  4877   using arcsin_sin [of "- pi/2"] by simp
  4878 
  4879 lemma arcsin_minus: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin (- x) = - arcsin x"
  4880   by (metis (no_types, hide_lams) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)
  4881 
  4882 lemma arcsin_eq_iff: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x = arcsin y \<longleftrightarrow> x = y"
  4883   by (metis abs_le_iff arcsin minus_le_iff)
  4884 
  4885 lemma cos_arcsin_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> cos (arcsin x) \<noteq> 0"
  4886   using arcsin_lt_bounded cos_gt_zero_pi by force
  4887 
  4888 lemma arccos: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi \<and> cos (arccos y) = y"
  4889   unfolding arccos_def by (rule theI' [OF cos_total])
  4890 
  4891 lemma cos_arccos [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  4892   by (blast dest: arccos)
  4893 
  4894 lemma arccos_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi"
  4895   by (blast dest: arccos)
  4896 
  4897 lemma arccos_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y"
  4898   by (blast dest: arccos)
  4899 
  4900 lemma arccos_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> pi"
  4901   by (blast dest: arccos)
  4902 
  4903 lemma arccos_lt_bounded: "- 1 < y \<Longrightarrow> y < 1 \<Longrightarrow> 0 < arccos y \<and> arccos y < pi"
  4904   apply (frule order_less_imp_le)
  4905   apply (frule_tac y = y in order_less_imp_le)
  4906   apply (frule arccos_bounded)
  4907    apply auto
  4908    apply (drule_tac y = "arccos y" in order_le_imp_less_or_eq)
  4909    apply (drule_tac [2] y = pi in order_le_imp_less_or_eq)
  4910    apply auto
  4911    apply (drule_tac [!] f = cos in arg_cong)
  4912    apply auto
  4913   done
  4914 
  4915 lemma arccos_cos: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> arccos (cos x) = x"
  4916   by (auto simp: arccos_def intro!: the1_equality cos_total)
  4917 
  4918 lemma arccos_cos2: "x \<le> 0 \<Longrightarrow> - pi \<le> x \<Longrightarrow> arccos (cos x) = -x"
  4919   by (auto simp: arccos_def intro!: the1_equality cos_total)
  4920 
  4921 lemma cos_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> cos (arcsin x) = sqrt (1 - x\<^sup>2)"
  4922   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4923    apply (rule power2_eq_imp_eq)
  4924      apply (simp add: cos_squared_eq)
  4925     apply (rule cos_ge_zero)
  4926      apply (erule (1) arcsin_lbound)
  4927     apply (erule (1) arcsin_ubound)
  4928    apply simp
  4929   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2")
  4930    apply simp
  4931   apply (rule power_mono)
  4932    apply simp
  4933   apply simp
  4934   done
  4935 
  4936 lemma sin_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> sin (arccos x) = sqrt (1 - x\<^sup>2)"
  4937   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4938    apply (rule power2_eq_imp_eq)
  4939      apply (simp add: sin_squared_eq)
  4940     apply (rule sin_ge_zero)
  4941      apply (erule (1) arccos_lbound)
  4942     apply (erule (1) arccos_ubound)
  4943    apply simp
  4944   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2")
  4945    apply simp
  4946   apply (rule power_mono)
  4947    apply simp
  4948   apply simp
  4949   done
  4950 
  4951 lemma arccos_0 [simp]: "arccos 0 = pi/2"
  4952   by (metis arccos_cos cos_gt_zero cos_pi cos_pi_half pi_gt_zero
  4953       pi_half_ge_zero not_le not_zero_less_neg_numeral numeral_One)
  4954 
  4955 lemma arccos_1 [simp]: "arccos 1 = 0"
  4956   using arccos_cos by force
  4957 
  4958 lemma arccos_minus_1 [simp]: "arccos (- 1) = pi"
  4959   by (metis arccos_cos cos_pi order_refl pi_ge_zero)
  4960 
  4961 lemma arccos_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos (- x) = pi - arccos x"
  4962   by (metis arccos_cos arccos_cos2 cos_minus_pi cos_total diff_le_0_iff_le le_add_same_cancel1
  4963       minus_diff_eq uminus_add_conv_diff)
  4964 
  4965 corollary arccos_minus_abs:
  4966   assumes "\<bar>x\<bar> \<le> 1"
  4967   shows "arccos (- x) = pi - arccos x"
  4968 using assms by (simp add: arccos_minus)
  4969 
  4970 lemma sin_arccos_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> sin (arccos x) \<noteq> 0"
  4971   using arccos_lt_bounded sin_gt_zero by force
  4972 
  4973 lemma arctan: "- (pi/2) < arctan y \<and> arctan y < pi/2 \<and> tan (arctan y) = y"
  4974   unfolding arctan_def by (rule theI' [OF tan_total])
  4975 
  4976 lemma tan_arctan: "tan (arctan y) = y"
  4977   by (simp add: arctan)
  4978 
  4979 lemma arctan_bounded: "- (pi/2) < arctan y \<and> arctan y < pi/2"
  4980   by (auto simp only: arctan)
  4981 
  4982 lemma arctan_lbound: "- (pi/2) < arctan y"
  4983   by (simp add: arctan)
  4984 
  4985 lemma arctan_ubound: "arctan y < pi/2"
  4986   by (auto simp only: arctan)
  4987 
  4988 lemma arctan_unique:
  4989   assumes "-(pi/2) < x"
  4990     and "x < pi/2"
  4991     and "tan x = y"
  4992   shows "arctan y = x"
  4993   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
  4994 
  4995 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
  4996   by (rule arctan_unique) simp_all
  4997 
  4998 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
  4999   by (rule arctan_unique) simp_all
  5000 
  5001 lemma arctan_minus: "arctan (- x) = - arctan x"
  5002   using arctan [of "x"] by (auto simp: arctan_unique)
  5003 
  5004 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
  5005   by (intro less_imp_neq [symmetric] cos_gt_zero_pi arctan_lbound arctan_ubound)
  5006 
  5007 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
  5008 proof (rule power2_eq_imp_eq)
  5009   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
  5010   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
  5011   show "0 \<le> cos (arctan x)"
  5012     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
  5013   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
  5014     unfolding tan_def by (simp add: distrib_left power_divide)
  5015   then show "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
  5016     using \<open>0 < 1 + x\<^sup>2\<close> by (simp add: arctan power_divide eq_divide_eq)
  5017 qed
  5018 
  5019 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
  5020   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
  5021   using tan_arctan [of x] unfolding tan_def cos_arctan
  5022   by (simp add: eq_divide_eq)
  5023 
  5024 lemma tan_sec: "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
  5025   for x :: "'a::{real_normed_field,banach,field}"
  5026   apply (rule power_inverse [THEN subst])
  5027   apply (rule_tac c1 = "(cos x)\<^sup>2" in mult_right_cancel [THEN iffD1])
  5028    apply (auto simp add: tan_def field_simps)
  5029   done
  5030 
  5031 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
  5032   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
  5033 
  5034 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
  5035   by (simp only: not_less [symmetric] arctan_less_iff)
  5036 
  5037 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
  5038   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
  5039 
  5040 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
  5041   using arctan_less_iff [of 0 x] by simp
  5042 
  5043 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
  5044   using arctan_less_iff [of x 0] by simp
  5045 
  5046 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
  5047   using arctan_le_iff [of 0 x] by simp
  5048 
  5049 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
  5050   using arctan_le_iff [of x 0] by simp
  5051 
  5052 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
  5053   using arctan_eq_iff [of x 0] by simp
  5054 
  5055 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
  5056 proof -
  5057   have "continuous_on (sin ` {- pi / 2 .. pi / 2}) arcsin"
  5058     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
  5059   also have "sin ` {- pi / 2 .. pi / 2} = {-1 .. 1}"
  5060   proof safe
  5061     fix x :: real
  5062     assume "x \<in> {-1..1}"
  5063     then show "x \<in> sin ` {- pi / 2..pi / 2}"
  5064       using arcsin_lbound arcsin_ubound
  5065       by (intro image_eqI[where x="arcsin x"]) auto
  5066   qed simp
  5067   finally show ?thesis .
  5068 qed
  5069 
  5070 lemma continuous_on_arcsin [continuous_intros]:
  5071   "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))"
  5072   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
  5073   by (auto simp: comp_def subset_eq)
  5074 
  5075 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
  5076   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  5077   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  5078 
  5079 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
  5080 proof -
  5081   have "continuous_on (cos ` {0 .. pi}) arccos"
  5082     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
  5083   also have "cos ` {0 .. pi} = {-1 .. 1}"
  5084   proof safe
  5085     fix x :: real
  5086     assume "x \<in> {-1..1}"
  5087     then show "x \<in> cos ` {0..pi}"
  5088       using arccos_lbound arccos_ubound
  5089       by (intro image_eqI[where x="arccos x"]) auto
  5090   qed simp
  5091   finally show ?thesis .
  5092 qed
  5093 
  5094 lemma continuous_on_arccos [continuous_intros]:
  5095   "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))"
  5096   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
  5097   by (auto simp: comp_def subset_eq)
  5098 
  5099 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
  5100   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  5101   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  5102 
  5103 lemma isCont_arctan: "isCont arctan x"
  5104   apply (rule arctan_lbound [of x, THEN dense, THEN exE])
  5105   apply clarify
  5106   apply (rule arctan_ubound [of x, THEN dense, THEN exE])
  5107   apply clarify
  5108   apply (subgoal_tac "isCont arctan (tan (arctan x))")
  5109    apply (simp add: arctan)
  5110   apply (erule (1) isCont_inverse_function2 [where f=tan])
  5111    apply (metis arctan_tan order_le_less_trans order_less_le_trans)
  5112   apply (metis cos_gt_zero_pi isCont_tan order_less_le_trans less_le)
  5113   done
  5114 
  5115 lemma tendsto_arctan [tendsto_intros]: "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) \<longlongrightarrow> arctan x) F"
  5116   by (rule isCont_tendsto_compose [OF isCont_arctan])
  5117 
  5118 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
  5119   unfolding continuous_def by (rule tendsto_arctan)
  5120 
  5121 lemma continuous_on_arctan [continuous_intros]:
  5122   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
  5123   unfolding continuous_on_def by (auto intro: tendsto_arctan)
  5124 
  5125 lemma DERIV_arcsin: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
  5126   apply (rule DERIV_inverse_function [where f=sin and a="-1" and b=1])
  5127        apply (rule DERIV_cong [OF DERIV_sin])
  5128        apply (simp add: cos_arcsin)
  5129       apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2")
  5130        apply simp
  5131       apply (rule power_strict_mono)
  5132         apply simp
  5133        apply simp
  5134       apply simp
  5135      apply assumption
  5136     apply assumption
  5137    apply simp
  5138   apply (erule (1) isCont_arcsin)
  5139   done
  5140 
  5141 lemma DERIV_arccos: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
  5142   apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
  5143        apply (rule DERIV_cong [OF DERIV_cos])
  5144        apply (simp add: sin_arccos)
  5145       apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2")
  5146        apply simp
  5147       apply (rule power_strict_mono)
  5148         apply simp
  5149        apply simp
  5150       apply simp
  5151      apply assumption
  5152     apply assumption
  5153    apply simp
  5154   apply (erule (1) isCont_arccos)
  5155   done
  5156 
  5157 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
  5158   apply (rule DERIV_inverse_function [where f=tan and a="x - 1" and b="x + 1"])
  5159        apply (rule DERIV_cong [OF DERIV_tan])
  5160         apply (rule cos_arctan_not_zero)
  5161        apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  5162    apply (simp add: arctan power_inverse [symmetric] tan_sec [symmetric])
  5163   apply (subgoal_tac "0 < 1 + x\<^sup>2")
  5164    apply simp
  5165   apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  5166   done
  5167 
  5168 declare
  5169   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
  5170   DERIV_arcsin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5171   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
  5172   DERIV_arccos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5173   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
  5174   DERIV_arctan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5175 
  5176 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- (pi/2)))"
  5177   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])
  5178      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  5179            intro!: tan_monotone exI[of _ "pi/2"])
  5180 
  5181 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
  5182   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])
  5183      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  5184            intro!: tan_monotone exI[of _ "pi/2"])
  5185 
  5186 lemma tendsto_arctan_at_top: "(arctan \<longlongrightarrow> (pi/2)) at_top"
  5187 proof (rule tendstoI)
  5188   fix e :: real
  5189   assume "0 < e"
  5190   define y where "y = pi/2 - min (pi/2) e"
  5191   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
  5192     using \<open>0 < e\<close> by auto
  5193   show "eventually (\<lambda>x. dist (arctan x) (pi / 2) < e) at_top"
  5194   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
  5195     fix x
  5196     assume "tan y < x"
  5197     then have "arctan (tan y) < arctan x"
  5198       by (simp add: arctan_less_iff)
  5199     with y have "y < arctan x"
  5200       by (subst (asm) arctan_tan) simp_all
  5201     with arctan_ubound[of x, arith] y \<open>0 < e\<close>
  5202     show "dist (arctan x) (pi / 2) < e"
  5203       by (simp add: dist_real_def)
  5204   qed
  5205 qed
  5206 
  5207 lemma tendsto_arctan_at_bot: "(arctan \<longlongrightarrow> - (pi/2)) at_bot"
  5208   unfolding filterlim_at_bot_mirror arctan_minus
  5209   by (intro tendsto_minus tendsto_arctan_at_top)
  5210 
  5211 
  5212 subsection \<open>Prove Totality of the Trigonometric Functions\<close>
  5213 
  5214 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  5215   by (simp add: abs_le_iff)
  5216 
  5217 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
  5218   by (simp add: sin_arccos abs_le_iff)
  5219 
  5220 lemma sin_mono_less_eq:
  5221   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x < sin y \<longleftrightarrow> x < y"
  5222   by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
  5223 
  5224 lemma sin_mono_le_eq:
  5225   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x \<le> sin y \<longleftrightarrow> x \<le> y"
  5226   by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
  5227 
  5228 lemma sin_inj_pi:
  5229   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x = sin y \<Longrightarrow> x = y"
  5230   by (metis arcsin_sin)
  5231 
  5232 lemma cos_mono_less_eq: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x < cos y \<longleftrightarrow> y < x"
  5233   by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
  5234 
  5235 lemma cos_mono_le_eq: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x \<le> cos y \<longleftrightarrow> y \<le> x"
  5236   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
  5237 
  5238 lemma cos_inj_pi: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x = cos y \<Longrightarrow> x = y"
  5239   by (metis arccos_cos)
  5240 
  5241 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
  5242   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
  5243       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
  5244 
  5245 lemma sincos_total_pi_half:
  5246   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  5247   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
  5248 proof -
  5249   have x1: "x \<le> 1"
  5250     using assms by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2)
  5251   with assms have *: "0 \<le> arccos x" "cos (arccos x) = x"
  5252     by (auto simp: arccos)
  5253   from assms have "y = sqrt (1 - x\<^sup>2)"
  5254     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
  5255   with x1 * assms arccos_le_pi2 [of x] show ?thesis
  5256     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
  5257 qed
  5258 
  5259 lemma sincos_total_pi:
  5260   assumes "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  5261   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
  5262 proof (cases rule: le_cases [of 0 x])
  5263   case le
  5264   from sincos_total_pi_half [OF le] show ?thesis
  5265     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
  5266 next
  5267   case ge
  5268   then have "0 \<le> -x"
  5269     by simp
  5270   then obtain t where t: "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
  5271     using sincos_total_pi_half assms
  5272     by auto (metis \<open>0 \<le> - x\<close> power2_minus)
  5273   show ?thesis
  5274     by (rule exI [where x = "pi -t"]) (use t in auto)
  5275 qed
  5276 
  5277 lemma sincos_total_2pi_le:
  5278   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  5279   shows "\<exists>t. 0 \<le> t \<and> t \<le> 2 * pi \<and> x = cos t \<and> y = sin t"
  5280 proof (cases rule: le_cases [of 0 y])
  5281   case le
  5282   from sincos_total_pi [OF le] show ?thesis
  5283     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
  5284 next
  5285   case ge
  5286   then have "0 \<le> -y"
  5287     by simp
  5288   then obtain t where t: "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
  5289     using sincos_total_pi assms
  5290     by auto (metis \<open>0 \<le> - y\<close> power2_minus)
  5291   show ?thesis
  5292     by (rule exI [where x = "2 * pi - t"]) (use t in auto)
  5293 qed
  5294 
  5295 lemma sincos_total_2pi:
  5296   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  5297   obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
  5298 proof -
  5299   from sincos_total_2pi_le [OF assms]
  5300   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
  5301     by blast
  5302   show ?thesis
  5303     by (cases "t = 2 * pi") (use t that in \<open>force+\<close>)
  5304 qed
  5305 
  5306 lemma arcsin_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x < arcsin y \<longleftrightarrow> x < y"
  5307   by (rule trans [OF sin_mono_less_eq [symmetric]]) (use arcsin_ubound arcsin_lbound in auto)
  5308 
  5309 lemma arcsin_le_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y \<longleftrightarrow> x \<le> y"
  5310   using arcsin_less_mono not_le by blast
  5311 
  5312 lemma arcsin_less_arcsin: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x < arcsin y"
  5313   using arcsin_less_mono by auto
  5314 
  5315 lemma arcsin_le_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y"
  5316   using arcsin_le_mono by auto
  5317 
  5318 lemma arccos_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x < arccos y \<longleftrightarrow> y < x"
  5319   by (rule trans [OF cos_mono_less_eq [symmetric]]) (use arccos_ubound arccos_lbound in auto)
  5320 
  5321 lemma arccos_le_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x \<le> arccos y \<longleftrightarrow> y \<le> x"
  5322   using arccos_less_mono [of y x] by (simp add: not_le [symmetric])
  5323 
  5324 lemma arccos_less_arccos: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y < arccos x"
  5325   using arccos_less_mono by auto
  5326 
  5327 lemma arccos_le_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> arccos x"
  5328   using arccos_le_mono by auto
  5329 
  5330 lemma arccos_eq_iff: "\<bar>x\<bar> \<le> 1 \<and> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x = arccos y \<longleftrightarrow> x = y"
  5331   using cos_arccos_abs by fastforce
  5332 
  5333 
  5334 subsection \<open>Machin's formula\<close>
  5335 
  5336 lemma arctan_one: "arctan 1 = pi / 4"
  5337   by (rule arctan_unique) (simp_all add: tan_45 m2pi_less_pi)
  5338 
  5339 lemma tan_total_pi4:
  5340   assumes "\<bar>x\<bar> < 1"
  5341   shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
  5342 proof
  5343   show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
  5344     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  5345     unfolding arctan_less_iff
  5346     using assms by (auto simp add: arctan)
  5347 qed
  5348 
  5349 lemma arctan_add:
  5350   assumes "\<bar>x\<bar> \<le> 1" "\<bar>y\<bar> < 1"
  5351   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
  5352 proof (rule arctan_unique [symmetric])
  5353   have "- (pi / 4) \<le> arctan x" "- (pi / 4) < arctan y"
  5354     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  5355     unfolding arctan_le_iff arctan_less_iff
  5356     using assms by auto
  5357   from add_le_less_mono [OF this] show 1: "- (pi / 2) < arctan x + arctan y"
  5358     by simp
  5359   have "arctan x \<le> pi / 4" "arctan y < pi / 4"
  5360     unfolding arctan_one [symmetric]
  5361     unfolding arctan_le_iff arctan_less_iff
  5362     using assms by auto
  5363   from add_le_less_mono [OF this] show 2: "arctan x + arctan y < pi / 2"
  5364     by simp
  5365   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
  5366     using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
  5367 qed
  5368 
  5369 lemma arctan_double: "\<bar>x\<bar> < 1 \<Longrightarrow> 2 * arctan x = arctan ((2 * x) / (1 - x\<^sup>2))"
  5370   by (metis arctan_add linear mult_2 not_less power2_eq_square)
  5371 
  5372 theorem machin: "pi / 4 = 4 * arctan (1 / 5) - arctan (1 / 239)"
  5373 proof -
  5374   have "\<bar>1 / 5\<bar> < (1 :: real)"
  5375     by auto
  5376   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (1 / 5) = arctan (5 / 12)"
  5377     by auto
  5378   moreover
  5379   have "\<bar>5 / 12\<bar> < (1 :: real)"
  5380     by auto
  5381   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (5 / 12) = arctan (120 / 119)"
  5382     by auto
  5383   moreover
  5384   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)"
  5385     by auto
  5386   from arctan_add[OF this] have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)"
  5387     by auto
  5388   ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)"
  5389     by auto
  5390   then show ?thesis
  5391     unfolding arctan_one by algebra
  5392 qed
  5393 
  5394 lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi / 4"
  5395 proof -
  5396   have 17: "\<bar>1 / 7\<bar> < (1 :: real)" by auto
  5397   with arctan_double have "2 * arctan (1 / 7) = arctan (7 / 24)"
  5398     by simp (simp add: field_simps)
  5399   moreover
  5400   have "\<bar>7 / 24\<bar> < (1 :: real)" by auto
  5401   with arctan_double have "2 * arctan (7 / 24) = arctan (336 / 527)"
  5402     by simp (simp add: field_simps)
  5403   moreover
  5404   have "\<bar>336 / 527\<bar> < (1 :: real)" by auto
  5405   from arctan_add[OF less_imp_le[OF 17] this]
  5406   have "arctan(1/7) + arctan (336 / 527) = arctan (2879 / 3353)"
  5407     by auto
  5408   ultimately have I: "5 * arctan (1 / 7) = arctan (2879 / 3353)" by auto
  5409   have 379: "\<bar>3 / 79\<bar> < (1 :: real)" by auto
  5410   with arctan_double have II: "2 * arctan (3 / 79) = arctan (237 / 3116)"
  5411     by simp (simp add: field_simps)
  5412   have *: "\<bar>2879 / 3353\<bar> < (1 :: real)" by auto
  5413   have "\<bar>237 / 3116\<bar> < (1 :: real)" by auto
  5414   from arctan_add[OF less_imp_le[OF *] this] have "arctan (2879/3353) + arctan (237/3116) = pi/4"
  5415     by (simp add: arctan_one)
  5416   with I II show ?thesis by auto
  5417 qed
  5418 
  5419 (*But could also prove MACHIN_GAUSS:
  5420   12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)
  5421 
  5422 
  5423 subsection \<open>Introducing the inverse tangent power series\<close>
  5424 
  5425 lemma monoseq_arctan_series:
  5426   fixes x :: real
  5427   assumes "\<bar>x\<bar> \<le> 1"
  5428   shows "monoseq (\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1))"
  5429     (is "monoseq ?a")
  5430 proof (cases "x = 0")
  5431   case True
  5432   then show ?thesis by (auto simp: monoseq_def)
  5433 next
  5434   case False
  5435   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
  5436     using assms by auto
  5437   show "monoseq ?a"
  5438   proof -
  5439     have mono: "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
  5440         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
  5441       if "0 \<le> x" and "x \<le> 1" for n and x :: real
  5442     proof (rule mult_mono)
  5443       show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
  5444         by (rule frac_le) simp_all
  5445       show "0 \<le> 1 / real (Suc (n * 2))"
  5446         by auto
  5447       show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
  5448         by (rule power_decreasing) (simp_all add: \<open>0 \<le> x\<close> \<open>x \<le> 1\<close>)
  5449       show "0 \<le> x ^ Suc (Suc n * 2)"
  5450         by (rule zero_le_power) (simp add: \<open>0 \<le> x\<close>)
  5451     qed
  5452     show ?thesis
  5453     proof (cases "0 \<le> x")
  5454       case True
  5455       from mono[OF this \<open>x \<le> 1\<close>, THEN allI]
  5456       show ?thesis
  5457         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI2)
  5458     next
  5459       case False
  5460       then have "0 \<le> - x" and "- x \<le> 1"
  5461         using \<open>-1 \<le> x\<close> by auto
  5462       from mono[OF this]
  5463       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
  5464           1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" for n
  5465         using \<open>0 \<le> -x\<close> by auto
  5466       then show ?thesis
  5467         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
  5468     qed
  5469   qed
  5470 qed
  5471 
  5472 lemma zeroseq_arctan_series:
  5473   fixes x :: real
  5474   assumes "\<bar>x\<bar> \<le> 1"
  5475   shows "(\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1)) \<longlonglongrightarrow> 0"
  5476     (is "?a \<longlonglongrightarrow> 0")
  5477 proof (cases "x = 0")
  5478   case True
  5479   then show ?thesis by simp
  5480 next
  5481   case False
  5482   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
  5483     using assms by auto
  5484   show "?a \<longlonglongrightarrow> 0"
  5485   proof (cases "\<bar>x\<bar> < 1")
  5486     case True
  5487     then have "norm x < 1" by auto
  5488     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF \<open>norm x < 1\<close>, THEN LIMSEQ_Suc]]
  5489     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) \<longlonglongrightarrow> 0"
  5490       unfolding inverse_eq_divide Suc_eq_plus1 by simp
  5491     then show ?thesis
  5492       using pos2 by (rule LIMSEQ_linear)
  5493   next
  5494     case False
  5495     then have "x = -1 \<or> x = 1"
  5496       using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5497     then have n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
  5498       unfolding One_nat_def by auto
  5499     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
  5500     show ?thesis
  5501       unfolding n_eq Suc_eq_plus1 by auto
  5502   qed
  5503 qed
  5504 
  5505 lemma summable_arctan_series:
  5506   fixes n :: nat
  5507   assumes "\<bar>x\<bar> \<le> 1"
  5508   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  5509     (is "summable (?c x)")
  5510   by (rule summable_Leibniz(1),
  5511       rule zeroseq_arctan_series[OF assms],
  5512       rule monoseq_arctan_series[OF assms])
  5513 
  5514 lemma DERIV_arctan_series:
  5515   assumes "\<bar>x\<bar> < 1"
  5516   shows "DERIV (\<lambda>x'. \<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x' ^ (k * 2 + 1))) x :>
  5517       (\<Sum>k. (-1)^k * x^(k * 2))"
  5518     (is "DERIV ?arctan _ :> ?Int")
  5519 proof -
  5520   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
  5521 
  5522   have n_even: "even n \<Longrightarrow> 2 * (n div 2) = n" for n :: nat
  5523     by presburger
  5524   then have if_eq: "?f n * real (Suc n) * x'^n =
  5525       (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
  5526     for n x'
  5527     by auto
  5528 
  5529   have summable_Integral: "summable (\<lambda> n. (- 1) ^ n * x^(2 * n))" if "\<bar>x\<bar> < 1" for x :: real
  5530   proof -
  5531     from that have "x\<^sup>2 < 1"
  5532       by (simp add: abs_square_less_1)
  5533     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
  5534       by (rule summable_Leibniz(1))
  5535         (auto intro!: LIMSEQ_realpow_zero monoseq_realpow \<open>x\<^sup>2 < 1\<close> order_less_imp_le[OF \<open>x\<^sup>2 < 1\<close>])
  5536     then show ?thesis
  5537       by (simp only: power_mult)
  5538   qed
  5539 
  5540   have sums_even: "op sums f = op sums (\<lambda> n. if even n then f (n div 2) else 0)"
  5541     for f :: "nat \<Rightarrow> real"
  5542   proof -
  5543     have "f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x" for x :: real
  5544     proof
  5545       assume "f sums x"
  5546       from sums_if[OF sums_zero this] show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
  5547         by auto
  5548     next
  5549       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
  5550       from LIMSEQ_linear[OF this[simplified sums_def] pos2, simplified sum_split_even_odd[simplified mult.commute]]
  5551       show "f sums x"
  5552         unfolding sums_def by auto
  5553     qed
  5554     then show ?thesis ..
  5555   qed
  5556 
  5557   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
  5558     unfolding if_eq mult.commute[of _ 2]
  5559       suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
  5560     by auto
  5561 
  5562   have arctan_eq: "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x" for x
  5563   proof -
  5564     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
  5565       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
  5566       using n_even by auto
  5567     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)"
  5568       by auto
  5569     then show ?thesis
  5570       unfolding if_eq' idx_eq suminf_def
  5571         sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
  5572       by auto
  5573   qed
  5574 
  5575   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum>n. ?f n * real (Suc n) * x^n)"
  5576   proof (rule DERIV_power_series')
  5577     show "x \<in> {- 1 <..< 1}"
  5578       using \<open>\<bar> x \<bar> < 1\<close> by auto
  5579     show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)"
  5580       if x'_bounds: "x' \<in> {- 1 <..< 1}" for x' :: real
  5581     proof -
  5582       from that have "\<bar>x'\<bar> < 1" by auto
  5583       then have *: "summable (\<lambda>n. (- 1) ^ n * x' ^ (2 * n))"
  5584         by (rule summable_Integral)
  5585       show ?thesis
  5586         unfolding if_eq
  5587         apply (rule sums_summable [where l="0 + (\<Sum>n. (-1)^n * x'^(2 * n))"])
  5588         apply (rule sums_if)
  5589          apply (rule sums_zero)
  5590         apply (rule summable_sums)
  5591         apply (rule *)
  5592         done
  5593     qed
  5594   qed auto
  5595   then show ?thesis
  5596     by (simp only: Int_eq arctan_eq)
  5597 qed
  5598 
  5599 lemma arctan_series:
  5600   assumes "\<bar>x\<bar> \<le> 1"
  5601   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x ^ (k * 2 + 1)))"
  5602     (is "_ = suminf (\<lambda> n. ?c x n)")
  5603 proof -
  5604   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
  5605 
  5606   have DERIV_arctan_suminf: "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))"
  5607     if "0 < r" and "r < 1" and "\<bar>x\<bar> < r" for r x :: real
  5608   proof (rule DERIV_arctan_series)
  5609     from that show "\<bar>x\<bar> < 1"
  5610       using \<open>r < 1\<close> and \<open>\<bar>x\<bar> < r\<close> by auto
  5611   qed
  5612 
  5613   {
  5614     fix x :: real
  5615     assume "\<bar>x\<bar> \<le> 1"
  5616     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
  5617   } note arctan_series_borders = this
  5618 
  5619   have when_less_one: "arctan x = (\<Sum>k. ?c x k)" if "\<bar>x\<bar> < 1" for x :: real
  5620   proof -
  5621     obtain r where "\<bar>x\<bar> < r" and "r < 1"
  5622       using dense[OF \<open>\<bar>x\<bar> < 1\<close>] by blast
  5623     then have "0 < r" and "- r < x" and "x < r" by auto
  5624 
  5625     have suminf_eq_arctan_bounded: "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  5626       if "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b" for x a b
  5627     proof -
  5628       from that have "\<bar>x\<bar> < r" by auto
  5629       show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  5630       proof (rule DERIV_isconst2[of "a" "b"])
  5631         show "a < b" and "a \<le> x" and "x \<le> b"
  5632           using \<open>a < b\<close> \<open>a \<le> x\<close> \<open>x \<le> b\<close> by auto
  5633         have "\<forall>x. - r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  5634         proof (rule allI, rule impI)
  5635           fix x
  5636           assume "-r < x \<and> x < r"
  5637           then have "\<bar>x\<bar> < r" by auto
  5638           with \<open>r < 1\<close> have "\<bar>x\<bar> < 1" by auto
  5639           have "\<bar>- (x\<^sup>2)\<bar> < 1" using abs_square_less_1 \<open>\<bar>x\<bar> < 1\<close> by auto
  5640           then have "(\<lambda>n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
  5641             unfolding real_norm_def[symmetric] by (rule geometric_sums)
  5642           then have "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
  5643             unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
  5644           then have suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
  5645             using sums_unique unfolding inverse_eq_divide by auto
  5646           have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
  5647             unfolding suminf_c'_eq_geom
  5648             by (rule DERIV_arctan_suminf[OF \<open>0 < r\<close> \<open>r < 1\<close> \<open>\<bar>x\<bar> < r\<close>])
  5649           from DERIV_diff [OF this DERIV_arctan] show "DERIV (\<lambda>x. suminf (?c x) - arctan x) x :> 0"
  5650             by auto
  5651         qed
  5652         then have DERIV_in_rball: "\<forall>y. a \<le> y \<and> y \<le> b \<longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
  5653           using \<open>-r < a\<close> \<open>b < r\<close> by auto
  5654         then show "\<forall>y. a < y \<and> y < b \<longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
  5655           using \<open>\<bar>x\<bar> < r\<close> by auto
  5656         show "\<forall>y. a \<le> y \<and> y \<le> b \<longrightarrow> isCont (\<lambda>x. suminf (?c x) - arctan x) y"
  5657           using DERIV_in_rball DERIV_isCont by auto
  5658       qed
  5659     qed
  5660 
  5661     have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
  5662       unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
  5663       by auto
  5664 
  5665     have "suminf (?c x) - arctan x = 0"
  5666     proof (cases "x = 0")
  5667       case True
  5668       then show ?thesis
  5669         using suminf_arctan_zero by auto
  5670     next
  5671       case False
  5672       then have "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>"
  5673         by auto
  5674       have "suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>) = suminf (?c 0) - arctan 0"
  5675         by (rule suminf_eq_arctan_bounded[where x1="0" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
  5676           (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5677       moreover
  5678       have "suminf (?c x) - arctan x = suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>)"
  5679         by (rule suminf_eq_arctan_bounded[where x1="x" and a1="- \<bar>x\<bar>" and b1="\<bar>x\<bar>"])
  5680            (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>- \<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5681       ultimately show ?thesis
  5682         using suminf_arctan_zero by auto
  5683     qed
  5684     then show ?thesis by auto
  5685   qed
  5686 
  5687   show "arctan x = suminf (\<lambda>n. ?c x n)"
  5688   proof (cases "\<bar>x\<bar> < 1")
  5689     case True
  5690     then show ?thesis by (rule when_less_one)
  5691   next
  5692     case False
  5693     then have "\<bar>x\<bar> = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5694     let ?a = "\<lambda>x n. \<bar>1 / real (n * 2 + 1) * x^(n * 2 + 1)\<bar>"
  5695     let ?diff = "\<lambda>x n. \<bar>arctan x - (\<Sum>i<n. ?c x i)\<bar>"
  5696     have "?diff 1 n \<le> ?a 1 n" for n :: nat
  5697     proof -
  5698       have "0 < (1 :: real)" by auto
  5699       moreover
  5700       have "?diff x n \<le> ?a x n" if "0 < x" and "x < 1" for x :: real
  5701       proof -
  5702         from that have "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1"
  5703           by auto
  5704         from \<open>0 < x\<close> have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
  5705           by auto
  5706         note bounds = mp[OF arctan_series_borders(2)[OF \<open>\<bar>x\<bar> \<le> 1\<close>] this, unfolded when_less_one[OF \<open>\<bar>x\<bar> < 1\<close>, symmetric], THEN spec]
  5707         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
  5708           by (rule mult_pos_pos) (simp_all only: zero_less_power[OF \<open>0 < x\<close>], auto)
  5709         then have a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
  5710           by (rule abs_of_pos)
  5711         show ?thesis
  5712         proof (cases "even n")
  5713           case True
  5714           then have sgn_pos: "(-1)^n = (1::real)" by auto
  5715           from \<open>even n\<close> obtain m where "n = 2 * m" ..
  5716           then have "2 * m = n" ..
  5717           from bounds[of m, unfolded this atLeastAtMost_iff]
  5718           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))"
  5719             by auto
  5720           also have "\<dots> = ?c x n" by auto
  5721           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
  5722           finally show ?thesis .
  5723         next
  5724           case False
  5725           then have sgn_neg: "(-1)^n = (-1::real)" by auto
  5726           from \<open>odd n\<close> obtain m where "n = 2 * m + 1" ..
  5727           then have m_def: "2 * m + 1 = n" ..
  5728           then have m_plus: "2 * (m + 1) = n + 1" by auto
  5729           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
  5730           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))" by auto
  5731           also have "\<dots> = - ?c x n" by auto
  5732           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
  5733           finally show ?thesis .
  5734         qed
  5735       qed
  5736       hence "\<forall>x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
  5737       moreover have "isCont (\<lambda> x. ?a x n - ?diff x n) x" for x
  5738         unfolding diff_conv_add_uminus divide_inverse
  5739         by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
  5740           isCont_inverse isCont_mult isCont_power continuous_const isCont_sum
  5741           simp del: add_uminus_conv_diff)
  5742       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
  5743         by (rule LIM_less_bound)
  5744       then show ?thesis by auto
  5745     qed
  5746     have "?a 1 \<longlonglongrightarrow> 0"
  5747       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
  5748       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat simp del: of_nat_Suc)
  5749     have "?diff 1 \<longlonglongrightarrow> 0"
  5750     proof (rule LIMSEQ_I)
  5751       fix r :: real
  5752       assume "0 < r"
  5753       obtain N :: nat where N_I: "N \<le> n \<Longrightarrow> ?a 1 n < r" for n
  5754         using LIMSEQ_D[OF \<open>?a 1 \<longlonglongrightarrow> 0\<close> \<open>0 < r\<close>] by auto
  5755       have "norm (?diff 1 n - 0) < r" if "N \<le> n" for n
  5756         using \<open>?diff 1 n \<le> ?a 1 n\<close> N_I[OF that] by auto
  5757       then show "\<exists>N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
  5758     qed
  5759     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
  5760     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
  5761     then have "arctan 1 = (\<Sum>i. ?c 1 i)" by (rule sums_unique)
  5762 
  5763     show ?thesis
  5764     proof (cases "x = 1")
  5765       case True
  5766       then show ?thesis by (simp add: \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close>)
  5767     next
  5768       case False
  5769       then have "x = -1" using \<open>\<bar>x\<bar> = 1\<close> by auto
  5770 
  5771       have "- (pi / 2) < 0" using pi_gt_zero by auto
  5772       have "- (2 * pi) < 0" using pi_gt_zero by auto
  5773 
  5774       have c_minus_minus: "?c (- 1) i = - ?c 1 i" for i by auto
  5775 
  5776       have "arctan (- 1) = arctan (tan (-(pi / 4)))"
  5777         unfolding tan_45 tan_minus ..
  5778       also have "\<dots> = - (pi / 4)"
  5779         by (rule arctan_tan) (auto simp: order_less_trans[OF \<open>- (pi / 2) < 0\<close> pi_gt_zero])
  5780       also have "\<dots> = - (arctan (tan (pi / 4)))"
  5781         unfolding neg_equal_iff_equal
  5782         by (rule arctan_tan[symmetric]) (auto simp: order_less_trans[OF \<open>- (2 * pi) < 0\<close> pi_gt_zero])
  5783       also have "\<dots> = - (arctan 1)"
  5784         unfolding tan_45 ..
  5785       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
  5786         using \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close> by auto
  5787       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
  5788         using suminf_minus[OF sums_summable[OF \<open>(?c 1) sums (arctan 1)\<close>]]
  5789         unfolding c_minus_minus by auto
  5790       finally show ?thesis using \<open>x = -1\<close> by auto
  5791     qed
  5792   qed
  5793 qed
  5794 
  5795 lemma arctan_half: "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
  5796   for x :: real
  5797 proof -
  5798   obtain y where low: "- (pi / 2) < y" and high: "y < pi / 2" and y_eq: "tan y = x"
  5799     using tan_total by blast
  5800   then have low2: "- (pi / 2) < y / 2" and high2: "y / 2 < pi / 2"
  5801     by auto
  5802 
  5803   have "0 < cos y" by (rule cos_gt_zero_pi[OF low high])
  5804   then have "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
  5805     by auto
  5806 
  5807   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5808     unfolding tan_def power_divide ..
  5809   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5810     using \<open>cos y \<noteq> 0\<close> by auto
  5811   also have "\<dots> = 1 / (cos y)\<^sup>2"
  5812     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
  5813   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
  5814 
  5815   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
  5816     unfolding tan_def using \<open>cos y \<noteq> 0\<close> by (simp add: field_simps)
  5817   also have "\<dots> = tan y / (1 + 1 / cos y)"
  5818     using \<open>cos y \<noteq> 0\<close> unfolding add_divide_distrib by auto
  5819   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
  5820     unfolding cos_sqrt ..
  5821   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
  5822     unfolding real_sqrt_divide by auto
  5823   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
  5824     unfolding \<open>1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2\<close> .
  5825 
  5826   have "arctan x = y"
  5827     using arctan_tan low high y_eq by auto
  5828   also have "\<dots> = 2 * (arctan (tan (y/2)))"
  5829     using arctan_tan[OF low2 high2] by auto
  5830   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
  5831     unfolding tan_half by auto
  5832   finally show ?thesis
  5833     unfolding eq \<open>tan y = x\<close> .
  5834 qed
  5835 
  5836 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
  5837   by (simp only: arctan_less_iff)
  5838 
  5839 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
  5840   by (simp only: arctan_le_iff)
  5841 
  5842 lemma arctan_inverse:
  5843   assumes "x \<noteq> 0"
  5844   shows "arctan (1 / x) = sgn x * pi / 2 - arctan x"
  5845 proof (rule arctan_unique)
  5846   show "- (pi / 2) < sgn x * pi / 2 - arctan x"
  5847     using arctan_bounded [of x] assms
  5848     unfolding sgn_real_def
  5849     apply (auto simp add: arctan algebra_simps)
  5850     apply (drule zero_less_arctan_iff [THEN iffD2])
  5851     apply arith
  5852     done
  5853   show "sgn x * pi / 2 - arctan x < pi / 2"
  5854     using arctan_bounded [of "- x"] assms
  5855     unfolding sgn_real_def arctan_minus
  5856     by (auto simp add: algebra_simps)
  5857   show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
  5858     unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
  5859     unfolding sgn_real_def
  5860     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
  5861 qed
  5862 
  5863 theorem pi_series: "pi / 4 = (\<Sum>k. (-1)^k * 1 / real (k * 2 + 1))"
  5864   (is "_ = ?SUM")
  5865 proof -
  5866   have "pi / 4 = arctan 1"
  5867     using arctan_one by auto
  5868   also have "\<dots> = ?SUM"
  5869     using arctan_series[of 1] by auto
  5870   finally show ?thesis by auto
  5871 qed
  5872 
  5873 
  5874 subsection \<open>Existence of Polar Coordinates\<close>
  5875 
  5876 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
  5877   by (rule power2_le_imp_le [OF _ zero_le_one])
  5878     (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
  5879 
  5880 lemmas cos_arccos_lemma1 = cos_arccos_abs [OF cos_x_y_le_one]
  5881 
  5882 lemmas sin_arccos_lemma1 = sin_arccos_abs [OF cos_x_y_le_one]
  5883 
  5884 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a \<and> y = r * sin a"
  5885 proof -
  5886   have polar_ex1: "0 < y \<Longrightarrow> \<exists>r a. x = r * cos a \<and> y = r * sin a" for y
  5887     apply (rule exI [where x = "sqrt (x\<^sup>2 + y\<^sup>2)"])
  5888     apply (rule exI [where x = "arccos (x / sqrt (x\<^sup>2 + y\<^sup>2))"])
  5889     apply (simp add: cos_arccos_lemma1 sin_arccos_lemma1 power_divide
  5890         real_sqrt_mult [symmetric] right_diff_distrib)
  5891     done
  5892   show ?thesis
  5893   proof (cases "0::real" y rule: linorder_cases)
  5894     case less
  5895     then show ?thesis
  5896       by (rule polar_ex1)
  5897   next
  5898     case equal
  5899     then show ?thesis
  5900       by (force simp add: intro!: cos_zero sin_zero)
  5901   next
  5902     case greater
  5903     with polar_ex1 [where y="-y"] show ?thesis
  5904       by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
  5905   qed
  5906 qed
  5907 
  5908 
  5909 subsection \<open>Basics about polynomial functions: products, extremal behaviour and root counts\<close>
  5910 
  5911 lemma pairs_le_eq_Sigma: "{(i, j). i + j \<le> m} = Sigma (atMost m) (\<lambda>r. atMost (m - r))"
  5912   for m :: nat
  5913   by auto
  5914 
  5915 lemma sum_up_index_split: "(\<Sum>k\<le>m + n. f k) = (\<Sum>k\<le>m. f k) + (\<Sum>k = Suc m..m + n. f k)"
  5916   by (metis atLeast0AtMost Suc_eq_plus1 le0 sum_ub_add_nat)
  5917 
  5918 lemma Sigma_interval_disjoint: "(SIGMA i:A. {..v i}) \<inter> (SIGMA i:A.{v i<..w}) = {}"
  5919   for w :: "'a::order"
  5920   by auto
  5921 
  5922 lemma product_atMost_eq_Un: "A \<times> {..m} = (SIGMA i:A.{..m - i}) \<union> (SIGMA i:A.{m - i<..m})"
  5923   for m :: nat
  5924   by auto
  5925 
  5926 lemma polynomial_product: (*with thanks to Chaitanya Mangla*)
  5927   fixes x :: "'a::idom"
  5928   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
  5929     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
  5930   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
  5931     (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5932 proof -
  5933   have "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) = (\<Sum>i\<le>m. \<Sum>j\<le>n. (a i * x ^ i) * (b j * x ^ j))"
  5934     by (rule sum_product)
  5935   also have "\<dots> = (\<Sum>i\<le>m + n. \<Sum>j\<le>n + m. a i * x ^ i * (b j * x ^ j))"
  5936     using assms by (auto simp: sum_up_index_split)
  5937   also have "\<dots> = (\<Sum>r\<le>m + n. \<Sum>j\<le>m + n - r. a r * x ^ r * (b j * x ^ j))"
  5938     apply (simp add: add_ac sum.Sigma product_atMost_eq_Un)
  5939     apply (clarsimp simp add: sum_Un Sigma_interval_disjoint intro!: sum.neutral)
  5940     apply (metis add_diff_assoc2 add.commute add_lessD1 leD m n nat_le_linear neqE)
  5941     done
  5942   also have "\<dots> = (\<Sum>(i,j)\<in>{(i,j). i+j \<le> m+n}. (a i * x ^ i) * (b j * x ^ j))"
  5943     by (auto simp: pairs_le_eq_Sigma sum.Sigma)
  5944   also have "\<dots> = (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5945     apply (subst sum_triangle_reindex_eq)
  5946     apply (auto simp: algebra_simps sum_distrib_left intro!: sum.cong)
  5947     apply (metis le_add_diff_inverse power_add)
  5948     done
  5949   finally show ?thesis .
  5950 qed
  5951 
  5952 lemma polynomial_product_nat:
  5953   fixes x :: nat
  5954   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
  5955     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
  5956   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
  5957     (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5958   using polynomial_product [of m a n b x] assms
  5959   by (simp only: of_nat_mult [symmetric] of_nat_power [symmetric]
  5960       of_nat_eq_iff Int.int_sum [symmetric])
  5961 
  5962 lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
  5963   fixes x :: "'a::idom"
  5964   assumes "1 \<le> n"
  5965   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5966     (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5967 proof -
  5968   have h: "bij_betw (\<lambda>(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
  5969     by (auto simp: bij_betw_def inj_on_def)
  5970   have "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) = (\<Sum>i\<le>n. a i * (x^i - y^i))"
  5971     by (simp add: right_diff_distrib sum_subtractf)
  5972   also have "\<dots> = (\<Sum>i\<le>n. a i * (x - y) * (\<Sum>j<i. y^(i - Suc j) * x^j))"
  5973     by (simp add: power_diff_sumr2 mult.assoc)
  5974   also have "\<dots> = (\<Sum>i\<le>n. \<Sum>j<i. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5975     by (simp add: sum_distrib_left)
  5976   also have "\<dots> = (\<Sum>(i,j) \<in> (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5977     by (simp add: sum.Sigma)
  5978   also have "\<dots> = (\<Sum>(j,i) \<in> (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5979     by (auto simp add: sum.reindex_bij_betw [OF h, symmetric] intro: sum.strong_cong)
  5980   also have "\<dots> = (\<Sum>j<n. \<Sum>i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5981     by (simp add: sum.Sigma)
  5982   also have "\<dots> = (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5983     by (simp add: sum_distrib_left mult_ac)
  5984   finally show ?thesis .
  5985 qed
  5986 
  5987 lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
  5988   fixes x :: "'a::idom"
  5989   assumes "1 \<le> n"
  5990   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5991     (x - y) * ((\<Sum>j<n. \<Sum>k<n-j. a(j + k + 1) * y^k * x^j))"
  5992 proof -
  5993   have "(\<Sum>i=Suc j..n. a i * y^(i - j - 1)) = (\<Sum>k<n-j. a(j+k+1) * y^k)"
  5994     if "j < n" for j :: nat
  5995   proof -
  5996     have h: "bij_betw (\<lambda>i. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
  5997       apply (auto simp: bij_betw_def inj_on_def)
  5998       apply (rule_tac x="x + Suc j" in image_eqI)
  5999        apply (auto simp: )
  6000       done
  6001     then show ?thesis
  6002       by (auto simp add: sum.reindex_bij_betw [OF h, symmetric] intro: sum.strong_cong)
  6003   qed
  6004   then show ?thesis
  6005     by (simp add: polyfun_diff [OF assms] sum_distrib_right)
  6006 qed
  6007 
  6008 lemma polyfun_linear_factor:  (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
  6009   fixes a :: "'a::idom"
  6010   shows "\<exists>b. \<forall>z. (\<Sum>i\<le>n. c(i) * z^i) = (z - a) * (\<Sum>i<n. b(i) * z^i) + (\<Sum>i\<le>n. c(i) * a^i)"
  6011 proof (cases "n = 0")
  6012   case True then show ?thesis
  6013     by simp
  6014 next
  6015   case False
  6016   have "(\<exists>b. \<forall>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i) + (\<Sum>i\<le>n. c i * a^i)) \<longleftrightarrow>
  6017         (\<exists>b. \<forall>z. (\<Sum>i\<le>n. c i * z^i) - (\<Sum>i\<le>n. c i * a^i) = (z - a) * (\<Sum>i<n. b i * z^i))"
  6018     by (simp add: algebra_simps)
  6019   also have "\<dots> \<longleftrightarrow>
  6020     (\<exists>b. \<forall>z. (z - a) * (\<Sum>j<n. (\<Sum>i = Suc j..n. c i * a^(i - Suc j)) * z^j) =
  6021       (z - a) * (\<Sum>i<n. b i * z^i))"
  6022     using False by (simp add: polyfun_diff)
  6023   also have "\<dots> = True" by auto
  6024   finally show ?thesis
  6025     by simp
  6026 qed
  6027 
  6028 lemma polyfun_linear_factor_root:  (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
  6029   fixes a :: "'a::idom"
  6030   assumes "(\<Sum>i\<le>n. c(i) * a^i) = 0"
  6031   obtains b where "\<And>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i)"
  6032   using polyfun_linear_factor [of c n a] assms by auto
  6033 
  6034 (*The material of this section, up until this point, could go into a new theory of polynomials
  6035   based on Main alone. The remaining material involves limits, continuity, series, etc.*)
  6036 
  6037 lemma isCont_polynom: "isCont (\<lambda>w. \<Sum>i\<le>n. c i * w^i) a"
  6038   for c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
  6039   by simp
  6040 
  6041 lemma zero_polynom_imp_zero_coeffs:
  6042   fixes c :: "nat \<Rightarrow> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
  6043   assumes "\<And>w. (\<Sum>i\<le>n. c i * w^i) = 0"  "k \<le> n"
  6044   shows "c k = 0"
  6045   using assms
  6046 proof (induction n arbitrary: c k)
  6047   case 0