src/HOL/Transcendental.thy
author haftmann
Mon Jun 05 15:59:41 2017 +0200 (2017-06-05)
changeset 66010 2f7d39285a1a
parent 65680 378a2f11bec9
child 66279 2dba15d3c402
permissions -rw-r--r--
executable domain membership checks
     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_mono2) 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: "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: "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: "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:
  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: "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: "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: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
  1763   by (rule ln_unique) (simp add: exp_of_nat_mult)
  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: "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 add: ln_add_one_self_le_self)
  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_diff:
  2484   fixes w:: "'a::{ln,real_normed_field}" shows  "w powr (z1 - z2) = w powr z1 / w powr z2"
  2485   by (simp add: powr_def algebra_simps exp_diff)
  2486 
  2487 lemma powr_mult: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
  2488   for a x y :: real
  2489   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
  2490 
  2491 lemma powr_ge_pzero [simp]: "0 \<le> x powr y"
  2492   for x y :: real
  2493   by (simp add: powr_def)
  2494 
  2495 lemma powr_divide: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
  2496   for a b x :: real
  2497   apply (simp add: divide_inverse positive_imp_inverse_positive powr_mult)
  2498   apply (simp add: powr_def exp_minus [symmetric] exp_add [symmetric] ln_inverse)
  2499   done
  2500 
  2501 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
  2502   for a b x :: "'a::{ln,real_normed_field}"
  2503   by (simp add: powr_def exp_add [symmetric] distrib_right)
  2504 
  2505 lemma powr_mult_base: "0 < x \<Longrightarrow>x * x powr y = x powr (1 + y)"
  2506   for x :: real
  2507   by (auto simp: powr_add)
  2508 
  2509 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
  2510   for a b x :: real
  2511   by (simp add: powr_def)
  2512 
  2513 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
  2514   for a b x :: real
  2515   by (simp add: powr_powr mult.commute)
  2516 
  2517 lemma powr_minus: "x powr (- a) = inverse (x powr a)"
  2518       for a x :: "'a::{ln,real_normed_field}"
  2519   by (simp add: powr_def exp_minus [symmetric])
  2520 
  2521 lemma powr_minus_divide: "x powr (- a) = 1/(x powr a)"
  2522   for x a :: real
  2523   by (simp add: divide_inverse powr_minus)
  2524 
  2525 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
  2526   for a b c :: real
  2527   by (simp add: powr_minus_divide)
  2528 
  2529 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
  2530   for a b x :: real
  2531   by (simp add: powr_def)
  2532 
  2533 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  2534   for a b x :: real
  2535   by (simp add: powr_def)
  2536 
  2537 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a < x powr b \<longleftrightarrow> a < b"
  2538   for a b x :: real
  2539   by (blast intro: powr_less_cancel powr_less_mono)
  2540 
  2541 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a \<le> x powr b \<longleftrightarrow> a \<le> b"
  2542   for a b x :: real
  2543   by (simp add: linorder_not_less [symmetric])
  2544 
  2545 lemma log_ln: "ln x = log (exp(1)) x"
  2546   by (simp add: log_def)
  2547 
  2548 lemma DERIV_log:
  2549   assumes "x > 0"
  2550   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
  2551 proof -
  2552   define lb where "lb = 1 / ln b"
  2553   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
  2554     using \<open>x > 0\<close> by (auto intro!: derivative_eq_intros)
  2555   ultimately show ?thesis
  2556     by (simp add: log_def)
  2557 qed
  2558 
  2559 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
  2560   and DERIV_log[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  2561 
  2562 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
  2563   by (simp add: powr_def log_def)
  2564 
  2565 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
  2566   by (simp add: log_def powr_def)
  2567 
  2568 lemma log_mult:
  2569   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
  2570     log a (x * y) = log a x + log a y"
  2571   by (simp add: log_def ln_mult divide_inverse distrib_right)
  2572 
  2573 lemma log_eq_div_ln_mult_log:
  2574   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  2575     log a x = (ln b/ln a) * log b x"
  2576   by (simp add: log_def divide_inverse)
  2577 
  2578 text\<open>Base 10 logarithms\<close>
  2579 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
  2580   by (simp add: log_def)
  2581 
  2582 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
  2583   by (simp add: log_def)
  2584 
  2585 lemma log_one [simp]: "log a 1 = 0"
  2586   by (simp add: log_def)
  2587 
  2588 lemma log_eq_one [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a a = 1"
  2589   by (simp add: log_def)
  2590 
  2591 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
  2592   apply (rule add_left_cancel [THEN iffD1, where a1 = "log a x"])
  2593   apply (simp add: log_mult [symmetric])
  2594   done
  2595 
  2596 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"
  2597   by (simp add: log_mult divide_inverse log_inverse)
  2598 
  2599 lemma powr_gt_zero [simp]: "0 < x powr a \<longleftrightarrow> x \<noteq> 0"
  2600   for a x :: real
  2601   by (simp add: powr_def)
  2602 
  2603 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)"
  2604   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)"
  2605   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)"
  2606   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)"
  2607   by (simp_all add: log_mult log_divide)
  2608 
  2609 lemma log_less_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
  2610   apply safe
  2611    apply (rule_tac [2] powr_less_cancel)
  2612     apply (drule_tac a = "log a x" in powr_less_mono)
  2613      apply auto
  2614   done
  2615 
  2616 lemma log_inj:
  2617   assumes "1 < b"
  2618   shows "inj_on (log b) {0 <..}"
  2619 proof (rule inj_onI, simp)
  2620   fix x y
  2621   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
  2622   show "x = y"
  2623   proof (cases rule: linorder_cases)
  2624     assume "x = y"
  2625     then show ?thesis by simp
  2626   next
  2627     assume "x < y"
  2628     then have "log b x < log b y"
  2629       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2630     then show ?thesis using * by simp
  2631   next
  2632     assume "y < x"
  2633     then have "log b y < log b x"
  2634       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2635     then show ?thesis using * by simp
  2636   qed
  2637 qed
  2638 
  2639 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"
  2640   by (simp add: linorder_not_less [symmetric])
  2641 
  2642 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
  2643   using log_less_cancel_iff[of a 1 x] by simp
  2644 
  2645 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
  2646   using log_le_cancel_iff[of a 1 x] by simp
  2647 
  2648 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
  2649   using log_less_cancel_iff[of a x 1] by simp
  2650 
  2651 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
  2652   using log_le_cancel_iff[of a x 1] by simp
  2653 
  2654 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
  2655   using log_less_cancel_iff[of a a x] by simp
  2656 
  2657 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
  2658   using log_le_cancel_iff[of a a x] by simp
  2659 
  2660 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
  2661   using log_less_cancel_iff[of a x a] by simp
  2662 
  2663 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
  2664   using log_le_cancel_iff[of a x a] by simp
  2665 
  2666 lemma le_log_iff:
  2667   fixes b x y :: real
  2668   assumes "1 < b" "x > 0"
  2669   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
  2670   using assms
  2671   apply auto
  2672    apply (metis (no_types, hide_lams) less_irrefl less_le_trans linear powr_le_cancel_iff
  2673       powr_log_cancel zero_less_one)
  2674   apply (metis not_less order.trans order_refl powr_le_cancel_iff powr_log_cancel zero_le_one)
  2675   done
  2676 
  2677 lemma less_log_iff:
  2678   assumes "1 < b" "x > 0"
  2679   shows "y < log b x \<longleftrightarrow> b powr y < x"
  2680   by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
  2681     powr_log_cancel zero_less_one)
  2682 
  2683 lemma
  2684   assumes "1 < b" "x > 0"
  2685   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
  2686     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
  2687   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
  2688   by auto
  2689 
  2690 lemmas powr_le_iff = le_log_iff[symmetric]
  2691   and powr_less_iff = le_log_iff[symmetric]
  2692   and less_powr_iff = log_less_iff[symmetric]
  2693   and le_powr_iff = log_le_iff[symmetric]
  2694 
  2695 lemma gr_one_powr[simp]:
  2696   fixes x y :: real shows "\<lbrakk> x > 1; y > 0 \<rbrakk> \<Longrightarrow> 1 < x powr y"
  2697 by(simp add: less_powr_iff)
  2698 
  2699 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)"
  2700   by (auto simp add: floor_eq_iff powr_le_iff less_powr_iff)
  2701 
  2702 lemma powr_realpow: "0 < x \<Longrightarrow> x powr (real n) = x^n"
  2703   by (induct n) (simp_all add: ac_simps powr_add)
  2704 
  2705 lemma powr_real_of_int:
  2706   "x > 0 \<Longrightarrow> x powr real_of_int n = (if n \<ge> 0 then x ^ nat n else inverse (x ^ nat (- n)))"
  2707   using powr_realpow[of x "nat n"] powr_realpow[of x "nat (-n)"]
  2708   by (auto simp: field_simps powr_minus)
  2709 
  2710 lemma powr_numeral [simp]: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
  2711   by (metis of_nat_numeral powr_realpow)
  2712 
  2713 lemma powr_int:
  2714   assumes "x > 0"
  2715   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
  2716 proof (cases "i < 0")
  2717   case True
  2718   have r: "x powr i = 1 / x powr (- i)"
  2719     by (simp add: powr_minus field_simps)
  2720   show ?thesis using \<open>i < 0\<close> \<open>x > 0\<close>
  2721     by (simp add: r field_simps powr_realpow[symmetric])
  2722 next
  2723   case False
  2724   then show ?thesis
  2725     by (simp add: assms powr_realpow[symmetric])
  2726 qed
  2727 
  2728 lemma compute_powr[code]:
  2729   fixes i :: real
  2730   shows "b powr i =
  2731     (if b \<le> 0 then Code.abort (STR ''op powr with nonpositive base'') (\<lambda>_. b powr i)
  2732      else if \<lfloor>i\<rfloor> = i then (if 0 \<le> i then b ^ nat \<lfloor>i\<rfloor> else 1 / b ^ nat \<lfloor>- i\<rfloor>)
  2733      else Code.abort (STR ''op powr with non-integer exponent'') (\<lambda>_. b powr i))"
  2734   by (auto simp: powr_int)
  2735 
  2736 lemma powr_one: "0 \<le> x \<Longrightarrow> x powr 1 = x"
  2737   for x :: real
  2738   using powr_realpow [of x 1] by simp
  2739 
  2740 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
  2741   for x :: real
  2742   using powr_int [of x "- 1"] by simp
  2743 
  2744 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
  2745   for x :: real
  2746   using powr_int [of x "- numeral n"] by simp
  2747 
  2748 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
  2749   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
  2750 
  2751 lemma ln_powr: "x \<noteq> 0 \<Longrightarrow> ln (x powr y) = y * ln x"
  2752   for x :: real
  2753   by (simp add: powr_def)
  2754 
  2755 lemma ln_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> ln (root n b) =  ln b / n"
  2756   by (simp add: root_powr_inverse ln_powr)
  2757 
  2758 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
  2759   by (simp add: ln_powr ln_powr[symmetric] mult.commute)
  2760 
  2761 lemma log_root: "n > 0 \<Longrightarrow> a > 0 \<Longrightarrow> log b (root n a) =  log b a / n"
  2762   by (simp add: log_def ln_root)
  2763 
  2764 lemma log_powr: "x \<noteq> 0 \<Longrightarrow> log b (x powr y) = y * log b x"
  2765   by (simp add: log_def ln_powr)
  2766 
  2767 (* [simp] is not worth it, interferes with some proofs *)
  2768 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
  2769   by (simp add: log_powr powr_realpow [symmetric])
  2770 
  2771 lemma le_log_of_power:
  2772   assumes "1 < b" "b ^ n \<le> m"
  2773   shows "n \<le> log b m"
  2774 proof -
  2775    from assms have "0 < m"
  2776      by (metis less_trans zero_less_power less_le_trans zero_less_one)
  2777    have "n = log b (b ^ n)"
  2778      using assms(1) by (simp add: log_nat_power)
  2779    also have "\<dots> \<le> log b m"
  2780      using assms \<open>0 < m\<close> by simp
  2781    finally show ?thesis .
  2782 qed
  2783 
  2784 lemma le_log2_of_power: "2 ^ n \<le> m \<Longrightarrow> n \<le> log 2 m"
  2785   for m n :: nat
  2786   using le_log_of_power[of 2] by simp
  2787 
  2788 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
  2789   by (simp add: log_def)
  2790 
  2791 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
  2792   by (simp add: log_def ln_realpow)
  2793 
  2794 lemma log_base_powr: "a \<noteq> 0 \<Longrightarrow> log (a powr b) x = log a x / b"
  2795   by (simp add: log_def ln_powr)
  2796 
  2797 lemma log_base_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> log (root n b) x = n * (log b x)"
  2798   by (simp add: log_def ln_root)
  2799 
  2800 lemma ln_bound: "1 \<le> x \<Longrightarrow> ln x \<le> x"
  2801   for x :: real
  2802   apply (subgoal_tac "ln (1 + (x - 1)) \<le> x - 1")
  2803    apply simp
  2804   apply (rule ln_add_one_self_le_self)
  2805   apply simp
  2806   done
  2807 
  2808 lemma powr_mono: "a \<le> b \<Longrightarrow> 1 \<le> x \<Longrightarrow> x powr a \<le> x powr b"
  2809   for x :: real
  2810   apply (cases "x = 1")
  2811    apply simp
  2812   apply (cases "a = b")
  2813    apply simp
  2814   apply (rule order_less_imp_le)
  2815   apply (rule powr_less_mono)
  2816    apply auto
  2817   done
  2818 
  2819 lemma ge_one_powr_ge_zero: "1 \<le> x \<Longrightarrow> 0 \<le> a \<Longrightarrow> 1 \<le> x powr a"
  2820   for x :: real
  2821   using powr_mono by fastforce
  2822 
  2823 lemma powr_less_mono2: "0 < a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> x powr a < y powr a"
  2824   for x :: real
  2825   by (simp add: powr_def)
  2826 
  2827 lemma powr_less_mono2_neg: "a < 0 \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> y powr a < x powr a"
  2828   for x :: real
  2829   by (simp add: powr_def)
  2830 
  2831 lemma powr_mono2: "x powr a \<le> y powr a" if "0 \<le> a" "0 \<le> x" "x \<le> y"
  2832   for x :: real
  2833 proof (cases "a = 0")
  2834   case True
  2835   with that show ?thesis by simp
  2836 next
  2837   case False show ?thesis
  2838   proof (cases "x = y")
  2839     case True
  2840     then show ?thesis by simp
  2841   next
  2842     case False
  2843     then show ?thesis
  2844       by (metis dual_order.strict_iff_order powr_less_mono2 that \<open>a \<noteq> 0\<close>)
  2845   qed
  2846 qed
  2847 
  2848 lemma powr_le1: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> x powr a \<le> 1"
  2849   for x :: real
  2850   using powr_mono2 by fastforce
  2851 
  2852 lemma powr_mono2':
  2853   fixes a x y :: real
  2854   assumes "a \<le> 0" "x > 0" "x \<le> y"
  2855   shows "x powr a \<ge> y powr a"
  2856 proof -
  2857   from assms have "x powr - a \<le> y powr - a"
  2858     by (intro powr_mono2) simp_all
  2859   with assms show ?thesis
  2860     by (auto simp add: powr_minus field_simps)
  2861 qed
  2862 
  2863 lemma powr_mono_both:
  2864   fixes x :: real
  2865   assumes "0 \<le> a" "a \<le> b" "1 \<le> x" "x \<le> y"
  2866     shows "x powr a \<le> y powr b"
  2867   by (meson assms order.trans powr_mono powr_mono2 zero_le_one)
  2868 
  2869 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
  2870   for x :: real
  2871   unfolding powr_def exp_inj_iff by simp
  2872 
  2873 lemma powr_half_sqrt: "0 \<le> x \<Longrightarrow> x powr (1/2) = sqrt x"
  2874   by (simp add: powr_def root_powr_inverse sqrt_def)
  2875 
  2876 lemma ln_powr_bound: "1 \<le> x \<Longrightarrow> 0 < a \<Longrightarrow> ln x \<le> (x powr a) / a"
  2877   for x :: real
  2878   by (metis exp_gt_zero linear ln_eq_zero_iff ln_exp ln_less_self ln_powr mult.commute
  2879       mult_imp_le_div_pos not_less powr_gt_zero)
  2880 
  2881 lemma ln_powr_bound2:
  2882   fixes x :: real
  2883   assumes "1 < x" and "0 < a"
  2884   shows "(ln x) powr a \<le> (a powr a) * x"
  2885 proof -
  2886   from assms have "ln x \<le> (x powr (1 / a)) / (1 / a)"
  2887     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
  2888   also have "\<dots> = a * (x powr (1 / a))"
  2889     by simp
  2890   finally have "(ln x) powr a \<le> (a * (x powr (1 / a))) powr a"
  2891     by (metis assms less_imp_le ln_gt_zero powr_mono2)
  2892   also have "\<dots> = (a powr a) * ((x powr (1 / a)) powr a)"
  2893     using assms powr_mult by auto
  2894   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
  2895     by (rule powr_powr)
  2896   also have "\<dots> = x" using assms
  2897     by auto
  2898   finally show ?thesis .
  2899 qed
  2900 
  2901 lemma tendsto_powr:
  2902   fixes a b :: real
  2903   assumes f: "(f \<longlongrightarrow> a) F"
  2904     and g: "(g \<longlongrightarrow> b) F"
  2905     and a: "a \<noteq> 0"
  2906   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2907   unfolding powr_def
  2908 proof (rule filterlim_If)
  2909   from f show "((\<lambda>x. 0) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
  2910     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_mono dest: t1_space_nhds)
  2911   from f g a show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a)))
  2912       (inf F (principal {x. f x \<noteq> 0}))"
  2913     by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
  2914 qed
  2915 
  2916 lemma tendsto_powr'[tendsto_intros]:
  2917   fixes a :: real
  2918   assumes f: "(f \<longlongrightarrow> a) F"
  2919     and g: "(g \<longlongrightarrow> b) F"
  2920     and a: "a \<noteq> 0 \<or> (b > 0 \<and> eventually (\<lambda>x. f x \<ge> 0) F)"
  2921   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2922 proof -
  2923   from a consider "a \<noteq> 0" | "a = 0" "b > 0" "eventually (\<lambda>x. f x \<ge> 0) F"
  2924     by auto
  2925   then show ?thesis
  2926   proof cases
  2927     case 1
  2928     with f g show ?thesis by (rule tendsto_powr)
  2929   next
  2930     case 2
  2931     have "((\<lambda>x. if f x = 0 then 0 else exp (g x * ln (f x))) \<longlongrightarrow> 0) F"
  2932     proof (intro filterlim_If)
  2933       have "filterlim f (principal {0<..}) (inf F (principal {z. f z \<noteq> 0}))"
  2934         using \<open>eventually (\<lambda>x. f x \<ge> 0) F\<close>
  2935         by (auto simp add: filterlim_iff eventually_inf_principal
  2936             eventually_principal elim: eventually_mono)
  2937       moreover have "filterlim f (nhds a) (inf F (principal {z. f z \<noteq> 0}))"
  2938         by (rule tendsto_mono[OF _ f]) simp_all
  2939       ultimately have f: "filterlim f (at_right 0) (inf F (principal {x. f x \<noteq> 0}))"
  2940         by (simp add: at_within_def filterlim_inf \<open>a = 0\<close>)
  2941       have g: "(g \<longlongrightarrow> b) (inf F (principal {z. f z \<noteq> 0}))"
  2942         by (rule tendsto_mono[OF _ g]) simp_all
  2943       show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> 0) (inf F (principal {x. f x \<noteq> 0}))"
  2944         by (rule filterlim_compose[OF exp_at_bot] filterlim_tendsto_pos_mult_at_bot
  2945                  filterlim_compose[OF ln_at_0] f g \<open>b > 0\<close>)+
  2946     qed simp_all
  2947     with \<open>a = 0\<close> show ?thesis
  2948       by (simp add: powr_def)
  2949   qed
  2950 qed
  2951 
  2952 lemma continuous_powr:
  2953   assumes "continuous F f"
  2954     and "continuous F g"
  2955     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
  2956   shows "continuous F (\<lambda>x. (f x) powr (g x :: real))"
  2957   using assms unfolding continuous_def by (rule tendsto_powr)
  2958 
  2959 lemma continuous_at_within_powr[continuous_intros]:
  2960   fixes f g :: "_ \<Rightarrow> real"
  2961   assumes "continuous (at a within s) f"
  2962     and "continuous (at a within s) g"
  2963     and "f a \<noteq> 0"
  2964   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
  2965   using assms unfolding continuous_within by (rule tendsto_powr)
  2966 
  2967 lemma isCont_powr[continuous_intros, simp]:
  2968   fixes f g :: "_ \<Rightarrow> real"
  2969   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
  2970   shows "isCont (\<lambda>x. (f x) powr g x) a"
  2971   using assms unfolding continuous_at by (rule tendsto_powr)
  2972 
  2973 lemma continuous_on_powr[continuous_intros]:
  2974   fixes f g :: "_ \<Rightarrow> real"
  2975   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
  2976   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2977   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
  2978 
  2979 lemma tendsto_powr2:
  2980   fixes a :: real
  2981   assumes f: "(f \<longlongrightarrow> a) F"
  2982     and g: "(g \<longlongrightarrow> b) F"
  2983     and "\<forall>\<^sub>F x in F. 0 \<le> f x"
  2984     and b: "0 < b"
  2985   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2986   using tendsto_powr'[of f a F g b] assms by auto
  2987 
  2988 lemma DERIV_powr:
  2989   fixes r :: real
  2990   assumes g: "DERIV g x :> m"
  2991     and pos: "g x > 0"
  2992     and f: "DERIV f x :> r"
  2993   shows "DERIV (\<lambda>x. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
  2994 proof -
  2995   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)"
  2996     using pos
  2997     by (auto intro!: derivative_eq_intros g pos f simp: powr_def field_simps exp_diff)
  2998   then show ?thesis
  2999   proof (rule DERIV_cong_ev[OF refl _ refl, THEN iffD1, rotated])
  3000     from DERIV_isCont[OF g] pos have "\<forall>\<^sub>F x in at x. 0 < g x"
  3001       unfolding isCont_def by (rule order_tendstoD(1))
  3002     with pos show "\<forall>\<^sub>F x in nhds x. exp (f x * ln (g x)) = g x powr f x"
  3003       by (auto simp: eventually_at_filter powr_def elim: eventually_mono)
  3004   qed
  3005 qed
  3006 
  3007 lemma DERIV_fun_powr:
  3008   fixes r :: real
  3009   assumes g: "DERIV g x :> m"
  3010     and pos: "g x > 0"
  3011   shows "DERIV (\<lambda>x. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
  3012   using DERIV_powr[OF g pos DERIV_const, of r] pos
  3013   by (simp add: powr_diff field_simps)
  3014 
  3015 lemma has_real_derivative_powr:
  3016   assumes "z > 0"
  3017   shows "((\<lambda>z. z powr r) has_real_derivative r * z powr (r - 1)) (at z)"
  3018 proof (subst DERIV_cong_ev[OF refl _ refl])
  3019   from assms have "eventually (\<lambda>z. z \<noteq> 0) (nhds z)"
  3020     by (intro t1_space_nhds) auto
  3021   then show "eventually (\<lambda>z. z powr r = exp (r * ln z)) (nhds z)"
  3022     unfolding powr_def by eventually_elim simp
  3023   from assms show "((\<lambda>z. exp (r * ln z)) has_real_derivative r * z powr (r - 1)) (at z)"
  3024     by (auto intro!: derivative_eq_intros simp: powr_def field_simps exp_diff)
  3025 qed
  3026 
  3027 declare has_real_derivative_powr[THEN DERIV_chain2, derivative_intros]
  3028 
  3029 lemma tendsto_zero_powrI:
  3030   assumes "(f \<longlongrightarrow> (0::real)) F" "(g \<longlongrightarrow> b) F" "\<forall>\<^sub>F x in F. 0 \<le> f x" "0 < b"
  3031   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> 0) F"
  3032   using tendsto_powr2[OF assms] by simp
  3033 
  3034 lemma continuous_on_powr':
  3035   fixes f g :: "_ \<Rightarrow> real"
  3036   assumes "continuous_on s f" "continuous_on s g"
  3037     and "\<forall>x\<in>s. f x \<ge> 0 \<and> (f x = 0 \<longrightarrow> g x > 0)"
  3038   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  3039   unfolding continuous_on_def
  3040 proof
  3041   fix x
  3042   assume x: "x \<in> s"
  3043   from assms x show "((\<lambda>x. f x powr g x) \<longlongrightarrow> f x powr g x) (at x within s)"
  3044   proof (cases "f x = 0")
  3045     case True
  3046     from assms(3) have "eventually (\<lambda>x. f x \<ge> 0) (at x within s)"
  3047       by (auto simp: at_within_def eventually_inf_principal)
  3048     with True x assms show ?thesis
  3049       by (auto intro!: tendsto_zero_powrI[of f _ g "g x"] simp: continuous_on_def)
  3050   next
  3051     case False
  3052     with assms x show ?thesis
  3053       by (auto intro!: tendsto_powr' simp: continuous_on_def)
  3054   qed
  3055 qed
  3056 
  3057 lemma tendsto_neg_powr:
  3058   assumes "s < 0"
  3059     and f: "LIM x F. f x :> at_top"
  3060   shows "((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
  3061 proof -
  3062   have "((\<lambda>x. exp (s * ln (f x))) \<longlongrightarrow> (0::real)) F" (is "?X")
  3063     by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
  3064         filterlim_tendsto_neg_mult_at_bot assms)
  3065   also have "?X \<longleftrightarrow> ((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
  3066     using f filterlim_at_top_dense[of f F]
  3067     by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_mono)
  3068   finally show ?thesis .
  3069 qed
  3070 
  3071 lemma tendsto_exp_limit_at_right: "((\<lambda>y. (1 + x * y) powr (1 / y)) \<longlongrightarrow> exp x) (at_right 0)"
  3072   for x :: real
  3073 proof (cases "x = 0")
  3074   case True
  3075   then show ?thesis by simp
  3076 next
  3077   case False
  3078   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
  3079     by (auto intro!: derivative_eq_intros)
  3080   then have "((\<lambda>y. ln (1 + x * y) / y) \<longlongrightarrow> x) (at 0)"
  3081     by (auto simp add: has_field_derivative_def field_has_derivative_at)
  3082   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) \<longlongrightarrow> exp x) (at 0)"
  3083     by (rule tendsto_intros)
  3084   then show ?thesis
  3085   proof (rule filterlim_mono_eventually)
  3086     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
  3087       unfolding eventually_at_right[OF zero_less_one]
  3088       using False
  3089       apply (intro exI[of _ "1 / \<bar>x\<bar>"])
  3090       apply (auto simp: field_simps powr_def abs_if)
  3091       apply (metis add_less_same_cancel1 mult_less_0_iff not_less_iff_gr_or_eq zero_less_one)
  3092       done
  3093   qed (simp_all add: at_eq_sup_left_right)
  3094 qed
  3095 
  3096 lemma tendsto_exp_limit_at_top: "((\<lambda>y. (1 + x / y) powr y) \<longlongrightarrow> exp x) at_top"
  3097   for x :: real
  3098   apply (subst filterlim_at_top_to_right)
  3099   apply (simp add: inverse_eq_divide)
  3100   apply (rule tendsto_exp_limit_at_right)
  3101   done
  3102 
  3103 lemma tendsto_exp_limit_sequentially: "(\<lambda>n. (1 + x / n) ^ n) \<longlonglongrightarrow> exp x"
  3104   for x :: real
  3105 proof (rule filterlim_mono_eventually)
  3106   from reals_Archimedean2 [of "\<bar>x\<bar>"] obtain n :: nat where *: "real n > \<bar>x\<bar>" ..
  3107   then have "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
  3108     apply (intro eventually_sequentiallyI [of n])
  3109     apply (cases "x \<ge> 0")
  3110      apply (rule add_pos_nonneg)
  3111       apply (auto intro: divide_nonneg_nonneg)
  3112     apply (subgoal_tac "x / real xa > - 1")
  3113      apply (auto simp add: field_simps)
  3114     done
  3115   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
  3116     by (rule eventually_mono) (erule powr_realpow)
  3117   show "(\<lambda>n. (1 + x / real n) powr real n) \<longlonglongrightarrow> exp x"
  3118     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
  3119 qed auto
  3120 
  3121 
  3122 subsection \<open>Sine and Cosine\<close>
  3123 
  3124 definition sin_coeff :: "nat \<Rightarrow> real"
  3125   where "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
  3126 
  3127 definition cos_coeff :: "nat \<Rightarrow> real"
  3128   where "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
  3129 
  3130 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  3131   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
  3132 
  3133 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  3134   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
  3135 
  3136 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
  3137   unfolding sin_coeff_def by simp
  3138 
  3139 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
  3140   unfolding cos_coeff_def by simp
  3141 
  3142 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
  3143   unfolding cos_coeff_def sin_coeff_def
  3144   by (simp del: mult_Suc)
  3145 
  3146 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
  3147   unfolding cos_coeff_def sin_coeff_def
  3148   by (simp del: mult_Suc) (auto elim: oddE)
  3149 
  3150 lemma summable_norm_sin: "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
  3151   for x :: "'a::{real_normed_algebra_1,banach}"
  3152   unfolding sin_coeff_def
  3153   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  3154   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  3155   done
  3156 
  3157 lemma summable_norm_cos: "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
  3158   for x :: "'a::{real_normed_algebra_1,banach}"
  3159   unfolding cos_coeff_def
  3160   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  3161   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  3162   done
  3163 
  3164 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin x"
  3165   unfolding sin_def
  3166   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
  3167 
  3168 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos x"
  3169   unfolding cos_def
  3170   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
  3171 
  3172 lemma sin_of_real: "sin (of_real x) = of_real (sin x)"
  3173   for x :: real
  3174 proof -
  3175   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
  3176   proof
  3177     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n" for n
  3178       by (simp add: scaleR_conv_of_real)
  3179   qed
  3180   also have "\<dots> sums (sin (of_real x))"
  3181     by (rule sin_converges)
  3182   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
  3183   then show ?thesis
  3184     using sums_unique2 sums_of_real [OF sin_converges]
  3185     by blast
  3186 qed
  3187 
  3188 corollary sin_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> sin z \<in> \<real>"
  3189   by (metis Reals_cases Reals_of_real sin_of_real)
  3190 
  3191 lemma cos_of_real: "cos (of_real x) = of_real (cos x)"
  3192   for x :: real
  3193 proof -
  3194   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
  3195   proof
  3196     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n" for n
  3197       by (simp add: scaleR_conv_of_real)
  3198   qed
  3199   also have "\<dots> sums (cos (of_real x))"
  3200     by (rule cos_converges)
  3201   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
  3202   then show ?thesis
  3203     using sums_unique2 sums_of_real [OF cos_converges]
  3204     by blast
  3205 qed
  3206 
  3207 corollary cos_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cos z \<in> \<real>"
  3208   by (metis Reals_cases Reals_of_real cos_of_real)
  3209 
  3210 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
  3211   by (simp add: diffs_def sin_coeff_Suc del: of_nat_Suc)
  3212 
  3213 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
  3214   by (simp add: diffs_def cos_coeff_Suc del: of_nat_Suc)
  3215 
  3216 lemma sin_int_times_real: "sin (of_int m * of_real x) = of_real (sin (of_int m * x))"
  3217   by (metis sin_of_real of_real_mult of_real_of_int_eq)
  3218 
  3219 lemma cos_int_times_real: "cos (of_int m * of_real x) = of_real (cos (of_int m * x))"
  3220   by (metis cos_of_real of_real_mult of_real_of_int_eq)
  3221 
  3222 text \<open>Now at last we can get the derivatives of exp, sin and cos.\<close>
  3223 
  3224 lemma DERIV_sin [simp]: "DERIV sin x :> cos x"
  3225   for x :: "'a::{real_normed_field,banach}"
  3226   unfolding sin_def cos_def scaleR_conv_of_real
  3227   apply (rule DERIV_cong)
  3228    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  3229       apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
  3230               summable_minus_iff scaleR_conv_of_real [symmetric]
  3231               summable_norm_sin [THEN summable_norm_cancel]
  3232               summable_norm_cos [THEN summable_norm_cancel])
  3233   done
  3234 
  3235 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
  3236   and DERIV_sin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  3237 
  3238 lemma DERIV_cos [simp]: "DERIV cos x :> - sin x"
  3239   for x :: "'a::{real_normed_field,banach}"
  3240   unfolding sin_def cos_def scaleR_conv_of_real
  3241   apply (rule DERIV_cong)
  3242    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  3243       apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
  3244               diffs_sin_coeff diffs_cos_coeff
  3245               summable_minus_iff scaleR_conv_of_real [symmetric]
  3246               summable_norm_sin [THEN summable_norm_cancel]
  3247               summable_norm_cos [THEN summable_norm_cancel])
  3248   done
  3249 
  3250 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
  3251   and DERIV_cos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  3252 
  3253 lemma isCont_sin: "isCont sin x"
  3254   for x :: "'a::{real_normed_field,banach}"
  3255   by (rule DERIV_sin [THEN DERIV_isCont])
  3256 
  3257 lemma isCont_cos: "isCont cos x"
  3258   for x :: "'a::{real_normed_field,banach}"
  3259   by (rule DERIV_cos [THEN DERIV_isCont])
  3260 
  3261 lemma isCont_sin' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
  3262   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3263   by (rule isCont_o2 [OF _ isCont_sin])
  3264 
  3265 (* FIXME a context for f would be better *)
  3266 
  3267 lemma isCont_cos' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
  3268   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3269   by (rule isCont_o2 [OF _ isCont_cos])
  3270 
  3271 lemma tendsto_sin [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) \<longlongrightarrow> sin a) F"
  3272   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3273   by (rule isCont_tendsto_compose [OF isCont_sin])
  3274 
  3275 lemma tendsto_cos [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) \<longlongrightarrow> cos a) F"
  3276   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3277   by (rule isCont_tendsto_compose [OF isCont_cos])
  3278 
  3279 lemma continuous_sin [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
  3280   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3281   unfolding continuous_def by (rule tendsto_sin)
  3282 
  3283 lemma continuous_on_sin [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
  3284   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3285   unfolding continuous_on_def by (auto intro: tendsto_sin)
  3286 
  3287 lemma continuous_within_sin: "continuous (at z within s) sin"
  3288   for z :: "'a::{real_normed_field,banach}"
  3289   by (simp add: continuous_within tendsto_sin)
  3290 
  3291 lemma continuous_cos [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
  3292   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3293   unfolding continuous_def by (rule tendsto_cos)
  3294 
  3295 lemma continuous_on_cos [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
  3296   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3297   unfolding continuous_on_def by (auto intro: tendsto_cos)
  3298 
  3299 lemma continuous_within_cos: "continuous (at z within s) cos"
  3300   for z :: "'a::{real_normed_field,banach}"
  3301   by (simp add: continuous_within tendsto_cos)
  3302 
  3303 
  3304 subsection \<open>Properties of Sine and Cosine\<close>
  3305 
  3306 lemma sin_zero [simp]: "sin 0 = 0"
  3307   by (simp add: sin_def sin_coeff_def scaleR_conv_of_real)
  3308 
  3309 lemma cos_zero [simp]: "cos 0 = 1"
  3310   by (simp add: cos_def cos_coeff_def scaleR_conv_of_real)
  3311 
  3312 lemma DERIV_fun_sin: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin (g x)) x :> cos (g x) * m"
  3313   by (auto intro!: derivative_intros)
  3314 
  3315 lemma DERIV_fun_cos: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> - sin (g x) * m"
  3316   by (auto intro!: derivative_eq_intros)
  3317 
  3318 
  3319 subsection \<open>Deriving the Addition Formulas\<close>
  3320 
  3321 text \<open>The product of two cosine series.\<close>
  3322 lemma cos_x_cos_y:
  3323   fixes x :: "'a::{real_normed_field,banach}"
  3324   shows
  3325     "(\<lambda>p. \<Sum>n\<le>p.
  3326         if even p \<and> even n
  3327         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  3328       sums (cos x * cos y)"
  3329 proof -
  3330   have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p - n)) =
  3331     (if even p \<and> even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p - n)
  3332      else 0)"
  3333     if "n \<le> p" for n p :: nat
  3334   proof -
  3335     from that have *: "even n \<Longrightarrow> even p \<Longrightarrow>
  3336         (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
  3337       by (metis div_add power_add le_add_diff_inverse odd_add)
  3338     with that show ?thesis
  3339       by (auto simp: algebra_simps cos_coeff_def binomial_fact)
  3340   qed
  3341   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
  3342                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3343              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  3344     by simp
  3345   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)))"
  3346     by (simp add: algebra_simps)
  3347   also have "\<dots> sums (cos x * cos y)"
  3348     using summable_norm_cos
  3349     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  3350   finally show ?thesis .
  3351 qed
  3352 
  3353 text \<open>The product of two sine series.\<close>
  3354 lemma sin_x_sin_y:
  3355   fixes x :: "'a::{real_normed_field,banach}"
  3356   shows
  3357     "(\<lambda>p. \<Sum>n\<le>p.
  3358         if even p \<and> odd n
  3359         then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3360         else 0)
  3361       sums (sin x * sin y)"
  3362 proof -
  3363   have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  3364     (if even p \<and> odd n
  3365      then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3366      else 0)"
  3367     if "n \<le> p" for n p :: nat
  3368   proof -
  3369     have "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
  3370       if np: "odd n" "even p"
  3371     proof -
  3372       from \<open>n \<le> p\<close> np have *: "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
  3373         by arith+
  3374       have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
  3375         by simp
  3376       with \<open>n \<le> p\<close> np * show ?thesis
  3377         apply (simp add: power_add [symmetric] div_add [symmetric] del: div_add)
  3378         apply (metis (no_types) One_nat_def Suc_1 le_div_geq minus_minus
  3379             mult.left_neutral mult_minus_left power.simps(2) zero_less_Suc)
  3380         done
  3381     qed
  3382     then show ?thesis
  3383       using \<open>n\<le>p\<close> by (auto simp: algebra_simps sin_coeff_def binomial_fact)
  3384   qed
  3385   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
  3386                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3387              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  3388     by simp
  3389   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)))"
  3390     by (simp add: algebra_simps)
  3391   also have "\<dots> sums (sin x * sin y)"
  3392     using summable_norm_sin
  3393     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  3394   finally show ?thesis .
  3395 qed
  3396 
  3397 lemma sums_cos_x_plus_y:
  3398   fixes x :: "'a::{real_normed_field,banach}"
  3399   shows
  3400     "(\<lambda>p. \<Sum>n\<le>p.
  3401         if even p
  3402         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3403         else 0)
  3404       sums cos (x + y)"
  3405 proof -
  3406   have
  3407     "(\<Sum>n\<le>p.
  3408       if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3409       else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  3410     for p :: nat
  3411   proof -
  3412     have
  3413       "(\<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) =
  3414        (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)"
  3415       by simp
  3416     also have "\<dots> =
  3417        (if even p
  3418         then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
  3419         else 0)"
  3420       by (auto simp: sum_distrib_left field_simps scaleR_conv_of_real nonzero_of_real_divide)
  3421     also have "\<dots> = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  3422       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real atLeast0AtMost)
  3423     finally show ?thesis .
  3424   qed
  3425   then have
  3426     "(\<lambda>p. \<Sum>n\<le>p.
  3427         if even p
  3428         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3429         else 0) = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
  3430     by simp
  3431    also have "\<dots> sums cos (x + y)"
  3432     by (rule cos_converges)
  3433    finally show ?thesis .
  3434 qed
  3435 
  3436 theorem cos_add:
  3437   fixes x :: "'a::{real_normed_field,banach}"
  3438   shows "cos (x + y) = cos x * cos y - sin x * sin y"
  3439 proof -
  3440   have
  3441     "(if even p \<and> even n
  3442       then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
  3443      (if even p \<and> odd n
  3444       then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3445      (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  3446     if "n \<le> p" for n p :: nat
  3447     by simp
  3448   then have
  3449     "(\<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))
  3450       sums (cos x * cos y - sin x * sin y)"
  3451     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
  3452     by (simp add: sum_subtractf [symmetric])
  3453   then show ?thesis
  3454     by (blast intro: sums_cos_x_plus_y sums_unique2)
  3455 qed
  3456 
  3457 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin x"
  3458 proof -
  3459   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
  3460     by (auto simp: sin_coeff_def elim!: oddE)
  3461   show ?thesis
  3462     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
  3463 qed
  3464 
  3465 lemma sin_minus [simp]: "sin (- x) = - sin x"
  3466   for x :: "'a::{real_normed_algebra_1,banach}"
  3467   using sin_minus_converges [of x]
  3468   by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel]
  3469       suminf_minus sums_iff equation_minus_iff)
  3470 
  3471 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos x"
  3472 proof -
  3473   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
  3474     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
  3475   show ?thesis
  3476     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
  3477 qed
  3478 
  3479 lemma cos_minus [simp]: "cos (-x) = cos x"
  3480   for x :: "'a::{real_normed_algebra_1,banach}"
  3481   using cos_minus_converges [of x]
  3482   by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
  3483       suminf_minus sums_iff equation_minus_iff)
  3484 
  3485 lemma sin_cos_squared_add [simp]: "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
  3486   for x :: "'a::{real_normed_field,banach}"
  3487   using cos_add [of x "-x"]
  3488   by (simp add: power2_eq_square algebra_simps)
  3489 
  3490 lemma sin_cos_squared_add2 [simp]: "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
  3491   for x :: "'a::{real_normed_field,banach}"
  3492   by (subst add.commute, rule sin_cos_squared_add)
  3493 
  3494 lemma sin_cos_squared_add3 [simp]: "cos x * cos x + sin x * sin x = 1"
  3495   for x :: "'a::{real_normed_field,banach}"
  3496   using sin_cos_squared_add2 [unfolded power2_eq_square] .
  3497 
  3498 lemma sin_squared_eq: "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
  3499   for x :: "'a::{real_normed_field,banach}"
  3500   unfolding eq_diff_eq by (rule sin_cos_squared_add)
  3501 
  3502 lemma cos_squared_eq: "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
  3503   for x :: "'a::{real_normed_field,banach}"
  3504   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
  3505 
  3506 lemma abs_sin_le_one [simp]: "\<bar>sin x\<bar> \<le> 1"
  3507   for x :: real
  3508   by (rule power2_le_imp_le) (simp_all add: sin_squared_eq)
  3509 
  3510 lemma sin_ge_minus_one [simp]: "- 1 \<le> sin x"
  3511   for x :: real
  3512   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
  3513 
  3514 lemma sin_le_one [simp]: "sin x \<le> 1"
  3515   for x :: real
  3516   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
  3517 
  3518 lemma abs_cos_le_one [simp]: "\<bar>cos x\<bar> \<le> 1"
  3519   for x :: real
  3520   by (rule power2_le_imp_le) (simp_all add: cos_squared_eq)
  3521 
  3522 lemma cos_ge_minus_one [simp]: "- 1 \<le> cos x"
  3523   for x :: real
  3524   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
  3525 
  3526 lemma cos_le_one [simp]: "cos x \<le> 1"
  3527   for x :: real
  3528   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
  3529 
  3530 lemma cos_diff: "cos (x - y) = cos x * cos y + sin x * sin y"
  3531   for x :: "'a::{real_normed_field,banach}"
  3532   using cos_add [of x "- y"] by simp
  3533 
  3534 lemma cos_double: "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
  3535   for x :: "'a::{real_normed_field,banach}"
  3536   using cos_add [where x=x and y=x] by (simp add: power2_eq_square)
  3537 
  3538 lemma sin_cos_le1: "\<bar>sin x * sin y + cos x * cos y\<bar> \<le> 1"
  3539   for x :: real
  3540   using cos_diff [of x y] by (metis abs_cos_le_one add.commute)
  3541 
  3542 lemma DERIV_fun_pow: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  3543   by (auto intro!: derivative_eq_intros simp:)
  3544 
  3545 lemma DERIV_fun_exp: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. exp (g x)) x :> exp (g x) * m"
  3546   by (auto intro!: derivative_intros)
  3547 
  3548 
  3549 subsection \<open>The Constant Pi\<close>
  3550 
  3551 definition pi :: real
  3552   where "pi = 2 * (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
  3553 
  3554 text \<open>Show that there's a least positive @{term x} with @{term "cos x = 0"};
  3555    hence define pi.\<close>
  3556 
  3557 lemma sin_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
  3558   for x :: real
  3559 proof -
  3560   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
  3561     by (rule sums_group) (use sin_converges [of x, unfolded scaleR_conv_of_real] in auto)
  3562   then show ?thesis
  3563     by (simp add: sin_coeff_def ac_simps)
  3564 qed
  3565 
  3566 lemma sin_gt_zero_02:
  3567   fixes x :: real
  3568   assumes "0 < x" and "x < 2"
  3569   shows "0 < sin x"
  3570 proof -
  3571   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
  3572   have pos: "\<forall>n. 0 < ?f n"
  3573   proof
  3574     fix n :: nat
  3575     let ?k2 = "real (Suc (Suc (4 * n)))"
  3576     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
  3577     have "x * x < ?k2 * ?k3"
  3578       using assms by (intro mult_strict_mono', simp_all)
  3579     then have "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
  3580       by (intro mult_strict_right_mono zero_less_power \<open>0 < x\<close>)
  3581     then show "0 < ?f n"
  3582       by (simp add: divide_simps mult_ac del: mult_Suc)
  3583 qed
  3584   have sums: "?f sums sin x"
  3585     by (rule sin_paired [THEN sums_group]) simp
  3586   show "0 < sin x"
  3587     unfolding sums_unique [OF sums]
  3588     using sums_summable [OF sums] pos
  3589     by (rule suminf_pos)
  3590 qed
  3591 
  3592 lemma cos_double_less_one: "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
  3593   for x :: real
  3594   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
  3595 
  3596 lemma cos_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
  3597   for x :: real
  3598 proof -
  3599   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
  3600     by (rule sums_group) (use cos_converges [of x, unfolded scaleR_conv_of_real] in auto)
  3601   then show ?thesis
  3602     by (simp add: cos_coeff_def ac_simps)
  3603 qed
  3604 
  3605 lemmas realpow_num_eq_if = power_eq_if
  3606 
  3607 lemma sumr_pos_lt_pair:
  3608   fixes f :: "nat \<Rightarrow> real"
  3609   shows "summable f \<Longrightarrow>
  3610     (\<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc (Suc 0) * d) + 1))) \<Longrightarrow>
  3611     sum f {..<k} < suminf f"
  3612   apply (simp only: One_nat_def)
  3613   apply (subst suminf_split_initial_segment [where k=k])
  3614    apply assumption
  3615   apply simp
  3616   apply (drule_tac k=k in summable_ignore_initial_segment)
  3617   apply (drule_tac k="Suc (Suc 0)" in sums_group [OF summable_sums])
  3618    apply simp
  3619   apply simp
  3620   apply (metis (no_types, lifting) add.commute suminf_pos summable_def sums_unique)
  3621   done
  3622 
  3623 lemma cos_two_less_zero [simp]: "cos 2 < (0::real)"
  3624 proof -
  3625   note fact_Suc [simp del]
  3626   from sums_minus [OF cos_paired]
  3627   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
  3628     by simp
  3629   then have sm: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3630     by (rule sums_summable)
  3631   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3632     by (simp add: fact_num_eq_if realpow_num_eq_if)
  3633   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n)))) <
  3634     (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3635   proof -
  3636     {
  3637       fix d
  3638       let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
  3639       have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
  3640         unfolding of_nat_mult by (rule mult_strict_mono) (simp_all add: fact_less_mono)
  3641       then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
  3642         by (simp only: fact_Suc [of "Suc (?six4d)"] of_nat_mult of_nat_fact)
  3643       then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
  3644         by (simp add: inverse_eq_divide less_divide_eq)
  3645     }
  3646     then show ?thesis
  3647       by (force intro!: sumr_pos_lt_pair [OF sm] simp add: divide_inverse algebra_simps)
  3648   qed
  3649   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3650     by (rule order_less_trans)
  3651   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3652     by (rule sums_unique)
  3653   ultimately have "(0::real) < - cos 2" by simp
  3654   then show ?thesis by simp
  3655 qed
  3656 
  3657 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
  3658 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
  3659 
  3660 lemma cos_is_zero: "\<exists>!x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3661 proof (rule ex_ex1I)
  3662   show "\<exists>x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3663     by (rule IVT2) simp_all
  3664 next
  3665   fix x y :: real
  3666   assume x: "0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3667   assume y: "0 \<le> y \<and> y \<le> 2 \<and> cos y = 0"
  3668   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3669     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3670   from x y less_linear [of x y] show "x = y"
  3671     apply auto
  3672      apply (drule_tac f = cos in Rolle)
  3673         apply (drule_tac [5] f = cos in Rolle)
  3674            apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3675      apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3676     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3677     done
  3678 qed
  3679 
  3680 lemma pi_half: "pi/2 = (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
  3681   by (simp add: pi_def)
  3682 
  3683 lemma cos_pi_half [simp]: "cos (pi / 2) = 0"
  3684   by (simp add: pi_half cos_is_zero [THEN theI'])
  3685 
  3686 lemma cos_of_real_pi_half [simp]: "cos ((of_real pi / 2) :: 'a) = 0"
  3687   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
  3688   by (metis cos_pi_half cos_of_real eq_numeral_simps(4)
  3689       nonzero_of_real_divide of_real_0 of_real_numeral)
  3690 
  3691 lemma pi_half_gt_zero [simp]: "0 < pi / 2"
  3692   apply (rule order_le_neq_trans)
  3693    apply (simp add: pi_half cos_is_zero [THEN theI'])
  3694   apply (metis cos_pi_half cos_zero zero_neq_one)
  3695   done
  3696 
  3697 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
  3698 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
  3699 
  3700 lemma pi_half_less_two [simp]: "pi / 2 < 2"
  3701   apply (rule order_le_neq_trans)
  3702    apply (simp add: pi_half cos_is_zero [THEN theI'])
  3703   apply (metis cos_pi_half cos_two_neq_zero)
  3704   done
  3705 
  3706 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
  3707 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
  3708 
  3709 lemma pi_gt_zero [simp]: "0 < pi"
  3710   using pi_half_gt_zero by simp
  3711 
  3712 lemma pi_ge_zero [simp]: "0 \<le> pi"
  3713   by (rule pi_gt_zero [THEN order_less_imp_le])
  3714 
  3715 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
  3716   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
  3717 
  3718 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
  3719   by (simp add: linorder_not_less)
  3720 
  3721 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
  3722   by simp
  3723 
  3724 lemma m2pi_less_pi: "- (2*pi) < pi"
  3725   by simp
  3726 
  3727 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
  3728   using sin_cos_squared_add2 [where x = "pi/2"]
  3729   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
  3730   by (simp add: power2_eq_1_iff)
  3731 
  3732 lemma sin_of_real_pi_half [simp]: "sin ((of_real pi / 2) :: 'a) = 1"
  3733   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
  3734   using sin_pi_half
  3735   by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
  3736 
  3737 lemma sin_cos_eq: "sin x = cos (of_real pi / 2 - x)"
  3738   for x :: "'a::{real_normed_field,banach}"
  3739   by (simp add: cos_diff)
  3740 
  3741 lemma minus_sin_cos_eq: "- sin x = cos (x + of_real pi / 2)"
  3742   for x :: "'a::{real_normed_field,banach}"
  3743   by (simp add: cos_add nonzero_of_real_divide)
  3744 
  3745 lemma cos_sin_eq: "cos x = sin (of_real pi / 2 - x)"
  3746   for x :: "'a::{real_normed_field,banach}"
  3747   using sin_cos_eq [of "of_real pi / 2 - x"] by simp
  3748 
  3749 lemma sin_add: "sin (x + y) = sin x * cos y + cos x * sin y"
  3750   for x :: "'a::{real_normed_field,banach}"
  3751   using cos_add [of "of_real pi / 2 - x" "-y"]
  3752   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
  3753 
  3754 lemma sin_diff: "sin (x - y) = sin x * cos y - cos x * sin y"
  3755   for x :: "'a::{real_normed_field,banach}"
  3756   using sin_add [of x "- y"] by simp
  3757 
  3758 lemma sin_double: "sin(2 * x) = 2 * sin x * cos x"
  3759   for x :: "'a::{real_normed_field,banach}"
  3760   using sin_add [where x=x and y=x] by simp
  3761 
  3762 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
  3763   using cos_add [where x = "pi/2" and y = "pi/2"]
  3764   by (simp add: cos_of_real)
  3765 
  3766 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
  3767   using sin_add [where x = "pi/2" and y = "pi/2"]
  3768   by (simp add: sin_of_real)
  3769 
  3770 lemma cos_pi [simp]: "cos pi = -1"
  3771   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
  3772 
  3773 lemma sin_pi [simp]: "sin pi = 0"
  3774   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
  3775 
  3776 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
  3777   by (simp add: sin_add)
  3778 
  3779 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
  3780   by (simp add: sin_add)
  3781 
  3782 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
  3783   by (simp add: cos_add)
  3784 
  3785 lemma cos_periodic_pi2 [simp]: "cos (pi + x) = - cos x"
  3786   by (simp add: cos_add)
  3787 
  3788 lemma sin_periodic [simp]: "sin (x + 2 * pi) = sin x"
  3789   by (simp add: sin_add sin_double cos_double)
  3790 
  3791 lemma cos_periodic [simp]: "cos (x + 2 * pi) = cos x"
  3792   by (simp add: cos_add sin_double cos_double)
  3793 
  3794 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
  3795   by (induct n) (auto simp: distrib_right)
  3796 
  3797 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
  3798   by (metis cos_npi mult.commute)
  3799 
  3800 lemma sin_npi [simp]: "sin (real n * pi) = 0"
  3801   for n :: nat
  3802   by (induct n) (auto simp: distrib_right)
  3803 
  3804 lemma sin_npi2 [simp]: "sin (pi * real n) = 0"
  3805   for n :: nat
  3806   by (simp add: mult.commute [of pi])
  3807 
  3808 lemma cos_two_pi [simp]: "cos (2 * pi) = 1"
  3809   by (simp add: cos_double)
  3810 
  3811 lemma sin_two_pi [simp]: "sin (2 * pi) = 0"
  3812   by (simp add: sin_double)
  3813 
  3814 lemma sin_times_sin: "sin w * sin z = (cos (w - z) - cos (w + z)) / 2"
  3815   for w :: "'a::{real_normed_field,banach}"
  3816   by (simp add: cos_diff cos_add)
  3817 
  3818 lemma sin_times_cos: "sin w * cos z = (sin (w + z) + sin (w - z)) / 2"
  3819   for w :: "'a::{real_normed_field,banach}"
  3820   by (simp add: sin_diff sin_add)
  3821 
  3822 lemma cos_times_sin: "cos w * sin z = (sin (w + z) - sin (w - z)) / 2"
  3823   for w :: "'a::{real_normed_field,banach}"
  3824   by (simp add: sin_diff sin_add)
  3825 
  3826 lemma cos_times_cos: "cos w * cos z = (cos (w - z) + cos (w + z)) / 2"
  3827   for w :: "'a::{real_normed_field,banach}"
  3828   by (simp add: cos_diff cos_add)
  3829 
  3830 lemma sin_plus_sin: "sin w + sin z = 2 * sin ((w + z) / 2) * cos ((w - z) / 2)"
  3831   for w :: "'a::{real_normed_field,banach,field}"  (* FIXME field should not be necessary *)
  3832   apply (simp add: mult.assoc sin_times_cos)
  3833   apply (simp add: field_simps)
  3834   done
  3835 
  3836 lemma sin_diff_sin: "sin w - sin z = 2 * sin ((w - z) / 2) * cos ((w + z) / 2)"
  3837   for w :: "'a::{real_normed_field,banach,field}"
  3838   apply (simp add: mult.assoc sin_times_cos)
  3839   apply (simp add: field_simps)
  3840   done
  3841 
  3842 lemma cos_plus_cos: "cos w + cos z = 2 * cos ((w + z) / 2) * cos ((w - z) / 2)"
  3843   for w :: "'a::{real_normed_field,banach,field}"
  3844   apply (simp add: mult.assoc cos_times_cos)
  3845   apply (simp add: field_simps)
  3846   done
  3847 
  3848 lemma cos_diff_cos: "cos w - cos z = 2 * sin ((w + z) / 2) * sin ((z - w) / 2)"
  3849   for w :: "'a::{real_normed_field,banach,field}"
  3850   apply (simp add: mult.assoc sin_times_sin)
  3851   apply (simp add: field_simps)
  3852   done
  3853 
  3854 lemma cos_double_cos: "cos (2 * z) = 2 * cos z ^ 2 - 1"
  3855   for z :: "'a::{real_normed_field,banach}"
  3856   by (simp add: cos_double sin_squared_eq)
  3857 
  3858 lemma cos_double_sin: "cos (2 * z) = 1 - 2 * sin z ^ 2"
  3859   for z :: "'a::{real_normed_field,banach}"
  3860   by (simp add: cos_double sin_squared_eq)
  3861 
  3862 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
  3863   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
  3864 
  3865 lemma cos_pi_minus [simp]: "cos (pi - x) = - (cos x)"
  3866   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
  3867 
  3868 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
  3869   by (simp add: sin_diff)
  3870 
  3871 lemma cos_minus_pi [simp]: "cos (x - pi) = - (cos x)"
  3872   by (simp add: cos_diff)
  3873 
  3874 lemma sin_2pi_minus [simp]: "sin (2 * pi - x) = - (sin x)"
  3875   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
  3876 
  3877 lemma cos_2pi_minus [simp]: "cos (2 * pi - x) = cos x"
  3878   by (metis (no_types, hide_lams) cos_add cos_minus cos_two_pi sin_minus sin_two_pi
  3879       diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
  3880 
  3881 lemma sin_gt_zero2: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < sin x"
  3882   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
  3883 
  3884 lemma sin_less_zero:
  3885   assumes "- pi/2 < x" and "x < 0"
  3886   shows "sin x < 0"
  3887 proof -
  3888   have "0 < sin (- x)"
  3889     using assms by (simp only: sin_gt_zero2)
  3890   then show ?thesis by simp
  3891 qed
  3892 
  3893 lemma pi_less_4: "pi < 4"
  3894   using pi_half_less_two by auto
  3895 
  3896 lemma cos_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
  3897   by (simp add: cos_sin_eq sin_gt_zero2)
  3898 
  3899 lemma cos_gt_zero_pi: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
  3900   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
  3901   by (cases rule: linorder_cases [of x 0]) auto
  3902 
  3903 lemma cos_ge_zero: "-(pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> 0 \<le> cos x"
  3904   by (auto simp: order_le_less cos_gt_zero_pi)
  3905     (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
  3906 
  3907 lemma sin_gt_zero: "0 < x \<Longrightarrow> x < pi \<Longrightarrow> 0 < sin x"
  3908   by (simp add: sin_cos_eq cos_gt_zero_pi)
  3909 
  3910 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x < 0"
  3911   using sin_gt_zero [of "x - pi"]
  3912   by (simp add: sin_diff)
  3913 
  3914 lemma pi_ge_two: "2 \<le> pi"
  3915 proof (rule ccontr)
  3916   assume "\<not> ?thesis"
  3917   then have "pi < 2" by auto
  3918   have "\<exists>y > pi. y < 2 \<and> y < 2 * pi"
  3919   proof (cases "2 < 2 * pi")
  3920     case True
  3921     with dense[OF \<open>pi < 2\<close>] show ?thesis by auto
  3922   next
  3923     case False
  3924     have "pi < 2 * pi" by auto
  3925     from dense[OF this] and False show ?thesis by auto
  3926   qed
  3927   then obtain y where "pi < y" and "y < 2" and "y < 2 * pi"
  3928     by blast
  3929   then have "0 < sin y"
  3930     using sin_gt_zero_02 by auto
  3931   moreover have "sin y < 0"
  3932     using sin_gt_zero[of "y - pi"] \<open>pi < y\<close> and \<open>y < 2 * pi\<close> sin_periodic_pi[of "y - pi"]
  3933     by auto
  3934   ultimately show False by auto
  3935 qed
  3936 
  3937 lemma sin_ge_zero: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> sin x"
  3938   by (auto simp: order_le_less sin_gt_zero)
  3939 
  3940 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x \<le> 0"
  3941   using sin_ge_zero [of "x - pi"] by (simp add: sin_diff)
  3942 
  3943 lemma sin_pi_divide_n_ge_0 [simp]:
  3944   assumes "n \<noteq> 0"
  3945   shows "0 \<le> sin (pi / real n)"
  3946   by (rule sin_ge_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
  3947 
  3948 lemma sin_pi_divide_n_gt_0:
  3949   assumes "2 \<le> n"
  3950   shows "0 < sin (pi / real n)"
  3951   by (rule sin_gt_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
  3952 
  3953 (* FIXME: This proof is almost identical to lemma \<open>cos_is_zero\<close>.
  3954    It should be possible to factor out some of the common parts. *)
  3955 lemma cos_total:
  3956   assumes y: "- 1 \<le> y" "y \<le> 1"
  3957   shows "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
  3958 proof (rule ex_ex1I)
  3959   show "\<exists>x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
  3960     by (rule IVT2) (simp_all add: y)
  3961 next
  3962   fix a b
  3963   assume a: "0 \<le> a \<and> a \<le> pi \<and> cos a = y"
  3964   assume b: "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
  3965   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3966     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3967   from a b less_linear [of a b] show "a = b"
  3968     apply auto
  3969      apply (drule_tac f = cos in Rolle)
  3970         apply (drule_tac [5] f = cos in Rolle)
  3971            apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3972      apply (metis order_less_le_trans less_le sin_gt_zero)
  3973     apply (metis order_less_le_trans less_le sin_gt_zero)
  3974     done
  3975 qed
  3976 
  3977 lemma sin_total:
  3978   assumes y: "-1 \<le> y" "y \<le> 1"
  3979   shows "\<exists>!x. - (pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y"
  3980 proof -
  3981   from cos_total [OF y]
  3982   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
  3983     and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
  3984     by blast
  3985   show ?thesis
  3986     apply (simp add: sin_cos_eq)
  3987     apply (rule ex1I [where a="pi/2 - x"])
  3988      apply (cut_tac [2] x'="pi/2 - xa" in uniq)
  3989     using x
  3990         apply auto
  3991     done
  3992 qed
  3993 
  3994 lemma cos_zero_lemma:
  3995   assumes "0 \<le> x" "cos x = 0"
  3996   shows "\<exists>n. odd n \<and> x = of_nat n * (pi/2) \<and> n > 0"
  3997 proof -
  3998   have xle: "x < (1 + real_of_int \<lfloor>x/pi\<rfloor>) * pi"
  3999     using floor_correct [of "x/pi"]
  4000     by (simp add: add.commute divide_less_eq)
  4001   obtain n where "real n * pi \<le> x" "x < real (Suc n) * pi"
  4002     apply (rule that [of "nat \<lfloor>x/pi\<rfloor>"])
  4003     using assms
  4004      apply (simp_all add: xle)
  4005     apply (metis floor_less_iff less_irrefl mult_imp_div_pos_less not_le pi_gt_zero)
  4006     done
  4007   then have x: "0 \<le> x - n * pi" "(x - n * pi) \<le> pi" "cos (x - n * pi) = 0"
  4008     by (auto simp: algebra_simps cos_diff assms)
  4009   then have "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = 0"
  4010     by (auto simp: intro!: cos_total)
  4011   then obtain \<theta> where \<theta>: "0 \<le> \<theta>" "\<theta> \<le> pi" "cos \<theta> = 0"
  4012     and uniq: "\<And>\<phi>. 0 \<le> \<phi> \<Longrightarrow> \<phi> \<le> pi \<Longrightarrow> cos \<phi> = 0 \<Longrightarrow> \<phi> = \<theta>"
  4013     by blast
  4014   then have "x - real n * pi = \<theta>"
  4015     using x by blast
  4016   moreover have "pi/2 = \<theta>"
  4017     using pi_half_ge_zero uniq by fastforce
  4018   ultimately show ?thesis
  4019     by (rule_tac x = "Suc (2 * n)" in exI) (simp add: algebra_simps)
  4020 qed
  4021 
  4022 lemma sin_zero_lemma: "0 \<le> x \<Longrightarrow> sin x = 0 \<Longrightarrow> \<exists>n::nat. even n \<and> x = real n * (pi/2)"
  4023   using cos_zero_lemma [of "x + pi/2"]
  4024   apply (clarsimp simp add: cos_add)
  4025   apply (rule_tac x = "n - 1" in exI)
  4026   apply (simp add: algebra_simps of_nat_diff)
  4027   done
  4028 
  4029 lemma cos_zero_iff:
  4030   "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))))"
  4031   (is "?lhs = ?rhs")
  4032 proof -
  4033   have *: "cos (real n * pi / 2) = 0" if "odd n" for n :: nat
  4034   proof -
  4035     from that obtain m where "n = 2 * m + 1" ..
  4036     then show ?thesis
  4037       by (simp add: field_simps) (simp add: cos_add add_divide_distrib)
  4038   qed
  4039   show ?thesis
  4040   proof
  4041     show ?rhs if ?lhs
  4042       using that cos_zero_lemma [of x] cos_zero_lemma [of "-x"] by force
  4043     show ?lhs if ?rhs
  4044       using that by (auto dest: * simp del: eq_divide_eq_numeral1)
  4045   qed
  4046 qed
  4047 
  4048 lemma sin_zero_iff:
  4049   "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))))"
  4050   (is "?lhs = ?rhs")
  4051 proof
  4052   show ?rhs if ?lhs
  4053     using that sin_zero_lemma [of x] sin_zero_lemma [of "-x"] by force
  4054   show ?lhs if ?rhs
  4055     using that by (auto elim: evenE)
  4056 qed
  4057 
  4058 lemma cos_zero_iff_int: "cos x = 0 \<longleftrightarrow> (\<exists>n. odd n \<and> x = of_int n * (pi/2))"
  4059 proof safe
  4060   assume "cos x = 0"
  4061   then show "\<exists>n. odd n \<and> x = of_int n * (pi/2)"
  4062     apply (simp add: cos_zero_iff)
  4063     apply safe
  4064      apply (metis even_int_iff of_int_of_nat_eq)
  4065     apply (rule_tac x="- (int n)" in exI)
  4066     apply simp
  4067     done
  4068 next
  4069   fix n :: int
  4070   assume "odd n"
  4071   then show "cos (of_int n * (pi / 2)) = 0"
  4072     apply (simp add: cos_zero_iff)
  4073     apply (cases n rule: int_cases2)
  4074      apply simp_all
  4075     done
  4076 qed
  4077 
  4078 lemma sin_zero_iff_int: "sin x = 0 \<longleftrightarrow> (\<exists>n. even n \<and> x = of_int n * (pi/2))"
  4079 proof safe
  4080   assume "sin x = 0"
  4081   then show "\<exists>n. even n \<and> x = of_int n * (pi / 2)"
  4082     apply (simp add: sin_zero_iff)
  4083     apply safe
  4084      apply (metis even_int_iff of_int_of_nat_eq)
  4085     apply (rule_tac x="- (int n)" in exI)
  4086     apply simp
  4087     done
  4088 next
  4089   fix n :: int
  4090   assume "even n"
  4091   then show "sin (of_int n * (pi / 2)) = 0"
  4092     apply (simp add: sin_zero_iff)
  4093     apply (cases n rule: int_cases2)
  4094      apply simp_all
  4095     done
  4096 qed
  4097 
  4098 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>n::int. x = of_int n * pi)"
  4099   apply (simp only: sin_zero_iff_int)
  4100   apply (safe elim!: evenE)
  4101    apply (simp_all add: field_simps)
  4102   using dvd_triv_left apply fastforce
  4103   done
  4104 
  4105 lemma sin_npi_int [simp]: "sin (pi * of_int n) = 0"
  4106   by (simp add: sin_zero_iff_int2)
  4107 
  4108 lemma cos_monotone_0_pi:
  4109   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
  4110   shows "cos x < cos y"
  4111 proof -
  4112   have "- (x - y) < 0" using assms by auto
  4113   from MVT2[OF \<open>y < x\<close> DERIV_cos[THEN impI, THEN allI]]
  4114   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
  4115     by auto
  4116   then have "0 < z" and "z < pi"
  4117     using assms by auto
  4118   then have "0 < sin z"
  4119     using sin_gt_zero by auto
  4120   then have "cos x - cos y < 0"
  4121     unfolding cos_diff minus_mult_commute[symmetric]
  4122     using \<open>- (x - y) < 0\<close> by (rule mult_pos_neg2)
  4123   then show ?thesis by auto
  4124 qed
  4125 
  4126 lemma cos_monotone_0_pi_le:
  4127   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
  4128   shows "cos x \<le> cos y"
  4129 proof (cases "y < x")
  4130   case True
  4131   show ?thesis
  4132     using cos_monotone_0_pi[OF \<open>0 \<le> y\<close> True \<open>x \<le> pi\<close>] by auto
  4133 next
  4134   case False
  4135   then have "y = x" using \<open>y \<le> x\<close> by auto
  4136   then show ?thesis by auto
  4137 qed
  4138 
  4139 lemma cos_monotone_minus_pi_0:
  4140   assumes "- pi \<le> y" and "y < x" and "x \<le> 0"
  4141   shows "cos y < cos x"
  4142 proof -
  4143   have "0 \<le> - x" and "- x < - y" and "- y \<le> pi"
  4144     using assms by auto
  4145   from cos_monotone_0_pi[OF this] show ?thesis
  4146     unfolding cos_minus .
  4147 qed
  4148 
  4149 lemma cos_monotone_minus_pi_0':
  4150   assumes "- pi \<le> y" and "y \<le> x" and "x \<le> 0"
  4151   shows "cos y \<le> cos x"
  4152 proof (cases "y < x")
  4153   case True
  4154   show ?thesis using cos_monotone_minus_pi_0[OF \<open>-pi \<le> y\<close> True \<open>x \<le> 0\<close>]
  4155     by auto
  4156 next
  4157   case False
  4158   then have "y = x" using \<open>y \<le> x\<close> by auto
  4159   then show ?thesis by auto
  4160 qed
  4161 
  4162 lemma sin_monotone_2pi:
  4163   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
  4164   shows "sin y < sin x"
  4165   apply (simp add: sin_cos_eq)
  4166   apply (rule cos_monotone_0_pi)
  4167   using assms
  4168     apply auto
  4169   done
  4170 
  4171 lemma sin_monotone_2pi_le:
  4172   assumes "- (pi / 2) \<le> y" and "y \<le> x" and "x \<le> pi / 2"
  4173   shows "sin y \<le> sin x"
  4174   by (metis assms le_less sin_monotone_2pi)
  4175 
  4176 lemma sin_x_le_x:
  4177   fixes x :: real
  4178   assumes x: "x \<ge> 0"
  4179   shows "sin x \<le> x"
  4180 proof -
  4181   let ?f = "\<lambda>x. x - sin x"
  4182   from x have "?f x \<ge> ?f 0"
  4183     apply (rule DERIV_nonneg_imp_nondecreasing)
  4184     apply (intro allI impI exI[of _ "1 - cos x" for x])
  4185     apply (auto intro!: derivative_eq_intros simp: field_simps)
  4186     done
  4187   then show "sin x \<le> x" by simp
  4188 qed
  4189 
  4190 lemma sin_x_ge_neg_x:
  4191   fixes x :: real
  4192   assumes x: "x \<ge> 0"
  4193   shows "sin x \<ge> - x"
  4194 proof -
  4195   let ?f = "\<lambda>x. x + sin x"
  4196   from x have "?f x \<ge> ?f 0"
  4197     apply (rule DERIV_nonneg_imp_nondecreasing)
  4198     apply (intro allI impI exI[of _ "1 + cos x" for x])
  4199     apply (auto intro!: derivative_eq_intros simp: field_simps real_0_le_add_iff)
  4200     done
  4201   then show "sin x \<ge> -x" by simp
  4202 qed
  4203 
  4204 lemma abs_sin_x_le_abs_x: "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
  4205   for x :: real
  4206   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"]
  4207   by (auto simp: abs_real_def)
  4208 
  4209 
  4210 subsection \<open>More Corollaries about Sine and Cosine\<close>
  4211 
  4212 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi / 2) = (-1) ^ n"
  4213 proof -
  4214   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
  4215     by (auto simp: algebra_simps sin_add)
  4216   then show ?thesis
  4217     by (simp add: distrib_right add_divide_distrib add.commute mult.commute [of pi])
  4218 qed
  4219 
  4220 lemma cos_2npi [simp]: "cos (2 * real n * pi) = 1"
  4221   for n :: nat
  4222   by (cases "even n") (simp_all add: cos_double mult.assoc)
  4223 
  4224 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
  4225   apply (subgoal_tac "cos (pi + pi/2) = 0")
  4226    apply simp
  4227   apply (subst cos_add)
  4228   apply simp
  4229   done
  4230 
  4231 lemma sin_2npi [simp]: "sin (2 * real n * pi) = 0"
  4232   for n :: nat
  4233   by (auto simp: mult.assoc sin_double)
  4234 
  4235 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
  4236   apply (subgoal_tac "sin (pi + pi/2) = - 1")
  4237    apply simp
  4238   apply (subst sin_add)
  4239   apply simp
  4240   done
  4241 
  4242 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
  4243   by (simp only: cos_add sin_add of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
  4244 
  4245 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
  4246   by (auto intro!: derivative_eq_intros)
  4247 
  4248 lemma sin_zero_norm_cos_one:
  4249   fixes x :: "'a::{real_normed_field,banach}"
  4250   assumes "sin x = 0"
  4251   shows "norm (cos x) = 1"
  4252   using sin_cos_squared_add [of x, unfolded assms]
  4253   by (simp add: square_norm_one)
  4254 
  4255 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
  4256   using sin_zero_norm_cos_one by fastforce
  4257 
  4258 lemma cos_one_sin_zero:
  4259   fixes x :: "'a::{real_normed_field,banach}"
  4260   assumes "cos x = 1"
  4261   shows "sin x = 0"
  4262   using sin_cos_squared_add [of x, unfolded assms]
  4263   by simp
  4264 
  4265 lemma sin_times_pi_eq_0: "sin (x * pi) = 0 \<longleftrightarrow> x \<in> \<int>"
  4266   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_of_int)
  4267 
  4268 lemma cos_one_2pi: "cos x = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2 * pi) | (\<exists>n::nat. x = - (n * 2 * pi))"
  4269   (is "?lhs = ?rhs")
  4270 proof
  4271   assume ?lhs
  4272   then have "sin x = 0"
  4273     by (simp add: cos_one_sin_zero)
  4274   then show ?rhs
  4275   proof (simp only: sin_zero_iff, elim exE disjE conjE)
  4276     fix n :: nat
  4277     assume n: "even n" "x = real n * (pi/2)"
  4278     then obtain m where m: "n = 2 * m"
  4279       using dvdE by blast
  4280     then have me: "even m" using \<open>?lhs\<close> n
  4281       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  4282     show ?rhs
  4283       using m me n
  4284       by (auto simp: field_simps elim!: evenE)
  4285   next
  4286     fix n :: nat
  4287     assume n: "even n" "x = - (real n * (pi/2))"
  4288     then obtain m where m: "n = 2 * m"
  4289       using dvdE by blast
  4290     then have me: "even m" using \<open>?lhs\<close> n
  4291       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  4292     show ?rhs
  4293       using m me n
  4294       by (auto simp: field_simps elim!: evenE)
  4295   qed
  4296 next
  4297   assume ?rhs
  4298   then show "cos x = 1"
  4299     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
  4300 qed
  4301 
  4302 lemma cos_one_2pi_int: "cos x = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2 * pi)" (is "?lhs = ?rhs")
  4303 proof
  4304   assume "cos x = 1"
  4305   then show ?rhs
  4306     apply (auto simp: cos_one_2pi)
  4307      apply (metis of_int_of_nat_eq)
  4308     apply (metis mult_minus_right of_int_minus of_int_of_nat_eq)
  4309     done
  4310 next
  4311   assume ?rhs
  4312   then show "cos x = 1"
  4313     by (clarsimp simp add: cos_one_2pi) (metis mult_minus_right of_int_of_nat)
  4314 qed
  4315 
  4316 lemma cos_npi_int [simp]:
  4317   fixes n::int shows "cos (pi * of_int n) = (if even n then 1 else -1)"
  4318     by (auto simp: algebra_simps cos_one_2pi_int elim!: oddE evenE)
  4319 
  4320 lemma sin_cos_sqrt: "0 \<le> sin x \<Longrightarrow> sin x = sqrt (1 - (cos(x) ^ 2))"
  4321   using sin_squared_eq real_sqrt_unique by fastforce
  4322 
  4323 lemma sin_eq_0_pi: "- pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin x = 0 \<Longrightarrow> x = 0"
  4324   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
  4325 
  4326 lemma cos_treble_cos: "cos (3 * x) = 4 * cos x ^ 3 - 3 * cos x"
  4327   for x :: "'a::{real_normed_field,banach}"
  4328 proof -
  4329   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
  4330     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
  4331   have "cos(3 * x) = cos(2*x + x)"
  4332     by simp
  4333   also have "\<dots> = 4 * cos x ^ 3 - 3 * cos x"
  4334     apply (simp only: cos_add cos_double sin_double)
  4335     apply (simp add: * field_simps power2_eq_square power3_eq_cube)
  4336     done
  4337   finally show ?thesis .
  4338 qed
  4339 
  4340 lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
  4341 proof -
  4342   let ?c = "cos (pi / 4)"
  4343   let ?s = "sin (pi / 4)"
  4344   have nonneg: "0 \<le> ?c"
  4345     by (simp add: cos_ge_zero)
  4346   have "0 = cos (pi / 4 + pi / 4)"
  4347     by simp
  4348   also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
  4349     by (simp only: cos_add power2_eq_square)
  4350   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
  4351     by (simp add: sin_squared_eq)
  4352   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
  4353     by (simp add: power_divide)
  4354   then show ?thesis
  4355     using nonneg by (rule power2_eq_imp_eq) simp
  4356 qed
  4357 
  4358 lemma cos_30: "cos (pi / 6) = sqrt 3/2"
  4359 proof -
  4360   let ?c = "cos (pi / 6)"
  4361   let ?s = "sin (pi / 6)"
  4362   have pos_c: "0 < ?c"
  4363     by (rule cos_gt_zero) simp_all
  4364   have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
  4365     by simp
  4366   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
  4367     by (simp only: cos_add sin_add)
  4368   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
  4369     by (simp add: algebra_simps power2_eq_square)
  4370   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
  4371     using pos_c by (simp add: sin_squared_eq power_divide)
  4372   then show ?thesis
  4373     using pos_c [THEN order_less_imp_le]
  4374     by (rule power2_eq_imp_eq) simp
  4375 qed
  4376 
  4377 lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
  4378   by (simp add: sin_cos_eq cos_45)
  4379 
  4380 lemma sin_60: "sin (pi / 3) = sqrt 3/2"
  4381   by (simp add: sin_cos_eq cos_30)
  4382 
  4383 lemma cos_60: "cos (pi / 3) = 1 / 2"
  4384   apply (rule power2_eq_imp_eq)
  4385     apply (simp add: cos_squared_eq sin_60 power_divide)
  4386    apply (rule cos_ge_zero)
  4387     apply (rule order_trans [where y=0])
  4388      apply simp_all
  4389   done
  4390 
  4391 lemma sin_30: "sin (pi / 6) = 1 / 2"
  4392   by (simp add: sin_cos_eq cos_60)
  4393 
  4394 lemma cos_integer_2pi: "n \<in> \<int> \<Longrightarrow> cos(2 * pi * n) = 1"
  4395   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute)
  4396 
  4397 lemma sin_integer_2pi: "n \<in> \<int> \<Longrightarrow> sin(2 * pi * n) = 0"
  4398   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
  4399 
  4400 lemma cos_int_2npi [simp]: "cos (2 * of_int n * pi) = 1"
  4401   for n :: int
  4402   by (simp add: cos_one_2pi_int)
  4403 
  4404 lemma sin_int_2npi [simp]: "sin (2 * of_int n * pi) = 0"
  4405   for n :: int
  4406   by (metis Ints_of_int mult.assoc mult.commute sin_integer_2pi)
  4407 
  4408 lemma sincos_principal_value: "\<exists>y. (- pi < y \<and> y \<le> pi) \<and> (sin y = sin x \<and> cos y = cos x)"
  4409   apply (rule exI [where x="pi - (2 * pi) * frac ((pi - x) / (2 * pi))"])
  4410   apply (auto simp: field_simps frac_lt_1)
  4411    apply (simp_all add: frac_def divide_simps)
  4412    apply (simp_all add: add_divide_distrib diff_divide_distrib)
  4413    apply (simp_all add: sin_diff cos_diff mult.assoc [symmetric] cos_integer_2pi sin_integer_2pi)
  4414   done
  4415 
  4416 
  4417 subsection \<open>Tangent\<close>
  4418 
  4419 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4420   where "tan = (\<lambda>x. sin x / cos x)"
  4421 
  4422 lemma tan_of_real: "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
  4423   by (simp add: tan_def sin_of_real cos_of_real)
  4424 
  4425 lemma tan_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> tan z \<in> \<real>"
  4426   for z :: "'a::{real_normed_field,banach}"
  4427   by (simp add: tan_def)
  4428 
  4429 lemma tan_zero [simp]: "tan 0 = 0"
  4430   by (simp add: tan_def)
  4431 
  4432 lemma tan_pi [simp]: "tan pi = 0"
  4433   by (simp add: tan_def)
  4434 
  4435 lemma tan_npi [simp]: "tan (real n * pi) = 0"
  4436   for n :: nat
  4437   by (simp add: tan_def)
  4438 
  4439 lemma tan_minus [simp]: "tan (- x) = - tan x"
  4440   by (simp add: tan_def)
  4441 
  4442 lemma tan_periodic [simp]: "tan (x + 2 * pi) = tan x"
  4443   by (simp add: tan_def)
  4444 
  4445 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)"
  4446   by (simp add: tan_def cos_add field_simps)
  4447 
  4448 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)"
  4449   for x :: "'a::{real_normed_field,banach}"
  4450   by (simp add: tan_def sin_add field_simps)
  4451 
  4452 lemma tan_add:
  4453   "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)"
  4454   for x :: "'a::{real_normed_field,banach}"
  4455   by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
  4456 
  4457 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)"
  4458   for x :: "'a::{real_normed_field,banach}"
  4459   using tan_add [of x x] by (simp add: power2_eq_square)
  4460 
  4461 lemma tan_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < tan x"
  4462   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  4463 
  4464 lemma tan_less_zero:
  4465   assumes "- pi/2 < x" and "x < 0"
  4466   shows "tan x < 0"
  4467 proof -
  4468   have "0 < tan (- x)"
  4469     using assms by (simp only: tan_gt_zero)
  4470   then show ?thesis by simp
  4471 qed
  4472 
  4473 lemma tan_half: "tan x = sin (2 * x) / (cos (2 * x) + 1)"
  4474   for x :: "'a::{real_normed_field,banach,field}"
  4475   unfolding tan_def sin_double cos_double sin_squared_eq
  4476   by (simp add: power2_eq_square)
  4477 
  4478 lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
  4479   unfolding tan_def by (simp add: sin_30 cos_30)
  4480 
  4481 lemma tan_45: "tan (pi / 4) = 1"
  4482   unfolding tan_def by (simp add: sin_45 cos_45)
  4483 
  4484 lemma tan_60: "tan (pi / 3) = sqrt 3"
  4485   unfolding tan_def by (simp add: sin_60 cos_60)
  4486 
  4487 lemma DERIV_tan [simp]: "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
  4488   for x :: "'a::{real_normed_field,banach}"
  4489   unfolding tan_def
  4490   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
  4491 
  4492 lemma isCont_tan: "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
  4493   for x :: "'a::{real_normed_field,banach}"
  4494   by (rule DERIV_tan [THEN DERIV_isCont])
  4495 
  4496 lemma isCont_tan' [simp,continuous_intros]:
  4497   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  4498   shows "isCont f a \<Longrightarrow> cos (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
  4499   by (rule isCont_o2 [OF _ isCont_tan])
  4500 
  4501 lemma tendsto_tan [tendsto_intros]:
  4502   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4503   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cos a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tan (f x)) \<longlongrightarrow> tan a) F"
  4504   by (rule isCont_tendsto_compose [OF isCont_tan])
  4505 
  4506 lemma continuous_tan:
  4507   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4508   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
  4509   unfolding continuous_def by (rule tendsto_tan)
  4510 
  4511 lemma continuous_on_tan [continuous_intros]:
  4512   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4513   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
  4514   unfolding continuous_on_def by (auto intro: tendsto_tan)
  4515 
  4516 lemma continuous_within_tan [continuous_intros]:
  4517   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4518   shows "continuous (at x within s) f \<Longrightarrow>
  4519     cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
  4520   unfolding continuous_within by (rule tendsto_tan)
  4521 
  4522 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) \<midarrow>pi/2\<rightarrow> 0"
  4523   by (rule LIM_cong_limit, (rule tendsto_intros)+, simp_all)
  4524 
  4525 lemma lemma_tan_total: "0 < y \<Longrightarrow> \<exists>x. 0 < x \<and> x < pi/2 \<and> y < tan x"
  4526   apply (insert LIM_cos_div_sin)
  4527   apply (simp only: LIM_eq)
  4528   apply (drule_tac x = "inverse y" in spec)
  4529   apply safe
  4530    apply force
  4531   apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero])
  4532   apply safe
  4533   apply (rule_tac x = "(pi/2) - e" in exI)
  4534   apply (simp (no_asm_simp))
  4535   apply (drule_tac x = "(pi/2) - e" in spec)
  4536   apply (auto simp add: tan_def sin_diff cos_diff)
  4537   apply (rule inverse_less_iff_less [THEN iffD1])
  4538     apply (auto simp add: divide_inverse)
  4539    apply (rule mult_pos_pos)
  4540     apply (subgoal_tac [3] "0 < sin e \<and> 0 < cos e")
  4541      apply (auto intro: cos_gt_zero sin_gt_zero2 simp: mult.commute)
  4542   done
  4543 
  4544 lemma tan_total_pos: "0 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x < pi/2 \<and> tan x = y"
  4545   apply (frule order_le_imp_less_or_eq)
  4546   apply safe
  4547    prefer 2 apply force
  4548   apply (drule lemma_tan_total)
  4549   apply safe
  4550   apply (cut_tac f = tan and a = 0 and b = x and y = y in IVT_objl)
  4551   apply (auto intro!: DERIV_tan [THEN DERIV_isCont])
  4552   apply (drule_tac y = xa in order_le_imp_less_or_eq)
  4553   apply (auto dest: cos_gt_zero)
  4554   done
  4555 
  4556 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
  4557   apply (insert linorder_linear [of 0 y])
  4558   apply safe
  4559    apply (drule tan_total_pos)
  4560    apply (cut_tac [2] y="-y" in tan_total_pos)
  4561     apply safe
  4562     apply (rule_tac [3] x = "-x" in exI)
  4563     apply (auto del: exI intro!: exI)
  4564   done
  4565 
  4566 lemma tan_total: "\<exists>! x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
  4567   apply (insert lemma_tan_total1 [where y = y])
  4568   apply auto
  4569   apply hypsubst_thin
  4570   apply (cut_tac x = xa and y = y in linorder_less_linear)
  4571   apply auto
  4572    apply (subgoal_tac [2] "\<exists>z. y < z \<and> z < xa \<and> DERIV tan z :> 0")
  4573     apply (subgoal_tac "\<exists>z. xa < z \<and> z < y \<and> DERIV tan z :> 0")
  4574      apply (rule_tac [4] Rolle)
  4575         apply (rule_tac [2] Rolle)
  4576            apply (auto del: exI intro!: DERIV_tan DERIV_isCont exI
  4577             simp add: real_differentiable_def)
  4578        apply (rule_tac [!] DERIV_tan asm_rl)
  4579        apply (auto dest!: DERIV_unique [OF _ DERIV_tan]
  4580         simp add: cos_gt_zero_pi [THEN less_imp_neq, THEN not_sym])
  4581   done
  4582 
  4583 lemma tan_monotone:
  4584   assumes "- (pi / 2) < y" and "y < x" and "x < pi / 2"
  4585   shows "tan y < tan x"
  4586 proof -
  4587   have "\<forall>x'. y \<le> x' \<and> x' \<le> x \<longrightarrow> DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4588   proof (rule allI, rule impI)
  4589     fix x' :: real
  4590     assume "y \<le> x' \<and> x' \<le> x"
  4591     then have "-(pi/2) < x'" and "x' < pi/2"
  4592       using assms by auto
  4593     from cos_gt_zero_pi[OF this]
  4594     have "cos x' \<noteq> 0" by auto
  4595     then show "DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4596       by (rule DERIV_tan)
  4597   qed
  4598   from MVT2[OF \<open>y < x\<close> this]
  4599   obtain z where "y < z" and "z < x"
  4600     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
  4601   then have "- (pi / 2) < z" and "z < pi / 2"
  4602     using assms by auto
  4603   then have "0 < cos z"
  4604     using cos_gt_zero_pi by auto
  4605   then have inv_pos: "0 < inverse ((cos z)\<^sup>2)"
  4606     by auto
  4607   have "0 < x - y" using \<open>y < x\<close> by auto
  4608   with inv_pos have "0 < tan x - tan y"
  4609     unfolding tan_diff by auto
  4610   then show ?thesis by auto
  4611 qed
  4612 
  4613 lemma tan_monotone':
  4614   assumes "- (pi / 2) < y"
  4615     and "y < pi / 2"
  4616     and "- (pi / 2) < x"
  4617     and "x < pi / 2"
  4618   shows "y < x \<longleftrightarrow> tan y < tan x"
  4619 proof
  4620   assume "y < x"
  4621   then show "tan y < tan x"
  4622     using tan_monotone and \<open>- (pi / 2) < y\<close> and \<open>x < pi / 2\<close> by auto
  4623 next
  4624   assume "tan y < tan x"
  4625   show "y < x"
  4626   proof (rule ccontr)
  4627     assume "\<not> ?thesis"
  4628     then have "x \<le> y" by auto
  4629     then have "tan x \<le> tan y"
  4630     proof (cases "x = y")
  4631       case True
  4632       then show ?thesis by auto
  4633     next
  4634       case False
  4635       then have "x < y" using \<open>x \<le> y\<close> by auto
  4636       from tan_monotone[OF \<open>- (pi/2) < x\<close> this \<open>y < pi / 2\<close>] show ?thesis
  4637         by auto
  4638     qed
  4639     then show False
  4640       using \<open>tan y < tan x\<close> by auto
  4641   qed
  4642 qed
  4643 
  4644 lemma tan_inverse: "1 / (tan y) = tan (pi / 2 - y)"
  4645   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
  4646 
  4647 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
  4648   by (simp add: tan_def)
  4649 
  4650 lemma tan_periodic_nat[simp]: "tan (x + real n * pi) = tan x"
  4651   for n :: nat
  4652 proof (induct n arbitrary: x)
  4653   case 0
  4654   then show ?case by simp
  4655 next
  4656   case (Suc n)
  4657   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
  4658     unfolding Suc_eq_plus1 of_nat_add  distrib_right by auto
  4659   show ?case
  4660     unfolding split_pi_off using Suc by auto
  4661 qed
  4662 
  4663 lemma tan_periodic_int[simp]: "tan (x + of_int i * pi) = tan x"
  4664 proof (cases "0 \<le> i")
  4665   case True
  4666   then have i_nat: "of_int i = of_int (nat i)" by auto
  4667   show ?thesis unfolding i_nat
  4668     by (metis of_int_of_nat_eq tan_periodic_nat)
  4669 next
  4670   case False
  4671   then have i_nat: "of_int i = - of_int (nat (- i))" by auto
  4672   have "tan x = tan (x + of_int i * pi - of_int i * pi)"
  4673     by auto
  4674   also have "\<dots> = tan (x + of_int i * pi)"
  4675     unfolding i_nat mult_minus_left diff_minus_eq_add
  4676     by (metis of_int_of_nat_eq tan_periodic_nat)
  4677   finally show ?thesis by auto
  4678 qed
  4679 
  4680 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
  4681   using tan_periodic_int[of _ "numeral n" ] by simp
  4682 
  4683 lemma tan_minus_45: "tan (-(pi/4)) = -1"
  4684   unfolding tan_def by (simp add: sin_45 cos_45)
  4685 
  4686 lemma tan_diff:
  4687   "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)"
  4688   for x :: "'a::{real_normed_field,banach}"
  4689   using tan_add [of x "-y"] by simp
  4690 
  4691 lemma tan_pos_pi2_le: "0 \<le> x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
  4692   using less_eq_real_def tan_gt_zero by auto
  4693 
  4694 lemma cos_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> cos x = 1 / sqrt (1 + tan x ^ 2)"
  4695   using cos_gt_zero_pi [of x]
  4696   by (simp add: divide_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
  4697 
  4698 lemma sin_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> sin x = tan x / sqrt (1 + tan x ^ 2)"
  4699   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
  4700   by (force simp add: divide_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
  4701 
  4702 lemma tan_mono_le: "-(pi/2) < x \<Longrightarrow> x \<le> y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y"
  4703   using less_eq_real_def tan_monotone by auto
  4704 
  4705 lemma tan_mono_lt_eq:
  4706   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x < tan y \<longleftrightarrow> x < y"
  4707   using tan_monotone' by blast
  4708 
  4709 lemma tan_mono_le_eq:
  4710   "-(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"
  4711   by (meson tan_mono_le not_le tan_monotone)
  4712 
  4713 lemma tan_bound_pi2: "\<bar>x\<bar> < pi/4 \<Longrightarrow> \<bar>tan x\<bar> < 1"
  4714   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
  4715   by (auto simp: abs_if split: if_split_asm)
  4716 
  4717 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
  4718   by (simp add: tan_def sin_diff cos_diff)
  4719 
  4720 
  4721 subsection \<open>Cotangent\<close>
  4722 
  4723 definition cot :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4724   where "cot = (\<lambda>x. cos x / sin x)"
  4725 
  4726 lemma cot_of_real: "of_real (cot x) = (cot (of_real x) :: 'a::{real_normed_field,banach})"
  4727   by (simp add: cot_def sin_of_real cos_of_real)
  4728 
  4729 lemma cot_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cot z \<in> \<real>"
  4730   for z :: "'a::{real_normed_field,banach}"
  4731   by (simp add: cot_def)
  4732 
  4733 lemma cot_zero [simp]: "cot 0 = 0"
  4734   by (simp add: cot_def)
  4735 
  4736 lemma cot_pi [simp]: "cot pi = 0"
  4737   by (simp add: cot_def)
  4738 
  4739 lemma cot_npi [simp]: "cot (real n * pi) = 0"
  4740   for n :: nat
  4741   by (simp add: cot_def)
  4742 
  4743 lemma cot_minus [simp]: "cot (- x) = - cot x"
  4744   by (simp add: cot_def)
  4745 
  4746 lemma cot_periodic [simp]: "cot (x + 2 * pi) = cot x"
  4747   by (simp add: cot_def)
  4748 
  4749 lemma cot_altdef: "cot x = inverse (tan x)"
  4750   by (simp add: cot_def tan_def)
  4751 
  4752 lemma tan_altdef: "tan x = inverse (cot x)"
  4753   by (simp add: cot_def tan_def)
  4754 
  4755 lemma tan_cot': "tan (pi/2 - x) = cot x"
  4756   by (simp add: tan_cot cot_altdef)
  4757 
  4758 lemma cot_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cot x"
  4759   by (simp add: cot_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  4760 
  4761 lemma cot_less_zero:
  4762   assumes lb: "- pi/2 < x" and "x < 0"
  4763   shows "cot x < 0"
  4764 proof -
  4765   have "0 < cot (- x)"
  4766     using assms by (simp only: cot_gt_zero)
  4767   then show ?thesis by simp
  4768 qed
  4769 
  4770 lemma DERIV_cot [simp]: "sin x \<noteq> 0 \<Longrightarrow> DERIV cot x :> -inverse ((sin x)\<^sup>2)"
  4771   for x :: "'a::{real_normed_field,banach}"
  4772   unfolding cot_def using cos_squared_eq[of x]
  4773   by (auto intro!: derivative_eq_intros) (simp add: divide_inverse power2_eq_square)
  4774 
  4775 lemma isCont_cot: "sin x \<noteq> 0 \<Longrightarrow> isCont cot x"
  4776   for x :: "'a::{real_normed_field,banach}"
  4777   by (rule DERIV_cot [THEN DERIV_isCont])
  4778 
  4779 lemma isCont_cot' [simp,continuous_intros]:
  4780   "isCont f a \<Longrightarrow> sin (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. cot (f x)) a"
  4781   for a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  4782   by (rule isCont_o2 [OF _ isCont_cot])
  4783 
  4784 lemma tendsto_cot [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> sin a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. cot (f x)) \<longlongrightarrow> cot a) F"
  4785   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4786   by (rule isCont_tendsto_compose [OF isCont_cot])
  4787 
  4788 lemma continuous_cot:
  4789   "continuous F f \<Longrightarrow> sin (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. cot (f x))"
  4790   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4791   unfolding continuous_def by (rule tendsto_cot)
  4792 
  4793 lemma continuous_on_cot [continuous_intros]:
  4794   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4795   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. sin (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. cot (f x))"
  4796   unfolding continuous_on_def by (auto intro: tendsto_cot)
  4797 
  4798 lemma continuous_within_cot [continuous_intros]:
  4799   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4800   shows "continuous (at x within s) f \<Longrightarrow> sin (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. cot (f x))"
  4801   unfolding continuous_within by (rule tendsto_cot)
  4802 
  4803 
  4804 subsection \<open>Inverse Trigonometric Functions\<close>
  4805 
  4806 definition arcsin :: "real \<Rightarrow> real"
  4807   where "arcsin y = (THE x. -(pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y)"
  4808 
  4809 definition arccos :: "real \<Rightarrow> real"
  4810   where "arccos y = (THE x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y)"
  4811 
  4812 definition arctan :: "real \<Rightarrow> real"
  4813   where "arctan y = (THE x. -(pi/2) < x \<and> x < pi/2 \<and> tan x = y)"
  4814 
  4815 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"
  4816   unfolding arcsin_def by (rule theI' [OF sin_total])
  4817 
  4818 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"
  4819   by (drule (1) arcsin) (force intro: order_trans)
  4820 
  4821 lemma sin_arcsin [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin (arcsin y) = y"
  4822   by (blast dest: arcsin)
  4823 
  4824 lemma arcsin_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2"
  4825   by (blast dest: arcsin)
  4826 
  4827 lemma arcsin_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y"
  4828   by (blast dest: arcsin)
  4829 
  4830 lemma arcsin_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
  4831   by (blast dest: arcsin)
  4832 
  4833 lemma arcsin_lt_bounded: "- 1 < y \<Longrightarrow> y < 1 \<Longrightarrow> - (pi/2) < arcsin y \<and> arcsin y < pi/2"
  4834   apply (frule order_less_imp_le)
  4835   apply (frule_tac y = y in order_less_imp_le)
  4836   apply (frule arcsin_bounded)
  4837    apply safe
  4838     apply simp
  4839    apply (drule_tac y = "arcsin y" in order_le_imp_less_or_eq)
  4840    apply (drule_tac [2] y = "pi/2" in order_le_imp_less_or_eq)
  4841    apply safe
  4842    apply (drule_tac [!] f = sin in arg_cong)
  4843    apply auto
  4844   done
  4845 
  4846 lemma arcsin_sin: "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> arcsin (sin x) = x"
  4847   apply (unfold arcsin_def)
  4848   apply (rule the1_equality)
  4849    apply (rule sin_total)
  4850     apply auto
  4851   done
  4852 
  4853 lemma arcsin_0 [simp]: "arcsin 0 = 0"
  4854   using arcsin_sin [of 0] by simp
  4855 
  4856 lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
  4857   using arcsin_sin [of "pi/2"] by simp
  4858 
  4859 lemma arcsin_minus_1 [simp]: "arcsin (- 1) = - (pi/2)"
  4860   using arcsin_sin [of "- pi/2"] by simp
  4861 
  4862 lemma arcsin_minus: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin (- x) = - arcsin x"
  4863   by (metis (no_types, hide_lams) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)
  4864 
  4865 lemma arcsin_eq_iff: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x = arcsin y \<longleftrightarrow> x = y"
  4866   by (metis abs_le_iff arcsin minus_le_iff)
  4867 
  4868 lemma cos_arcsin_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> cos (arcsin x) \<noteq> 0"
  4869   using arcsin_lt_bounded cos_gt_zero_pi by force
  4870 
  4871 lemma arccos: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi \<and> cos (arccos y) = y"
  4872   unfolding arccos_def by (rule theI' [OF cos_total])
  4873 
  4874 lemma cos_arccos [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  4875   by (blast dest: arccos)
  4876 
  4877 lemma arccos_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi"
  4878   by (blast dest: arccos)
  4879 
  4880 lemma arccos_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y"
  4881   by (blast dest: arccos)
  4882 
  4883 lemma arccos_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> pi"
  4884   by (blast dest: arccos)
  4885 
  4886 lemma arccos_lt_bounded: "- 1 < y \<Longrightarrow> y < 1 \<Longrightarrow> 0 < arccos y \<and> arccos y < pi"
  4887   apply (frule order_less_imp_le)
  4888   apply (frule_tac y = y in order_less_imp_le)
  4889   apply (frule arccos_bounded)
  4890    apply auto
  4891    apply (drule_tac y = "arccos y" in order_le_imp_less_or_eq)
  4892    apply (drule_tac [2] y = pi in order_le_imp_less_or_eq)
  4893    apply auto
  4894    apply (drule_tac [!] f = cos in arg_cong)
  4895    apply auto
  4896   done
  4897 
  4898 lemma arccos_cos: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> arccos (cos x) = x"
  4899   by (auto simp: arccos_def intro!: the1_equality cos_total)
  4900 
  4901 lemma arccos_cos2: "x \<le> 0 \<Longrightarrow> - pi \<le> x \<Longrightarrow> arccos (cos x) = -x"
  4902   by (auto simp: arccos_def intro!: the1_equality cos_total)
  4903 
  4904 lemma cos_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> cos (arcsin x) = sqrt (1 - x\<^sup>2)"
  4905   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4906    apply (rule power2_eq_imp_eq)
  4907      apply (simp add: cos_squared_eq)
  4908     apply (rule cos_ge_zero)
  4909      apply (erule (1) arcsin_lbound)
  4910     apply (erule (1) arcsin_ubound)
  4911    apply simp
  4912   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2")
  4913    apply simp
  4914   apply (rule power_mono)
  4915    apply simp
  4916   apply simp
  4917   done
  4918 
  4919 lemma sin_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> sin (arccos x) = sqrt (1 - x\<^sup>2)"
  4920   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4921    apply (rule power2_eq_imp_eq)
  4922      apply (simp add: sin_squared_eq)
  4923     apply (rule sin_ge_zero)
  4924      apply (erule (1) arccos_lbound)
  4925     apply (erule (1) arccos_ubound)
  4926    apply simp
  4927   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2")
  4928    apply simp
  4929   apply (rule power_mono)
  4930    apply simp
  4931   apply simp
  4932   done
  4933 
  4934 lemma arccos_0 [simp]: "arccos 0 = pi/2"
  4935   by (metis arccos_cos cos_gt_zero cos_pi cos_pi_half pi_gt_zero
  4936       pi_half_ge_zero not_le not_zero_less_neg_numeral numeral_One)
  4937 
  4938 lemma arccos_1 [simp]: "arccos 1 = 0"
  4939   using arccos_cos by force
  4940 
  4941 lemma arccos_minus_1 [simp]: "arccos (- 1) = pi"
  4942   by (metis arccos_cos cos_pi order_refl pi_ge_zero)
  4943 
  4944 lemma arccos_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos (- x) = pi - arccos x"
  4945   by (metis arccos_cos arccos_cos2 cos_minus_pi cos_total diff_le_0_iff_le le_add_same_cancel1
  4946       minus_diff_eq uminus_add_conv_diff)
  4947 
  4948 corollary arccos_minus_abs:
  4949   assumes "\<bar>x\<bar> \<le> 1"
  4950   shows "arccos (- x) = pi - arccos x"
  4951 using assms by (simp add: arccos_minus)
  4952 
  4953 lemma sin_arccos_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> sin (arccos x) \<noteq> 0"
  4954   using arccos_lt_bounded sin_gt_zero by force
  4955 
  4956 lemma arctan: "- (pi/2) < arctan y \<and> arctan y < pi/2 \<and> tan (arctan y) = y"
  4957   unfolding arctan_def by (rule theI' [OF tan_total])
  4958 
  4959 lemma tan_arctan: "tan (arctan y) = y"
  4960   by (simp add: arctan)
  4961 
  4962 lemma arctan_bounded: "- (pi/2) < arctan y \<and> arctan y < pi/2"
  4963   by (auto simp only: arctan)
  4964 
  4965 lemma arctan_lbound: "- (pi/2) < arctan y"
  4966   by (simp add: arctan)
  4967 
  4968 lemma arctan_ubound: "arctan y < pi/2"
  4969   by (auto simp only: arctan)
  4970 
  4971 lemma arctan_unique:
  4972   assumes "-(pi/2) < x"
  4973     and "x < pi/2"
  4974     and "tan x = y"
  4975   shows "arctan y = x"
  4976   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
  4977 
  4978 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
  4979   by (rule arctan_unique) simp_all
  4980 
  4981 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
  4982   by (rule arctan_unique) simp_all
  4983 
  4984 lemma arctan_minus: "arctan (- x) = - arctan x"
  4985   using arctan [of "x"] by (auto simp: arctan_unique)
  4986 
  4987 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
  4988   by (intro less_imp_neq [symmetric] cos_gt_zero_pi arctan_lbound arctan_ubound)
  4989 
  4990 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
  4991 proof (rule power2_eq_imp_eq)
  4992   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
  4993   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
  4994   show "0 \<le> cos (arctan x)"
  4995     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
  4996   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
  4997     unfolding tan_def by (simp add: distrib_left power_divide)
  4998   then show "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
  4999     using \<open>0 < 1 + x\<^sup>2\<close> by (simp add: arctan power_divide eq_divide_eq)
  5000 qed
  5001 
  5002 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
  5003   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
  5004   using tan_arctan [of x] unfolding tan_def cos_arctan
  5005   by (simp add: eq_divide_eq)
  5006 
  5007 lemma tan_sec: "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
  5008   for x :: "'a::{real_normed_field,banach,field}"
  5009   apply (rule power_inverse [THEN subst])
  5010   apply (rule_tac c1 = "(cos x)\<^sup>2" in mult_right_cancel [THEN iffD1])
  5011    apply (auto simp add: tan_def field_simps)
  5012   done
  5013 
  5014 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
  5015   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
  5016 
  5017 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
  5018   by (simp only: not_less [symmetric] arctan_less_iff)
  5019 
  5020 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
  5021   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
  5022 
  5023 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
  5024   using arctan_less_iff [of 0 x] by simp
  5025 
  5026 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
  5027   using arctan_less_iff [of x 0] by simp
  5028 
  5029 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
  5030   using arctan_le_iff [of 0 x] by simp
  5031 
  5032 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
  5033   using arctan_le_iff [of x 0] by simp
  5034 
  5035 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
  5036   using arctan_eq_iff [of x 0] by simp
  5037 
  5038 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
  5039 proof -
  5040   have "continuous_on (sin ` {- pi / 2 .. pi / 2}) arcsin"
  5041     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
  5042   also have "sin ` {- pi / 2 .. pi / 2} = {-1 .. 1}"
  5043   proof safe
  5044     fix x :: real
  5045     assume "x \<in> {-1..1}"
  5046     then show "x \<in> sin ` {- pi / 2..pi / 2}"
  5047       using arcsin_lbound arcsin_ubound
  5048       by (intro image_eqI[where x="arcsin x"]) auto
  5049   qed simp
  5050   finally show ?thesis .
  5051 qed
  5052 
  5053 lemma continuous_on_arcsin [continuous_intros]:
  5054   "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))"
  5055   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
  5056   by (auto simp: comp_def subset_eq)
  5057 
  5058 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
  5059   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  5060   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  5061 
  5062 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
  5063 proof -
  5064   have "continuous_on (cos ` {0 .. pi}) arccos"
  5065     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
  5066   also have "cos ` {0 .. pi} = {-1 .. 1}"
  5067   proof safe
  5068     fix x :: real
  5069     assume "x \<in> {-1..1}"
  5070     then show "x \<in> cos ` {0..pi}"
  5071       using arccos_lbound arccos_ubound
  5072       by (intro image_eqI[where x="arccos x"]) auto
  5073   qed simp
  5074   finally show ?thesis .
  5075 qed
  5076 
  5077 lemma continuous_on_arccos [continuous_intros]:
  5078   "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))"
  5079   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
  5080   by (auto simp: comp_def subset_eq)
  5081 
  5082 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
  5083   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  5084   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  5085 
  5086 lemma isCont_arctan: "isCont arctan x"
  5087   apply (rule arctan_lbound [of x, THEN dense, THEN exE])
  5088   apply clarify
  5089   apply (rule arctan_ubound [of x, THEN dense, THEN exE])
  5090   apply clarify
  5091   apply (subgoal_tac "isCont arctan (tan (arctan x))")
  5092    apply (simp add: arctan)
  5093   apply (erule (1) isCont_inverse_function2 [where f=tan])
  5094    apply (metis arctan_tan order_le_less_trans order_less_le_trans)
  5095   apply (metis cos_gt_zero_pi isCont_tan order_less_le_trans less_le)
  5096   done
  5097 
  5098 lemma tendsto_arctan [tendsto_intros]: "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) \<longlongrightarrow> arctan x) F"
  5099   by (rule isCont_tendsto_compose [OF isCont_arctan])
  5100 
  5101 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
  5102   unfolding continuous_def by (rule tendsto_arctan)
  5103 
  5104 lemma continuous_on_arctan [continuous_intros]:
  5105   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
  5106   unfolding continuous_on_def by (auto intro: tendsto_arctan)
  5107 
  5108 lemma DERIV_arcsin: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
  5109   apply (rule DERIV_inverse_function [where f=sin and a="-1" and b=1])
  5110        apply (rule DERIV_cong [OF DERIV_sin])
  5111        apply (simp add: cos_arcsin)
  5112       apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2")
  5113        apply simp
  5114       apply (rule power_strict_mono)
  5115         apply simp
  5116        apply simp
  5117       apply simp
  5118      apply assumption
  5119     apply assumption
  5120    apply simp
  5121   apply (erule (1) isCont_arcsin)
  5122   done
  5123 
  5124 lemma DERIV_arccos: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
  5125   apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
  5126        apply (rule DERIV_cong [OF DERIV_cos])
  5127        apply (simp add: sin_arccos)
  5128       apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2")
  5129        apply simp
  5130       apply (rule power_strict_mono)
  5131         apply simp
  5132        apply simp
  5133       apply simp
  5134      apply assumption
  5135     apply assumption
  5136    apply simp
  5137   apply (erule (1) isCont_arccos)
  5138   done
  5139 
  5140 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
  5141   apply (rule DERIV_inverse_function [where f=tan and a="x - 1" and b="x + 1"])
  5142        apply (rule DERIV_cong [OF DERIV_tan])
  5143         apply (rule cos_arctan_not_zero)
  5144        apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  5145    apply (simp add: arctan power_inverse [symmetric] tan_sec [symmetric])
  5146   apply (subgoal_tac "0 < 1 + x\<^sup>2")
  5147    apply simp
  5148   apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  5149   done
  5150 
  5151 declare
  5152   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
  5153   DERIV_arcsin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5154   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
  5155   DERIV_arccos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5156   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
  5157   DERIV_arctan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5158 
  5159 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- (pi/2)))"
  5160   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])
  5161      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  5162            intro!: tan_monotone exI[of _ "pi/2"])
  5163 
  5164 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
  5165   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])
  5166      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  5167            intro!: tan_monotone exI[of _ "pi/2"])
  5168 
  5169 lemma tendsto_arctan_at_top: "(arctan \<longlongrightarrow> (pi/2)) at_top"
  5170 proof (rule tendstoI)
  5171   fix e :: real
  5172   assume "0 < e"
  5173   define y where "y = pi/2 - min (pi/2) e"
  5174   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
  5175     using \<open>0 < e\<close> by auto
  5176   show "eventually (\<lambda>x. dist (arctan x) (pi / 2) < e) at_top"
  5177   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
  5178     fix x
  5179     assume "tan y < x"
  5180     then have "arctan (tan y) < arctan x"
  5181       by (simp add: arctan_less_iff)
  5182     with y have "y < arctan x"
  5183       by (subst (asm) arctan_tan) simp_all
  5184     with arctan_ubound[of x, arith] y \<open>0 < e\<close>
  5185     show "dist (arctan x) (pi / 2) < e"
  5186       by (simp add: dist_real_def)
  5187   qed
  5188 qed
  5189 
  5190 lemma tendsto_arctan_at_bot: "(arctan \<longlongrightarrow> - (pi/2)) at_bot"
  5191   unfolding filterlim_at_bot_mirror arctan_minus
  5192   by (intro tendsto_minus tendsto_arctan_at_top)
  5193 
  5194 
  5195 subsection \<open>Prove Totality of the Trigonometric Functions\<close>
  5196 
  5197 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  5198   by (simp add: abs_le_iff)
  5199 
  5200 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
  5201   by (simp add: sin_arccos abs_le_iff)
  5202 
  5203 lemma sin_mono_less_eq:
  5204   "- (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"
  5205   by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
  5206 
  5207 lemma sin_mono_le_eq:
  5208   "- (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"
  5209   by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
  5210 
  5211 lemma sin_inj_pi:
  5212   "- (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"
  5213   by (metis arcsin_sin)
  5214 
  5215 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"
  5216   by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
  5217 
  5218 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"
  5219   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
  5220 
  5221 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"
  5222   by (metis arccos_cos)
  5223 
  5224 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
  5225   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
  5226       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
  5227 
  5228 lemma sincos_total_pi_half:
  5229   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  5230   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
  5231 proof -
  5232   have x1: "x \<le> 1"
  5233     using assms by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2)
  5234   with assms have *: "0 \<le> arccos x" "cos (arccos x) = x"
  5235     by (auto simp: arccos)
  5236   from assms have "y = sqrt (1 - x\<^sup>2)"
  5237     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
  5238   with x1 * assms arccos_le_pi2 [of x] show ?thesis
  5239     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
  5240 qed
  5241 
  5242 lemma sincos_total_pi:
  5243   assumes "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  5244   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
  5245 proof (cases rule: le_cases [of 0 x])
  5246   case le
  5247   from sincos_total_pi_half [OF le] show ?thesis
  5248     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
  5249 next
  5250   case ge
  5251   then have "0 \<le> -x"
  5252     by simp
  5253   then obtain t where t: "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
  5254     using sincos_total_pi_half assms
  5255     by auto (metis \<open>0 \<le> - x\<close> power2_minus)
  5256   show ?thesis
  5257     by (rule exI [where x = "pi -t"]) (use t in auto)
  5258 qed
  5259 
  5260 lemma sincos_total_2pi_le:
  5261   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  5262   shows "\<exists>t. 0 \<le> t \<and> t \<le> 2 * pi \<and> x = cos t \<and> y = sin t"
  5263 proof (cases rule: le_cases [of 0 y])
  5264   case le
  5265   from sincos_total_pi [OF le] show ?thesis
  5266     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
  5267 next
  5268   case ge
  5269   then have "0 \<le> -y"
  5270     by simp
  5271   then obtain t where t: "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
  5272     using sincos_total_pi assms
  5273     by auto (metis \<open>0 \<le> - y\<close> power2_minus)
  5274   show ?thesis
  5275     by (rule exI [where x = "2 * pi - t"]) (use t in auto)
  5276 qed
  5277 
  5278 lemma sincos_total_2pi:
  5279   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  5280   obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
  5281 proof -
  5282   from sincos_total_2pi_le [OF assms]
  5283   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
  5284     by blast
  5285   show ?thesis
  5286     by (cases "t = 2 * pi") (use t that in \<open>force+\<close>)
  5287 qed
  5288 
  5289 lemma arcsin_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x < arcsin y \<longleftrightarrow> x < y"
  5290   by (rule trans [OF sin_mono_less_eq [symmetric]]) (use arcsin_ubound arcsin_lbound in auto)
  5291 
  5292 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"
  5293   using arcsin_less_mono not_le by blast
  5294 
  5295 lemma arcsin_less_arcsin: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x < arcsin y"
  5296   using arcsin_less_mono by auto
  5297 
  5298 lemma arcsin_le_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y"
  5299   using arcsin_le_mono by auto
  5300 
  5301 lemma arccos_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x < arccos y \<longleftrightarrow> y < x"
  5302   by (rule trans [OF cos_mono_less_eq [symmetric]]) (use arccos_ubound arccos_lbound in auto)
  5303 
  5304 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"
  5305   using arccos_less_mono [of y x] by (simp add: not_le [symmetric])
  5306 
  5307 lemma arccos_less_arccos: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y < arccos x"
  5308   using arccos_less_mono by auto
  5309 
  5310 lemma arccos_le_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> arccos x"
  5311   using arccos_le_mono by auto
  5312 
  5313 lemma arccos_eq_iff: "\<bar>x\<bar> \<le> 1 \<and> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x = arccos y \<longleftrightarrow> x = y"
  5314   using cos_arccos_abs by fastforce
  5315 
  5316 
  5317 subsection \<open>Machin's formula\<close>
  5318 
  5319 lemma arctan_one: "arctan 1 = pi / 4"
  5320   by (rule arctan_unique) (simp_all add: tan_45 m2pi_less_pi)
  5321 
  5322 lemma tan_total_pi4:
  5323   assumes "\<bar>x\<bar> < 1"
  5324   shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
  5325 proof
  5326   show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
  5327     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  5328     unfolding arctan_less_iff
  5329     using assms by (auto simp add: arctan)
  5330 qed
  5331 
  5332 lemma arctan_add:
  5333   assumes "\<bar>x\<bar> \<le> 1" "\<bar>y\<bar> < 1"
  5334   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
  5335 proof (rule arctan_unique [symmetric])
  5336   have "- (pi / 4) \<le> arctan x" "- (pi / 4) < arctan y"
  5337     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  5338     unfolding arctan_le_iff arctan_less_iff
  5339     using assms by auto
  5340   from add_le_less_mono [OF this] show 1: "- (pi / 2) < arctan x + arctan y"
  5341     by simp
  5342   have "arctan x \<le> pi / 4" "arctan y < pi / 4"
  5343     unfolding arctan_one [symmetric]
  5344     unfolding arctan_le_iff arctan_less_iff
  5345     using assms by auto
  5346   from add_le_less_mono [OF this] show 2: "arctan x + arctan y < pi / 2"
  5347     by simp
  5348   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
  5349     using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
  5350 qed
  5351 
  5352 lemma arctan_double: "\<bar>x\<bar> < 1 \<Longrightarrow> 2 * arctan x = arctan ((2 * x) / (1 - x\<^sup>2))"
  5353   by (metis arctan_add linear mult_2 not_less power2_eq_square)
  5354 
  5355 theorem machin: "pi / 4 = 4 * arctan (1 / 5) - arctan (1 / 239)"
  5356 proof -
  5357   have "\<bar>1 / 5\<bar> < (1 :: real)"
  5358     by auto
  5359   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (1 / 5) = arctan (5 / 12)"
  5360     by auto
  5361   moreover
  5362   have "\<bar>5 / 12\<bar> < (1 :: real)"
  5363     by auto
  5364   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (5 / 12) = arctan (120 / 119)"
  5365     by auto
  5366   moreover
  5367   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)"
  5368     by auto
  5369   from arctan_add[OF this] have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)"
  5370     by auto
  5371   ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)"
  5372     by auto
  5373   then show ?thesis
  5374     unfolding arctan_one by algebra
  5375 qed
  5376 
  5377 lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi / 4"
  5378 proof -
  5379   have 17: "\<bar>1 / 7\<bar> < (1 :: real)" by auto
  5380   with arctan_double have "2 * arctan (1 / 7) = arctan (7 / 24)"
  5381     by simp (simp add: field_simps)
  5382   moreover
  5383   have "\<bar>7 / 24\<bar> < (1 :: real)" by auto
  5384   with arctan_double have "2 * arctan (7 / 24) = arctan (336 / 527)"
  5385     by simp (simp add: field_simps)
  5386   moreover
  5387   have "\<bar>336 / 527\<bar> < (1 :: real)" by auto
  5388   from arctan_add[OF less_imp_le[OF 17] this]
  5389   have "arctan(1/7) + arctan (336 / 527) = arctan (2879 / 3353)"
  5390     by auto
  5391   ultimately have I: "5 * arctan (1 / 7) = arctan (2879 / 3353)" by auto
  5392   have 379: "\<bar>3 / 79\<bar> < (1 :: real)" by auto
  5393   with arctan_double have II: "2 * arctan (3 / 79) = arctan (237 / 3116)"
  5394     by simp (simp add: field_simps)
  5395   have *: "\<bar>2879 / 3353\<bar> < (1 :: real)" by auto
  5396   have "\<bar>237 / 3116\<bar> < (1 :: real)" by auto
  5397   from arctan_add[OF less_imp_le[OF *] this] have "arctan (2879/3353) + arctan (237/3116) = pi/4"
  5398     by (simp add: arctan_one)
  5399   with I II show ?thesis by auto
  5400 qed
  5401 
  5402 (*But could also prove MACHIN_GAUSS:
  5403   12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)
  5404 
  5405 
  5406 subsection \<open>Introducing the inverse tangent power series\<close>
  5407 
  5408 lemma monoseq_arctan_series:
  5409   fixes x :: real
  5410   assumes "\<bar>x\<bar> \<le> 1"
  5411   shows "monoseq (\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1))"
  5412     (is "monoseq ?a")
  5413 proof (cases "x = 0")
  5414   case True
  5415   then show ?thesis by (auto simp: monoseq_def)
  5416 next
  5417   case False
  5418   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
  5419     using assms by auto
  5420   show "monoseq ?a"
  5421   proof -
  5422     have mono: "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
  5423         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
  5424       if "0 \<le> x" and "x \<le> 1" for n and x :: real
  5425     proof (rule mult_mono)
  5426       show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
  5427         by (rule frac_le) simp_all
  5428       show "0 \<le> 1 / real (Suc (n * 2))"
  5429         by auto
  5430       show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
  5431         by (rule power_decreasing) (simp_all add: \<open>0 \<le> x\<close> \<open>x \<le> 1\<close>)
  5432       show "0 \<le> x ^ Suc (Suc n * 2)"
  5433         by (rule zero_le_power) (simp add: \<open>0 \<le> x\<close>)
  5434     qed
  5435     show ?thesis
  5436     proof (cases "0 \<le> x")
  5437       case True
  5438       from mono[OF this \<open>x \<le> 1\<close>, THEN allI]
  5439       show ?thesis
  5440         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI2)
  5441     next
  5442       case False
  5443       then have "0 \<le> - x" and "- x \<le> 1"
  5444         using \<open>-1 \<le> x\<close> by auto
  5445       from mono[OF this]
  5446       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
  5447           1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" for n
  5448         using \<open>0 \<le> -x\<close> by auto
  5449       then show ?thesis
  5450         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
  5451     qed
  5452   qed
  5453 qed
  5454 
  5455 lemma zeroseq_arctan_series:
  5456   fixes x :: real
  5457   assumes "\<bar>x\<bar> \<le> 1"
  5458   shows "(\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1)) \<longlonglongrightarrow> 0"
  5459     (is "?a \<longlonglongrightarrow> 0")
  5460 proof (cases "x = 0")
  5461   case True
  5462   then show ?thesis by simp
  5463 next
  5464   case False
  5465   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
  5466     using assms by auto
  5467   show "?a \<longlonglongrightarrow> 0"
  5468   proof (cases "\<bar>x\<bar> < 1")
  5469     case True
  5470     then have "norm x < 1" by auto
  5471     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF \<open>norm x < 1\<close>, THEN LIMSEQ_Suc]]
  5472     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) \<longlonglongrightarrow> 0"
  5473       unfolding inverse_eq_divide Suc_eq_plus1 by simp
  5474     then show ?thesis
  5475       using pos2 by (rule LIMSEQ_linear)
  5476   next
  5477     case False
  5478     then have "x = -1 \<or> x = 1"
  5479       using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5480     then have n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
  5481       unfolding One_nat_def by auto
  5482     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
  5483     show ?thesis
  5484       unfolding n_eq Suc_eq_plus1 by auto
  5485   qed
  5486 qed
  5487 
  5488 lemma summable_arctan_series:
  5489   fixes n :: nat
  5490   assumes "\<bar>x\<bar> \<le> 1"
  5491   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  5492     (is "summable (?c x)")
  5493   by (rule summable_Leibniz(1),
  5494       rule zeroseq_arctan_series[OF assms],
  5495       rule monoseq_arctan_series[OF assms])
  5496 
  5497 lemma DERIV_arctan_series:
  5498   assumes "\<bar>x\<bar> < 1"
  5499   shows "DERIV (\<lambda>x'. \<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x' ^ (k * 2 + 1))) x :>
  5500       (\<Sum>k. (-1)^k * x^(k * 2))"
  5501     (is "DERIV ?arctan _ :> ?Int")
  5502 proof -
  5503   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
  5504 
  5505   have n_even: "even n \<Longrightarrow> 2 * (n div 2) = n" for n :: nat
  5506     by presburger
  5507   then have if_eq: "?f n * real (Suc n) * x'^n =
  5508       (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
  5509     for n x'
  5510     by auto
  5511 
  5512   have summable_Integral: "summable (\<lambda> n. (- 1) ^ n * x^(2 * n))" if "\<bar>x\<bar> < 1" for x :: real
  5513   proof -
  5514     from that have "x\<^sup>2 < 1"
  5515       by (simp add: abs_square_less_1)
  5516     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
  5517       by (rule summable_Leibniz(1))
  5518         (auto intro!: LIMSEQ_realpow_zero monoseq_realpow \<open>x\<^sup>2 < 1\<close> order_less_imp_le[OF \<open>x\<^sup>2 < 1\<close>])
  5519     then show ?thesis
  5520       by (simp only: power_mult)
  5521   qed
  5522 
  5523   have sums_even: "op sums f = op sums (\<lambda> n. if even n then f (n div 2) else 0)"
  5524     for f :: "nat \<Rightarrow> real"
  5525   proof -
  5526     have "f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x" for x :: real
  5527     proof
  5528       assume "f sums x"
  5529       from sums_if[OF sums_zero this] show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
  5530         by auto
  5531     next
  5532       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
  5533       from LIMSEQ_linear[OF this[simplified sums_def] pos2, simplified sum_split_even_odd[simplified mult.commute]]
  5534       show "f sums x"
  5535         unfolding sums_def by auto
  5536     qed
  5537     then show ?thesis ..
  5538   qed
  5539 
  5540   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
  5541     unfolding if_eq mult.commute[of _ 2]
  5542       suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
  5543     by auto
  5544 
  5545   have arctan_eq: "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x" for x
  5546   proof -
  5547     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
  5548       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
  5549       using n_even by auto
  5550     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)"
  5551       by auto
  5552     then show ?thesis
  5553       unfolding if_eq' idx_eq suminf_def
  5554         sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
  5555       by auto
  5556   qed
  5557 
  5558   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum>n. ?f n * real (Suc n) * x^n)"
  5559   proof (rule DERIV_power_series')
  5560     show "x \<in> {- 1 <..< 1}"
  5561       using \<open>\<bar> x \<bar> < 1\<close> by auto
  5562     show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)"
  5563       if x'_bounds: "x' \<in> {- 1 <..< 1}" for x' :: real
  5564     proof -
  5565       from that have "\<bar>x'\<bar> < 1" by auto
  5566       then have *: "summable (\<lambda>n. (- 1) ^ n * x' ^ (2 * n))"
  5567         by (rule summable_Integral)
  5568       show ?thesis
  5569         unfolding if_eq
  5570         apply (rule sums_summable [where l="0 + (\<Sum>n. (-1)^n * x'^(2 * n))"])
  5571         apply (rule sums_if)
  5572          apply (rule sums_zero)
  5573         apply (rule summable_sums)
  5574         apply (rule *)
  5575         done
  5576     qed
  5577   qed auto
  5578   then show ?thesis
  5579     by (simp only: Int_eq arctan_eq)
  5580 qed
  5581 
  5582 lemma arctan_series:
  5583   assumes "\<bar>x\<bar> \<le> 1"
  5584   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x ^ (k * 2 + 1)))"
  5585     (is "_ = suminf (\<lambda> n. ?c x n)")
  5586 proof -
  5587   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
  5588 
  5589   have DERIV_arctan_suminf: "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))"
  5590     if "0 < r" and "r < 1" and "\<bar>x\<bar> < r" for r x :: real
  5591   proof (rule DERIV_arctan_series)
  5592     from that show "\<bar>x\<bar> < 1"
  5593       using \<open>r < 1\<close> and \<open>\<bar>x\<bar> < r\<close> by auto
  5594   qed
  5595 
  5596   {
  5597     fix x :: real
  5598     assume "\<bar>x\<bar> \<le> 1"
  5599     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
  5600   } note arctan_series_borders = this
  5601 
  5602   have when_less_one: "arctan x = (\<Sum>k. ?c x k)" if "\<bar>x\<bar> < 1" for x :: real
  5603   proof -
  5604     obtain r where "\<bar>x\<bar> < r" and "r < 1"
  5605       using dense[OF \<open>\<bar>x\<bar> < 1\<close>] by blast
  5606     then have "0 < r" and "- r < x" and "x < r" by auto
  5607 
  5608     have suminf_eq_arctan_bounded: "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  5609       if "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b" for x a b
  5610     proof -
  5611       from that have "\<bar>x\<bar> < r" by auto
  5612       show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  5613       proof (rule DERIV_isconst2[of "a" "b"])
  5614         show "a < b" and "a \<le> x" and "x \<le> b"
  5615           using \<open>a < b\<close> \<open>a \<le> x\<close> \<open>x \<le> b\<close> by auto
  5616         have "\<forall>x. - r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  5617         proof (rule allI, rule impI)
  5618           fix x
  5619           assume "-r < x \<and> x < r"
  5620           then have "\<bar>x\<bar> < r" by auto
  5621           with \<open>r < 1\<close> have "\<bar>x\<bar> < 1" by auto
  5622           have "\<bar>- (x\<^sup>2)\<bar> < 1" using abs_square_less_1 \<open>\<bar>x\<bar> < 1\<close> by auto
  5623           then have "(\<lambda>n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
  5624             unfolding real_norm_def[symmetric] by (rule geometric_sums)
  5625           then have "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
  5626             unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
  5627           then have suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
  5628             using sums_unique unfolding inverse_eq_divide by auto
  5629           have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
  5630             unfolding suminf_c'_eq_geom
  5631             by (rule DERIV_arctan_suminf[OF \<open>0 < r\<close> \<open>r < 1\<close> \<open>\<bar>x\<bar> < r\<close>])
  5632           from DERIV_diff [OF this DERIV_arctan] show "DERIV (\<lambda>x. suminf (?c x) - arctan x) x :> 0"
  5633             by auto
  5634         qed
  5635         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"
  5636           using \<open>-r < a\<close> \<open>b < r\<close> by auto
  5637         then show "\<forall>y. a < y \<and> y < b \<longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
  5638           using \<open>\<bar>x\<bar> < r\<close> by auto
  5639         show "\<forall>y. a \<le> y \<and> y \<le> b \<longrightarrow> isCont (\<lambda>x. suminf (?c x) - arctan x) y"
  5640           using DERIV_in_rball DERIV_isCont by auto
  5641       qed
  5642     qed
  5643 
  5644     have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
  5645       unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
  5646       by auto
  5647 
  5648     have "suminf (?c x) - arctan x = 0"
  5649     proof (cases "x = 0")
  5650       case True
  5651       then show ?thesis
  5652         using suminf_arctan_zero by auto
  5653     next
  5654       case False
  5655       then have "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>"
  5656         by auto
  5657       have "suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>) = suminf (?c 0) - arctan 0"
  5658         by (rule suminf_eq_arctan_bounded[where x1="0" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
  5659           (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5660       moreover
  5661       have "suminf (?c x) - arctan x = suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>)"
  5662         by (rule suminf_eq_arctan_bounded[where x1="x" and a1="- \<bar>x\<bar>" and b1="\<bar>x\<bar>"])
  5663            (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>- \<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5664       ultimately show ?thesis
  5665         using suminf_arctan_zero by auto
  5666     qed
  5667     then show ?thesis by auto
  5668   qed
  5669 
  5670   show "arctan x = suminf (\<lambda>n. ?c x n)"
  5671   proof (cases "\<bar>x\<bar> < 1")
  5672     case True
  5673     then show ?thesis by (rule when_less_one)
  5674   next
  5675     case False
  5676     then have "\<bar>x\<bar> = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5677     let ?a = "\<lambda>x n. \<bar>1 / real (n * 2 + 1) * x^(n * 2 + 1)\<bar>"
  5678     let ?diff = "\<lambda>x n. \<bar>arctan x - (\<Sum>i<n. ?c x i)\<bar>"
  5679     have "?diff 1 n \<le> ?a 1 n" for n :: nat
  5680     proof -
  5681       have "0 < (1 :: real)" by auto
  5682       moreover
  5683       have "?diff x n \<le> ?a x n" if "0 < x" and "x < 1" for x :: real
  5684       proof -
  5685         from that have "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1"
  5686           by auto
  5687         from \<open>0 < x\<close> have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
  5688           by auto
  5689         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]
  5690         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
  5691           by (rule mult_pos_pos) (simp_all only: zero_less_power[OF \<open>0 < x\<close>], auto)
  5692         then have a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
  5693           by (rule abs_of_pos)
  5694         show ?thesis
  5695         proof (cases "even n")
  5696           case True
  5697           then have sgn_pos: "(-1)^n = (1::real)" by auto
  5698           from \<open>even n\<close> obtain m where "n = 2 * m" ..
  5699           then have "2 * m = n" ..
  5700           from bounds[of m, unfolded this atLeastAtMost_iff]
  5701           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))"
  5702             by auto
  5703           also have "\<dots> = ?c x n" by auto
  5704           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
  5705           finally show ?thesis .
  5706         next
  5707           case False
  5708           then have sgn_neg: "(-1)^n = (-1::real)" by auto
  5709           from \<open>odd n\<close> obtain m where "n = 2 * m + 1" ..
  5710           then have m_def: "2 * m + 1 = n" ..
  5711           then have m_plus: "2 * (m + 1) = n + 1" by auto
  5712           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
  5713           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
  5714           also have "\<dots> = - ?c x n" by auto
  5715           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
  5716           finally show ?thesis .
  5717         qed
  5718       qed
  5719       hence "\<forall>x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
  5720       moreover have "isCont (\<lambda> x. ?a x n - ?diff x n) x" for x
  5721         unfolding diff_conv_add_uminus divide_inverse
  5722         by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
  5723           isCont_inverse isCont_mult isCont_power continuous_const isCont_sum
  5724           simp del: add_uminus_conv_diff)
  5725       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
  5726         by (rule LIM_less_bound)
  5727       then show ?thesis by auto
  5728     qed
  5729     have "?a 1 \<longlonglongrightarrow> 0"
  5730       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
  5731       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat simp del: of_nat_Suc)
  5732     have "?diff 1 \<longlonglongrightarrow> 0"
  5733     proof (rule LIMSEQ_I)
  5734       fix r :: real
  5735       assume "0 < r"
  5736       obtain N :: nat where N_I: "N \<le> n \<Longrightarrow> ?a 1 n < r" for n
  5737         using LIMSEQ_D[OF \<open>?a 1 \<longlonglongrightarrow> 0\<close> \<open>0 < r\<close>] by auto
  5738       have "norm (?diff 1 n - 0) < r" if "N \<le> n" for n
  5739         using \<open>?diff 1 n \<le> ?a 1 n\<close> N_I[OF that] by auto
  5740       then show "\<exists>N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
  5741     qed
  5742     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
  5743     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
  5744     then have "arctan 1 = (\<Sum>i. ?c 1 i)" by (rule sums_unique)
  5745 
  5746     show ?thesis
  5747     proof (cases "x = 1")
  5748       case True
  5749       then show ?thesis by (simp add: \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close>)
  5750     next
  5751       case False
  5752       then have "x = -1" using \<open>\<bar>x\<bar> = 1\<close> by auto
  5753 
  5754       have "- (pi / 2) < 0" using pi_gt_zero by auto
  5755       have "- (2 * pi) < 0" using pi_gt_zero by auto
  5756 
  5757       have c_minus_minus: "?c (- 1) i = - ?c 1 i" for i by auto
  5758 
  5759       have "arctan (- 1) = arctan (tan (-(pi / 4)))"
  5760         unfolding tan_45 tan_minus ..
  5761       also have "\<dots> = - (pi / 4)"
  5762         by (rule arctan_tan) (auto simp: order_less_trans[OF \<open>- (pi / 2) < 0\<close> pi_gt_zero])
  5763       also have "\<dots> = - (arctan (tan (pi / 4)))"
  5764         unfolding neg_equal_iff_equal
  5765         by (rule arctan_tan[symmetric]) (auto simp: order_less_trans[OF \<open>- (2 * pi) < 0\<close> pi_gt_zero])
  5766       also have "\<dots> = - (arctan 1)"
  5767         unfolding tan_45 ..
  5768       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
  5769         using \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close> by auto
  5770       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
  5771         using suminf_minus[OF sums_summable[OF \<open>(?c 1) sums (arctan 1)\<close>]]
  5772         unfolding c_minus_minus by auto
  5773       finally show ?thesis using \<open>x = -1\<close> by auto
  5774     qed
  5775   qed
  5776 qed
  5777 
  5778 lemma arctan_half: "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
  5779   for x :: real
  5780 proof -
  5781   obtain y where low: "- (pi / 2) < y" and high: "y < pi / 2" and y_eq: "tan y = x"
  5782     using tan_total by blast
  5783   then have low2: "- (pi / 2) < y / 2" and high2: "y / 2 < pi / 2"
  5784     by auto
  5785 
  5786   have "0 < cos y" by (rule cos_gt_zero_pi[OF low high])
  5787   then have "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
  5788     by auto
  5789 
  5790   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5791     unfolding tan_def power_divide ..
  5792   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5793     using \<open>cos y \<noteq> 0\<close> by auto
  5794   also have "\<dots> = 1 / (cos y)\<^sup>2"
  5795     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
  5796   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
  5797 
  5798   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
  5799     unfolding tan_def using \<open>cos y \<noteq> 0\<close> by (simp add: field_simps)
  5800   also have "\<dots> = tan y / (1 + 1 / cos y)"
  5801     using \<open>cos y \<noteq> 0\<close> unfolding add_divide_distrib by auto
  5802   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
  5803     unfolding cos_sqrt ..
  5804   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
  5805     unfolding real_sqrt_divide by auto
  5806   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
  5807     unfolding \<open>1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2\<close> .
  5808 
  5809   have "arctan x = y"
  5810     using arctan_tan low high y_eq by auto
  5811   also have "\<dots> = 2 * (arctan (tan (y/2)))"
  5812     using arctan_tan[OF low2 high2] by auto
  5813   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
  5814     unfolding tan_half by auto
  5815   finally show ?thesis
  5816     unfolding eq \<open>tan y = x\<close> .
  5817 qed
  5818 
  5819 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
  5820   by (simp only: arctan_less_iff)
  5821 
  5822 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
  5823   by (simp only: arctan_le_iff)
  5824 
  5825 lemma arctan_inverse:
  5826   assumes "x \<noteq> 0"
  5827   shows "arctan (1 / x) = sgn x * pi / 2 - arctan x"
  5828 proof (rule arctan_unique)
  5829   show "- (pi / 2) < sgn x * pi / 2 - arctan x"
  5830     using arctan_bounded [of x] assms
  5831     unfolding sgn_real_def
  5832     apply (auto simp add: arctan algebra_simps)
  5833     apply (drule zero_less_arctan_iff [THEN iffD2])
  5834     apply arith
  5835     done
  5836   show "sgn x * pi / 2 - arctan x < pi / 2"
  5837     using arctan_bounded [of "- x"] assms
  5838     unfolding sgn_real_def arctan_minus
  5839     by (auto simp add: algebra_simps)
  5840   show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
  5841     unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
  5842     unfolding sgn_real_def
  5843     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
  5844 qed
  5845 
  5846 theorem pi_series: "pi / 4 = (\<Sum>k. (-1)^k * 1 / real (k * 2 + 1))"
  5847   (is "_ = ?SUM")
  5848 proof -
  5849   have "pi / 4 = arctan 1"
  5850     using arctan_one by auto
  5851   also have "\<dots> = ?SUM"
  5852     using arctan_series[of 1] by auto
  5853   finally show ?thesis by auto
  5854 qed
  5855 
  5856 
  5857 subsection \<open>Existence of Polar Coordinates\<close>
  5858 
  5859 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
  5860   by (rule power2_le_imp_le [OF _ zero_le_one])
  5861     (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
  5862 
  5863 lemmas cos_arccos_lemma1 = cos_arccos_abs [OF cos_x_y_le_one]
  5864 
  5865 lemmas sin_arccos_lemma1 = sin_arccos_abs [OF cos_x_y_le_one]
  5866 
  5867 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a \<and> y = r * sin a"
  5868 proof -
  5869   have polar_ex1: "0 < y \<Longrightarrow> \<exists>r a. x = r * cos a \<and> y = r * sin a" for y
  5870     apply (rule exI [where x = "sqrt (x\<^sup>2 + y\<^sup>2)"])
  5871     apply (rule exI [where x = "arccos (x / sqrt (x\<^sup>2 + y\<^sup>2))"])
  5872     apply (simp add: cos_arccos_lemma1 sin_arccos_lemma1 power_divide
  5873         real_sqrt_mult [symmetric] right_diff_distrib)
  5874     done
  5875   show ?thesis
  5876   proof (cases "0::real" y rule: linorder_cases)
  5877     case less
  5878     then show ?thesis
  5879       by (rule polar_ex1)
  5880   next
  5881     case equal
  5882     then show ?thesis
  5883       by (force simp add: intro!: cos_zero sin_zero)
  5884   next
  5885     case greater
  5886     with polar_ex1 [where y="-y"] show ?thesis
  5887       by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
  5888   qed
  5889 qed
  5890 
  5891 
  5892 subsection \<open>Basics about polynomial functions: products, extremal behaviour and root counts\<close>
  5893 
  5894 lemma pairs_le_eq_Sigma: "{(i, j). i + j \<le> m} = Sigma (atMost m) (\<lambda>r. atMost (m - r))"
  5895   for m :: nat
  5896   by auto
  5897 
  5898 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)"
  5899   by (metis atLeast0AtMost Suc_eq_plus1 le0 sum_ub_add_nat)
  5900 
  5901 lemma Sigma_interval_disjoint: "(SIGMA i:A. {..v i}) \<inter> (SIGMA i:A.{v i<..w}) = {}"
  5902   for w :: "'a::order"
  5903   by auto
  5904 
  5905 lemma product_atMost_eq_Un: "A \<times> {..m} = (SIGMA i:A.{..m - i}) \<union> (SIGMA i:A.{m - i<..m})"
  5906   for m :: nat
  5907   by auto
  5908 
  5909 lemma polynomial_product: (*with thanks to Chaitanya Mangla*)
  5910   fixes x :: "'a::idom"
  5911   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
  5912     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
  5913   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
  5914     (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5915 proof -
  5916   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))"
  5917     by (rule sum_product)
  5918   also have "\<dots> = (\<Sum>i\<le>m + n. \<Sum>j\<le>n + m. a i * x ^ i * (b j * x ^ j))"
  5919     using assms by (auto simp: sum_up_index_split)
  5920   also have "\<dots> = (\<Sum>r\<le>m + n. \<Sum>j\<le>m + n - r. a r * x ^ r * (b j * x ^ j))"
  5921     apply (simp add: add_ac sum.Sigma product_atMost_eq_Un)
  5922     apply (clarsimp simp add: sum_Un Sigma_interval_disjoint intro!: sum.neutral)
  5923     apply (metis add_diff_assoc2 add.commute add_lessD1 leD m n nat_le_linear neqE)
  5924     done
  5925   also have "\<dots> = (\<Sum>(i,j)\<in>{(i,j). i+j \<le> m+n}. (a i * x ^ i) * (b j * x ^ j))"
  5926     by (auto simp: pairs_le_eq_Sigma sum.Sigma)
  5927   also have "\<dots> = (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5928     apply (subst sum_triangle_reindex_eq)
  5929     apply (auto simp: algebra_simps sum_distrib_left intro!: sum.cong)
  5930     apply (metis le_add_diff_inverse power_add)
  5931     done
  5932   finally show ?thesis .
  5933 qed
  5934 
  5935 lemma polynomial_product_nat:
  5936   fixes x :: nat
  5937   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
  5938     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
  5939   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
  5940     (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5941   using polynomial_product [of m a n b x] assms
  5942   by (simp only: of_nat_mult [symmetric] of_nat_power [symmetric]
  5943       of_nat_eq_iff Int.int_sum [symmetric])
  5944 
  5945 lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
  5946   fixes x :: "'a::idom"
  5947   assumes "1 \<le> n"
  5948   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5949     (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5950 proof -
  5951   have h: "bij_betw (\<lambda>(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
  5952     by (auto simp: bij_betw_def inj_on_def)
  5953   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))"
  5954     by (simp add: right_diff_distrib sum_subtractf)
  5955   also have "\<dots> = (\<Sum>i\<le>n. a i * (x - y) * (\<Sum>j<i. y^(i - Suc j) * x^j))"
  5956     by (simp add: power_diff_sumr2 mult.assoc)
  5957   also have "\<dots> = (\<Sum>i\<le>n. \<Sum>j<i. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5958     by (simp add: sum_distrib_left)
  5959   also have "\<dots> = (\<Sum>(i,j) \<in> (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5960     by (simp add: sum.Sigma)
  5961   also have "\<dots> = (\<Sum>(j,i) \<in> (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5962     by (auto simp add: sum.reindex_bij_betw [OF h, symmetric] intro: sum.strong_cong)
  5963   also have "\<dots> = (\<Sum>j<n. \<Sum>i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5964     by (simp add: sum.Sigma)
  5965   also have "\<dots> = (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5966     by (simp add: sum_distrib_left mult_ac)
  5967   finally show ?thesis .
  5968 qed
  5969 
  5970 lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
  5971   fixes x :: "'a::idom"
  5972   assumes "1 \<le> n"
  5973   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5974     (x - y) * ((\<Sum>j<n. \<Sum>k<n-j. a(j + k + 1) * y^k * x^j))"
  5975 proof -
  5976   have "(\<Sum>i=Suc j..n. a i * y^(i - j - 1)) = (\<Sum>k<n-j. a(j+k+1) * y^k)"
  5977     if "j < n" for j :: nat
  5978   proof -
  5979     have h: "bij_betw (\<lambda>i. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
  5980       apply (auto simp: bij_betw_def inj_on_def)
  5981       apply (rule_tac x="x + Suc j" in image_eqI)
  5982        apply (auto simp: )
  5983       done
  5984     then show ?thesis
  5985       by (auto simp add: sum.reindex_bij_betw [OF h, symmetric] intro: sum.strong_cong)
  5986   qed
  5987   then show ?thesis
  5988     by (simp add: polyfun_diff [OF assms] sum_distrib_right)
  5989 qed
  5990 
  5991 lemma polyfun_linear_factor:  (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
  5992   fixes a :: "'a::idom"
  5993   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)"
  5994 proof (cases "n = 0")
  5995   case True then show ?thesis
  5996     by simp
  5997 next
  5998   case False
  5999   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>
  6000         (\<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))"
  6001     by (simp add: algebra_simps)
  6002   also have "\<dots> \<longleftrightarrow>
  6003     (\<exists>b. \<forall>z. (z - a) * (\<Sum>j<n. (\<Sum>i = Suc j..n. c i * a^(i - Suc j)) * z^j) =
  6004       (z - a) * (\<Sum>i<n. b i * z^i))"
  6005     using False by (simp add: polyfun_diff)
  6006   also have "\<dots> = True" by auto
  6007   finally show ?thesis
  6008     by simp
  6009 qed
  6010 
  6011 lemma polyfun_linear_factor_root:  (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
  6012   fixes a :: "'a::idom"
  6013   assumes "(\<Sum>i\<le>n. c(i) * a^i) = 0"
  6014   obtains b where "\<And>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i)"
  6015   using polyfun_linear_factor [of c n a] assms by auto
  6016 
  6017 (*The material of this section, up until this point, could go into a new theory of polynomials
  6018   based on Main alone. The remaining material involves limits, continuity, series, etc.*)
  6019 
  6020 lemma isCont_polynom: "isCont (\<lambda>w. \<Sum>i\<le>n. c i * w^i) a"
  6021   for c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
  6022   by simp
  6023 
  6024 lemma zero_polynom_imp_zero_coeffs:
  6025   fixes c :: "nat \<Rightarrow> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
  6026   assumes "\<And>w. (\<Sum>i\<le>n. c i * w^i) = 0"  "k \<le> n"
  6027   shows "c k = 0"
  6028   using assms
  6029 proof (induction n arbitrary: c k)
  6030   case 0
  6031   then show ?case
  6032     by simp
  6033 next
  6034   case (Suc n c k)
  6035   have [simp]: "c 0 = 0" using Suc.prems(1) [of 0]
  6036     by simp
  6037   have "(\<Sum>i\<le>Suc n. c i * w^i) = w * (\<Sum>i\<le>n. c (Suc i) * w^i)" for w
  6038   proof -
  6039     have "(\<Sum>i\<le>Suc n. c i * w^i) = (\<Sum>i\<le>n. c (Suc i) * w ^ Suc i)"
  6040       unfolding Set_Interval.sum_atMost_Suc_shift
  6041       by simp
  6042     also have "\<dots> = w * (\<Sum>i\<le>n. c (Suc i) * w^i)"
  6043       by (simp add: sum_distrib_left ac_simps)
  6044     finally show ?thesis .
  6045   qed
  6046   then have w: "\<And>w. w \<noteq> 0 \<Longrightarrow> (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
  6047     using Suc  by auto